Как обрезать форму по рисунку?
01.01.2007
Вот пример, правда для Bitmap, хотя преобразовать PNG в BMP не составит труда.
unit Unit1; interface uses Windows, Classes, SysUtils, Graphics, Forms; type TRGBArray = array[0..32767] of TRGBTriple; PRGBArray = ^TRGBArray; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } FRegion: THandle; function CreateRegion(Bmp: TBitmap): THandle; end; var Form1: TForm1; implementation {$R *.dfm} function TForm1.CreateRegion(Bmp: TBitmap): THandle; var X, Y, StartX: Integer; Excl: THandle; Row: PRGBArray; TransparentColor: TRGBTriple; begin Bmp.PixelFormat := pf24Bit; Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height); for Y := 0 to Bmp.Height - 1 do begin Row := Bmp.Scanline[Y]; StartX := -1; if Y = 0 then TransparentColor := Row[0]; for X := 0 to Bmp.Width - 1 do begin if (Row[X].rgbtRed = TransparentColor.rgbtRed) and (Row[X].rgbtGreen = TransparentColor.rgbtGreen) and (Row[X].rgbtBlue = TransparentColor.rgbtBlue) then begin if StartX = -1 then StartX := X; end else begin if StartX > -1 then begin Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1); try CombineRGN(Result, Result, Excl, RGN_DIFF); StartX := -1; finally DeleteObject(Excl); end; end; end; end; if StartX > -1 then begin Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1); try CombineRGN(Result, Result, Excl, RGN_DIFF); finally DeleteObject(Excl); end; end; end; end; procedure TForm1.FormCreate(Sender: TObject); var Bmp: TBitmap; begin Bmp := TBitmap.Create; try Bmp.LoadFromFile('C:\YourBitmap.bmp'); FRegion := CreateRegion(Bmp); SetWindowRGN(Handle, FRegion, True); finally Bmp.Free; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin DeleteObject(FRegion); end; end.
Взято из https://forum.sources.ru