真正的透明实现代码(附图效果)?高分请教!!(200分)

  • 主题发起人 主题发起人 wgj
  • 开始时间 开始时间
W

wgj

Unregistered / Unconfirmed
GUEST, unregistred user!
如何实现如图示的效果,谢谢!
http://www.xiaojisoft.com/123.jpg
 
很简单啊
 
弄了一个,处理速度有点慢.
Function Test(Handle: Hwnd; bmp: Graphics.TBitmap): Boolean;
Var
I, J, W, H: integer;
hRgnTmp, hRgnRect: HRGN;
C: TColor;
Begin
W := bmp.Width;
H := bmp.Height;
hRgnRect := CreateRectRgn(0, 0, W, H);
C := bmp.Canvas.Pixels[0, 0];
For I := 0 To W - 1 Do
Begin
For J := 0 To H - 1 Do
Begin
If (bmp.Canvas.Pixels[I, J] = C) Then
Begin
hRgnTmp := CreateRectRgn(i, j, i + 1, j + 1);
CombineRgn(hRgnRect, hRgnRect, hRgnTmp, RGN_XOR);
DeleteObject(hRgnTmp);
End;
End;
End;
Result:=SetWindowRgn(Handle, hRgnRect, True)<>0;
End;
 
实现上面的效果需要GIFFORM控件
不过这控件是在FOR D6运行的
下载:http://www.programfan.com/showdown.asp?id=182
 
不用的,这样麻烦,不用代码就可实现,我QQ:360986494,加我给你程序
 
不错学习下[:)]
 
form1.TransparentColor
 
窗体上扔个Image控件。然后画个图,就是你要显示的东西
代码如下:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, jpeg;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
function CreateRegion(wMask: TBitmap; wColor: TColor; hControl: THandle): HRGN;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

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
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); //释放DC
Result:=rgn;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
w1: TBitmap; //COPY图片
w2: TColor; //图片上这个颜色为空白的
rgn: HRGN;
begin
w1:=TBitmap.Create;
w1.Assign(image1.Picture.Bitmap); //取得图片对象
w2:=w1.Canvas.Pixels[0, 0];//图片要空白的颜色的像素点
rgn:=CreateRegion(w1, w2, self.Handle); //生成窗体区域
if rgn <> 0 then
begin
SetWindowRgn(Handle, rgn, true); //设定窗体形状
end;
w1.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close; //退出程序
end;

end.
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
833
DelphiTeacher的专栏
D
后退
顶部