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;

相关阅读 >>

Delphi 检测文件是否被占用

Delphi arp攻击代码

Delphi 最简单的升级下载代码

Delphi 验证ip地址

Delphi 截取字符串的用法

Delphi调节音量及静音

Delphi jpg文件合并器代码

Delphi释放内存一般这么写

Delphi canvas.lineto 画线

Delphi 实现窗口记住关闭时的坐标位置

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...