The full transparent form (more efficient) Uses ExtCtrlsProcedure TFORM1.SETFORMTROCEDURE 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: 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.p Ixels [bx, by] <> c the 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 damness if w 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: = cretellipticRGN: ×, y, x w, y h); else controlrgn: = cretereCtrGN (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 // Reprinted please keep this information
