全透明窗體（效果比較好）

2019-11-18 18:43:20

字體：大中小

來源：轉載

供稿：網友

全透明窗體（效果比較好）
uses里加上ExtCtrls
PRocedure tform1.setformtransparent;
var
I: Integer;
FullRgn,
ClientRgn,
ControlRgn: THandle;
Margin,
MarginX,
MarginY,
X,
Y: Integer;
W,H,S :Integer;
bX,bY :Integer;
c     :TColor;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
MarginX := Margin;
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
DeleteObject(ClientRgn);
for I:=0 to ControlCount-1 do
begin
    X := MarginX + Controls[I].Left;
    Y := MarginY + Controls[I].Top;
    W:=Controls[I].Width;
    H:=Controls[I].Height;
{}
    if controls[i] is timage then begin
      with controls[i] as tImage do begin
        c:=Picture.Bitmap.Canvas.Pixels[0,0];
        for bX:=0 to Picture.Bitmap.Width-1 do begin
          for bY:=0 to Picture.Bitmap.Height-1 do begin
            if Picture.Bitmap.Canvas.Pixels[bX,bY]<>c then begin
              ControlRgn := CreateRectRgn(X+bX, Y+bY, X + bX+1, Y + bY+1);
              CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
              DeleteObject(ControlRgn);
            end;
          end;
        end;
      end;
    end else
{}
    if controls[i] is tShape then begin
      if W < H then S := W else S := H;
      if (Controls[i] as tshape).Shape in [stSquare, stRoundSquare, stCircle] then
      begin
        Inc(X, (W - S) div 2);
        Inc(Y, (H - S) div 2);
        W := S;
        H := S;
      end;
      Inc(W); Inc(H); Inc(S);
      case (controls[i] as tshape).Shape of
        stRectangle, stSquare:
          ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
        stRoundRect, stRoundSquare:
          ControlRgn := CreateRoundRectRgn(X, Y, X + W, Y + H, S div 4, S div 4);
        stCircle, stEllipse:
          ControlRgn:=CreateEllipticRgn(X, Y, X + W, Y + H);
      else
        ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
      end;
      CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
      DeleteObject(ControlRgn);
    end else
{}
    begin
      ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
      CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
      DeleteObject(ControlRgn);
    end;
end;
SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
setformtransparent;
end;

//rock
//轉載請保留此信息

上一篇：一個從EXE、DLL文件中提取、存取圖標完整程序

下一篇：如何控制其他程序窗體上的窗口控件：中