procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Form1.Handle, GWL_EXSTYLE,
(GetWindowLong(Form1.Handle, GWL_EXSTYLE) or WS_WX_TRANSPARENT));
end;
Showing posts with label form. Show all posts
Showing posts with label form. Show all posts
Wednesday, March 14, 2007
prevent Windows from minimizing a Form?
implementation
procedure TForm1.WMShowWindow(var Msg: TWMShowWindow);
begin
if not Msg.Show then
Msg.Result := 0
else
inherited;
end;
procedure TForm1.WMShowWindow(var Msg: TWMShowWindow);
begin
if not Msg.Show then
Msg.Result := 0
else
inherited;
end;
shape a form to a 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.
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.
Thursday, March 8, 2007
move the cursor to the currently focused control
procedure TForm1.Button1Enter(Sender: TObject);
var
cntrl: TControl;
xCent, yCent: Integer;
point: TPoint;
begin
cntrl := TControl(Sender);
xCent := cntrl.Left + (cntrl.Width div 2);
yCent := cntrl.Top + (cntrl.Height div 2);
point := ClientToScreen(Point(xCent, yCent));
SetCursorPos(point.X,point.Y);
end;
var
cntrl: TControl;
xCent, yCent: Integer;
point: TPoint;
begin
cntrl := TControl(Sender);
xCent := cntrl.Left + (cntrl.Width div 2);
yCent := cntrl.Top + (cntrl.Height div 2);
point := ClientToScreen(Point(xCent, yCent));
SetCursorPos(point.X,point.Y);
end;
Subscribe to:
Posts (Atom)