transparent form

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
The MeLiX
Üye
Mesajlar: 22
Kayıt: 30 May 2005 08:09
Konum: Port 80
İletişim:

transparent form

Mesaj gönderen The MeLiX »

Slm arkadaşlar ben bi kod buldum.. transparent form için.. ama NT ve 9X de Çalışıyor.. Bunu XP için nasıl Düzenleyebiliriz?

Kod: Tümünü seç

private
    { Private declarations }
    FullRgn, ClientRgn, CtlRgn: THandle;
    procedure MakeTransparent;
    procedure UndoTransparent;
  end;

{...}

implementation

{...}

procedure TForm1.MakeTransparent;
var
  AControl: TControl;
  A, Margin, X, Y, CtlX, CtlY: Integer;
begin
  Margin    := (Width - ClientWidth) div 2;
  FullRgn   := CreateRectRgn(0, 0, Width, Height);
  X         := Margin;
  Y         := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  for A := 0 to ControlCount - 1 do
  begin
    AControl := Controls[A];
    if (AControl is TWinControl) or (AControl is TGraphicControl) then with AControl do
      begin
        if Visible then
        begin
          CtlX   := X + Left;
          CtlY   := Y + Top;
          CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);
          CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);
        end;
      end;
  end;
  SetWindowRgn(Handle, FullRgn, True);
end;

procedure TForm1.UndoTransparent;
begin
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
  SetWindowRgn(Handle, FullRgn, True);
end;

// Test

procedure TForm1.Button1Click(Sender: TObject);
begin
  MakeTransparent
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  UndoTransparent
end;
Kullanıcı avatarı
vedatkaba
Kıdemli Üye
Mesajlar: 866
Kayıt: 06 Oca 2004 06:50
Konum: DARICA/GEBZE

Mesaj gönderen vedatkaba »

Neden çalışması neresi çalışmadı nerede ne hatası verdi vs. vs. gibi sorular.Biraz daha aydınlatıcı olursan en kısa zamanda en sağlıklı cevap alırsın burdan.kolay gelsin.
***********************************
Kamil odur ki; koya dünyada bir eser,
Eseri olmayanın, yerinde yeller eser.

***********************************
Kullanıcı avatarı
vedatkaba
Kıdemli Üye
Mesajlar: 866
Kayıt: 06 Oca 2004 06:50
Konum: DARICA/GEBZE

Mesaj gönderen vedatkaba »

vecap yazdıktan sonra denedim WindowsXp ve Delphi 7.0 da çalıştı çalışmış hali.aşağıda;

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  FullRgn, ClientRgn, CtlRgn: THandle; 
    procedure MakeTransparent; 
    procedure UndoTransparent;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.MakeTransparent;
var 
  AControl: TControl; 
  A, Margin, X, Y, CtlX, CtlY: Integer; 
begin 
  Margin    := (Width - ClientWidth) div 2; 
  FullRgn   := CreateRectRgn(0, 0, Width, Height); 
  X         := Margin; 
  Y         := Height - ClientHeight - Margin; 
  ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight); 
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF); 
  for A := 0 to ControlCount - 1 do 
  begin 
    AControl := Controls[A]; 
    if (AControl is TWinControl) or (AControl is TGraphicControl) then with AControl do 
      begin 
        if Visible then 
        begin 
          CtlX   := X + Left; 
          CtlY   := Y + Top; 
          CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height); 
          CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR); 
        end; 
      end; 
  end; 
  SetWindowRgn(Handle, FullRgn, True); 
end;


procedure TForm1.UndoTransparent;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
  CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY); 
  SetWindowRgn(Handle, FullRgn, True);

end;

procedure TForm1.FormShow(Sender: TObject);
begin
MakeTransparent;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
UndoTransparent;
end;

end.
kolay gelsin
***********************************
Kamil odur ki; koya dünyada bir eser,
Eseri olmayanın, yerinde yeller eser.

***********************************
The MeLiX
Üye
Mesajlar: 22
Kayıt: 30 May 2005 08:09
Konum: Port 80
İletişim:

Mesaj gönderen The MeLiX »

teşakkürler çalıştı...
fduman
Moderator
Mesajlar: 2749
Kayıt: 17 Ara 2004 12:02
Konum: Ankara

Mesaj gönderen fduman »

Delphi 7 kullanıyorsan, AlphaBlend property'sini True yapıp, AlphaBlendValue değeri ile oynayarak saydam etkisi verebilirsin. Bu etkiyi sadece çalışma zamanında görebilirsin. Tasarım aşamasında değerle oynaman etkiyi oluşturmaz.
The MeLiX
Üye
Mesajlar: 22
Kayıt: 30 May 2005 08:09
Konum: Port 80
İletişim:

Mesaj gönderen The MeLiX »

coderlord yazdı:Delphi 7 kullanıyorsan, AlphaBlend property'sini True yapıp, AlphaBlendValue değeri ile oynayarak saydam etkisi verebilirsin. Bu etkiyi sadece çalışma zamanında görebilirsin. Tasarım aşamasında değerle oynaman etkiyi oluşturmaz.
Teşekkürler Buda Güzel Bişimiş...
Cevapla