随笔 - 6  文章 - 129  trackbacks - 0
<2024年4月>
31123456
78910111213
14151617181920
21222324252627
2829301234
567891011

常用链接

留言簿(14)

随笔档案(6)

文章分类(467)

文章档案(423)

相册

收藏夹(18)

JAVA

搜索

  •  

积分与排名

  • 积分 - 815441
  • 排名 - 49

最新评论

阅读排行榜

评论排行榜

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 阅读(375) 评论(0)  编辑  收藏 所属分类: delphi

只有注册用户登录后才能发表评论。


网站导航: