was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1547)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (127)
Strings (83)
System (268)
VCL (243)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

37 Visitors Online


 
...eine TForm transparent machen?
Autor: Mohammad Khorsandy
[ Tip ausdrucken ]  

Tip Bewertung (9):  
     


  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 it:

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

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

 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners