创建异形窗口[5]

本例效果图:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  bit: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bit := TBitmap.Create;
  bit.LoadFromFile('c:\temp\test.bmp');
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, bit);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  rgn1,rgn2: HRGN;
  x,y,w,h: Integer;
begin
  w := bit.Width;
  h := bit.Height;

  rgn1 := CreateRectRgn(0, 0, w, h);

  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      if bit.Canvas.Pixels[x,y] = clBlack then
      begin
        rgn2 := CreateRectRgn(x, y, x+1, y+1);
        CombineRgn(rgn1, rgn1, rgn2, RGN_XOR);
        DeleteObject(rgn2);
      end;
  SetWindowRgn(Handle, rgn1, True);

  Self.BorderStyle := bsNone;
  Self.Width := w;
  Self.Height := h;
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bit.Free;
end;

end.

posted on 2008-04-30 22:23  万一  阅读(2970)  评论(0)  编辑  收藏