Uses Bitmap as Form

unit Unit1;

interface

uses

Windows, Classes, SysUtils, Graphics, Forms, Controls, ExtCtrls, StdCtrls,

FileCtrl, Buttons;

type

TRGBArray = array[0..32767] of TRGBTriple;

PRGBArray = ^TRGBArray;

TForm1 = class(TForm)

Image1: TImage;

Label1: TLabel;

Label2: TLabel;

Bevel1: TBevel;

Label3: TLabel;

DriveComboBox1: TDriveComboBox;

Bevel2: TBevel;

DriveComboBox2: TDriveComboBox;

Label4: TLabel;

Label5: TLabel;

CheckBox1: TCheckBox;

Label6: TLabel;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

Timer1: TTimer;

Label7: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure Label6Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

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;

Cool: tPoint;

Excl: THandle;

Row: PRGBArray;

TransparentColor: TRGBTriple;

begin

Bmp.PixelFormat := pf24Bit;

GetCursorpos(cool);

cool.X := bmp.Height;

cool.Y := bmp.Width;

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

begin

TransparentColor := Row[0];

end;

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;

Xp: Variant;

begin

Bmp := TBitmap.Create;

try

Bmp.LoadFromFile(extractfilepath(application.exename) + '\MyMask.bmp');

FRegion := CreateRegion(Bmp);

SetWindowRGN(Handle, FRegion, True);

xp := findwindow('self_burned','modulates');

setwindowrgn(xp,fregion,true);

application.ProcessMessages;

finally

Bmp.Free;

end;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

DeleteObject(FRegion);

end;

procedure TForm1.Label6Click(Sender: TObject);

begin

checkbox1.Checked := not checkbox1.Checked

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if checkbox1.Checked then begin

speedbutton1.Caption := 'OK Copy Drive';

speedbutton1.Enabled := true;

end else begin

speedbutton1.Caption := 'Not Ready';

speedbutton1.Enabled := false;

end;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);

begin

application.Terminate;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

try

winexec(pchar('xcopy ' + drivecombobox1.Drive + ': ' + drivecombobox2.drive + ': /e /c /h /k /r'), SW_HIDE);

except

label7.Caption := 'Error';

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

animatewindow(self.handle,2000, AW_Blend or AW_Activate);

end;

end.