unit CreateImageForm;
interface
uses
Windows, SysUtils, Variants, Classes, Graphics;
procedure CreatRgnForm( Bmap: TBitMap; WColor: TColor; hand:THandle);
implementation
procedure CreatRgnForm( Bmap: TBitMap; WColor: TColor; hand:THandle);
var
rgn: HRgn;
dc, cdc: HDC;
x, y: integer;
p: Tpoint;
line: boolean;
color: Tcolor;
begin
dc := GetWindowDc(hand);
cdc := CreateCompatibleDc( dc );
SelectObject( cdc, Bmap.Handle );
//WColor := Img.Picture.Bitmap.Canvas.Pixels[0, 0];
//WColor := GetPixel( cdc, 0, 0 );
BeginPath( dc );
for x := 0 to Bmap.Width - 1 do
begin
line := false;
for y := 0 to Bmap.Height - 1 do
begin
color := GetPixel( cdc, x, y );
if not( color=WColor) then
begin
if not line then
begin
line := true;
p.X := x;
p.Y := y;
end;
end;
if ( color=WColor)or( y=Bmap.Height - 1 ) then
begin
if line then
begin
line := false;
MoveToEx( dc, p.X, p.Y, nil );
LineTo(dc, p.X, y );
LineTo(dc, p.X + 1, y );
LineTo(dc, p.X + 1, p.Y );
CloseFigure( dc );
end;
end;
end;
end;
EndPath( dc );
Rgn := PathToRegion( dc );
ReleaseDc( hand, dc );
SetWindowRgn( hand , rgn, true );
end;
end.
如此调用就可以了
procedure TForm1.FormCreate(Sender: TObject);
var
color: TColor;
w1: TBitMap;
begin
w1 := TBitMap.Create;
w1.Assign( Image1.Picture.Bitmap );
color := w1.Canvas.Pixels[0, 0];
CreatRgnForm( w1, color, handle);
end.
