delphi 程序嵌入桌面效果的实现

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;

 

转载于:https://www.cnblogs.com/blogpro/p/11339118.html