根据位图做出漂亮的不规则FORM

黑夜彩虹

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.

wofan

Delphi源码一定要支持！

枫影

支持+学习~~

快雪时晴

给个图噻:P

caterpilla

居然可以这样描出图形的边框，厉害。。。。。。。。。