unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, Menus, ExtCtrls,
BmpRgn, StdCtrls, IniFiles,
Buttons;
type
TForm1 = class(TForm)
img1: TImage;
bvl1: TBevel;
lbl1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMEraseBkGnd( Var Msg: TWMEraseBkGnd ); message WM_ERASEBKGND;
procedure WMNCHitTest( Var msg: TWMNCHitTest ); message WM_NCHITTEST;
public
{ Public declarations }
procedure SetTheRegion;
procedure AppException(Sender: TObject; E: Exception);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// This routine takes care of drawing the bitmap on the form.
procedure TForm1.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
var
Brush: TBrush;
begin
Brush := TBrush.Create;
Brush.Color := Color;
FillRect( Msg.DC, ClientRect, Brush.Handle);
Brush.Free;
with img1.Picture.Bitmap do
BitBlt( Msg.DC, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
Msg.Result := 1;
end;
// This routine takes care of letting the user move the form
// around on the desktop.
procedure TForm1.WMNCHitTest( var msg: TWMNCHitTest );
var
i: integer;
p: TPoint;
AControl: TControl;
MouseOnControl: boolean;
begin
inherited;
if msg.result = HTCLIENT then begin
p.x := msg.XPos;
p.y := msg.YPos;
p := ScreenToClient( p);
MouseOnControl := false;
for i := 0 to ControlCount-1 do begin
if not MouseOnControl
then begin
AControl := Controls[i];
if ((AControl is TWinControl) or (AControl is TGraphicControl))
and (
AControl.Visible) then
begin
MouseOnControl := PtInRect( AControl.BoundsRect, p);
end;
end
else
break;
end;
if (not MouseOnControl) then
msg.Result := HTCAPTION;
end;
end;
procedure TForm1.SetTheRegion;
var
HR: HRGN;
begin
HR := BmpToRegion( Self, img1.Picture.Bitmap);
SetWindowRgn( handle, HR, true);
Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := AppException;
SetTheRegion;
end;
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
Application.ProcessMessages;
Application.ShowException(E);
Application.Terminate;
end;
end.
注意:
(1) img1: TImage;的Visible屬性必須設置為false
(2) BmpRgn 為外部dcu文件,需要導入
posted on 2010-02-22 11:48
Ke 阅读(382)
评论(0) 编辑 收藏 所属分类:
delphi