Форма окна по Bitmap

Форма окна по Bitmap

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.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...