如何把窗体的形状变成任意形状,比如变成一个位图的形状 高分相送哦 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 这段代码能行,试试看unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 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_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; begin w1:=TBitmap.Create; w1.Assign(image1.Picture.Bitmap); w2:=w1.Canvas.Pixels[0,0]; rgn := CreateRegion(w1,w2,Handle); if rgn<>0 then begin SetWindowRgn(Handle, rgn, true); end; w1.Free; end; procedure TForm1.Button1Click(Sender: TObject); begin Close; end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, $F012, 0); end; end. 参考以下api函数,查找帮助先用CreateRoundRectRgn()CreateRectRgn()CreatePolygonRgn()CreatePolyPolygonRgn();CreateEllipticRgn()建立区域然后给SetWindowRgn();结果窗口在这个区域之外的都成透明了 同意第一位朋友的代码,但是我觉得CreateRegion函数系统中应该有吧? 用CreatePolyPolygonRgn()获得图形的指针;用SetWindowRgn()设置窗体的形状! 用D如何实现分批取数据? DELPHI7下安装VSFLEX7 active控件,导入正常,怎么拖放到FORM上报 OLE 错! 大家帮我看一下这条语句有什么问题? 1条挺难写的SQL语句 Oracle数据库导出后的XML数据格式,如何用Delphi在前台把数据显示出来? 如何删除中文目录,在线等待! 关于98与XP的兼容问题 怎样才能在richedit里插入文字时,是以覆盖模式插入? 判断软件版本的问题 请问大家,到那里有 Sql 7.0 或者SQL 2000下载呢?? 网络问题(NMMsg) 寻找天津的同志。MY QQ:191481110(口令:CSDN)
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons; type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
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_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;
begin
w1:=TBitmap.Create;
w1.Assign(image1.Picture.Bitmap);
w2:=w1.Canvas.Pixels[0,0];
rgn := CreateRegion(w1,w2,Handle);
if rgn<>0 then
begin
SetWindowRgn(Handle, rgn, true);
end;
w1.Free;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);
end; end.
先用
CreateRoundRectRgn()
CreateRectRgn()
CreatePolygonRgn()
CreatePolyPolygonRgn();
CreateEllipticRgn()
建立区域
然后给
SetWindowRgn();
结果窗口在这个区域之外的都成透明了
用SetWindowRgn()设置窗体的形状!