function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN; var dc, dc_c: HDC; rgn: HRGN; x, y: integer; coord: TPoint; line: boolean; color: TColor; begin dc := GetWindowDC(hControl); dc_c := CreateCompatibleDC(dc); SelectObject(dc_c, wMask.Handle); BeginPath(dc); for x:=0 to wMask.Width-1 do begin line := false; for y:=0 to wMask.Height-1 do begin color := GetPixel(dc_c, x, y); if not (color = wColor) then begin if not line then begin line := true; coord.x := x; coord.y := y; end; end; if (color = wColor) or (y=wMask.Height-1) then begin if line then begin line := false; MoveToEx(dc, coord.x, coord.y, nil); LineTo(dc, coord.x, y); LineTo(dc, coord.x + 1, y); LineTo(dc, coord.x + 1, coord.y); CloseFigure(dc); end; end; end; end; EndPath(dc); rgn := PathToRegion(dc); ReleaseDC(hControl, dc); Result := rgn; end; procedure TForm1.FormCreate(Sender: TObject); var w1:TBitmap; w2:TColor; rgn: HRGN; deskHandle, ProgmanH, ShellDllH, DeskopICOH: Thandle; wc: TWinControl; i: Integer; begin i := 0; ProgmanH := FindWindow('Progman', 'Program Manager'); while (i < 100) and (ProgmanH = 0) do begin ProgmanH := FindWindow('Progman', 'Program Manager'); Inc(I); Sleep(100); end; if ProgmanH = 0 then Close; if (ProgmanH <> 0) and IsWindow(ProgmanH) and (GetParent(ProgmanH) = 0) then begin ShellDllH := FindWindowEx(ProgmanH, 0, PChar('SHELLDLL_DefView'), ''); if ShellDllH <> 0 then DeskopICOH := FindWindowEx(ShellDllH, 0, PChar('SysListView32'), 'FolderView'); if DeskopICOH <> 0 then windows.SetParent(Self.Handle, DeskopICOH) else Close; end; w1:=TBitmap.Create; w1.Assign(image1.Picture.Bitmap); w2:=w1.Canvas.Pixels[0,0]; // w2 := clWhite; rgn := CreateRegion(w1,w2,Handle); if rgn<>0 then begin SetWindowRgn(Handle, rgn, true); end; w1.Free; end;