syloux
asked on
Skin, form look like the BMP
Hi,
How can I simply have a form having the shape of a bitmap ? And is it possible to change it during running ? I mean, the user can change the bitmap and the form change to shape like the new bitmap.
Thanks
How can I simply have a form having the shape of a bitmap ? And is it possible to change it during running ? I mean, the user can change the bitmap and the form change to shape like the new bitmap.
Thanks
hello syloux, yes you can change the shape of a form with a Region, even during runtime. Getting a Region the shape of a section of a bitmap is not so easy, I would use a scanline of the bitmap and translate that into a windows Region. I could show you some code if you need it. You might look at torry's delphi web site for some components to do it, it takes some code to get it done.
ASKER
Thanks lopem, is coolform free ?
Thanks Slick812, some code would be useful
Thanks Slick812, some code would be useful
Hi
There's a component called Eclipse and it's great. It works just like Timage but with more properties. Simply drop the componet onto your form. Create your bitmap with a lime background. load the bitmap into the ecpimage.The lime becomes transparent and just shows the shape left. You can even click through the transparent regions and activate other things on your desktop. The package also comes with a speed button. use a glyph on the button to make your button any shape
It was free and used to be avaiable here:
http://www.gajits.com/p_eclipse.html
Have fun
t.
There's a component called Eclipse and it's great. It works just like Timage but with more properties. Simply drop the componet onto your form. Create your bitmap with a lime background. load the bitmap into the ecpimage.The lime becomes transparent and just shows the shape left. You can even click through the transparent regions and activate other things on your desktop. The package also comes with a speed button. use a glyph on the button to make your button any shape
It was free and used to be avaiable here:
http://www.gajits.com/p_eclipse.html
Have fun
t.
Hi again,
I don't think the free version is available from that URL any longer :-(
If you hve D3 or D4 I believe the free version might still be downloadable here:
http://www.programmersheaven.com/zone2/cat54/
scroll down the page to eclipse.
T.
I don't think the free version is available from that URL any longer :-(
If you hve D3 or D4 I believe the free version might still be downloadable here:
http://www.programmersheaven.com/zone2/cat54/
scroll down the page to eclipse.
T.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
unit Unit1;
interface
uses
Windows, Classes, SysUtils, Graphics, Forms;
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(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;
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
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;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('MyMask.b mp');
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;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(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;
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
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
(Row[X].rgbtBlue = TransparentColor.rgbtBlue)
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('MyMask.b
FRegion := CreateRegion(Bmp);
SetWindowRGN(Handle, FRegion, True);
finally
Bmp.Free;
end;
end;
procedure TForm1.FormDestroy(Sender:
begin
DeleteObject(FRegion);
end;
end.
implementation
var
Mask: THandle;
{$R *.DFM}
function BitmapToRegion(Bmp: TBitmap): THandle;
var
X, Y, StartX: Integer;
Excl: THandle;
TransColour: TColor;
begin
Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
TransColour := Bmp.Canvas.Pixels[0,0];
for Y := 0 to Bmp.Height - 1 do begin
StartX := -1;
for X := 0 to Bmp.Width - 1 do begin
if Bmp.Canvas.Pixels[X,Y] = TransColour then begin
if StartX = -1 then StartX := X;
end else begin
if StartX > -1 then begin
Excl := CreateRectRGN(StartX -1, Y + 1, X, Y);
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.LoadMask(Filename: String);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(Filename) ;
Mask := CreateRegion(Bmp);
SetWindowRGN(Handle, Mask, True);
finally
Bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadMask('Default.bmp');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(Mask);
end;
var
Mask: THandle;
{$R *.DFM}
function BitmapToRegion(Bmp: TBitmap): THandle;
var
X, Y, StartX: Integer;
Excl: THandle;
TransColour: TColor;
begin
Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
TransColour := Bmp.Canvas.Pixels[0,0];
for Y := 0 to Bmp.Height - 1 do begin
StartX := -1;
for X := 0 to Bmp.Width - 1 do begin
if Bmp.Canvas.Pixels[X,Y] = TransColour then begin
if StartX = -1 then StartX := X;
end else begin
if StartX > -1 then begin
Excl := CreateRectRGN(StartX -1, Y + 1, X, Y);
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.LoadMask(Filename: String);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(Filename)
Mask := CreateRegion(Bmp);
SetWindowRGN(Handle, Mask, True);
finally
Bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadMask('Default.bmp');
end;
procedure TForm1.FormDestroy(Sender:
begin
DeleteObject(Mask);
end;
Drunkard_Englishman ,
Look like you are new here.
How you can see a lots of people put just comments and not a directly answer. We use this method because we don't wish to lock the question with an answer and to let the other experts to propose maybe a better solution.
In same time the asker can choice the best comment for him and to accept it like answer.
Best regards,
Nick
Look like you are new here.
How you can see a lots of people put just comments and not a directly answer. We use this method because we don't wish to lock the question with an answer and to let the other experts to propose maybe a better solution.
In same time the asker can choice the best comment for him and to accept it like answer.
Best regards,
Nick
syloux, are you here?
do you need help with this?
do you need help with this?
ASKER
Almost that. But the bitmap is not showed. The foram have the shape, but I can not see the image.
ASKER
With your solution, how can I move the form with the mouse ?
you need to assign the bitmap to the forms canvas.
modifying my code above by adding/changing the following will do it:
procedure TForm1.LoadMask(Filename: String);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(Filename) ;
Mask := CreateRegion(Bmp);
SetWindowRGN(Handle, Mask, True);
Form1.Canvas.Brush.Bitmap := Bitmap;
finally
Bmp.Free;
end;
end;
procedure TMainForm.Form1MouseDown(S ender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGMOVE = $F012;
begin
if Button = mbleft then begin
ReleaseCapture;
MainForm.Perform(WM_SYSCOM MAND, SC_DRAGMOVE, 0);
end;
end;
modifying my code above by adding/changing the following will do it:
procedure TForm1.LoadMask(Filename: String);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(Filename)
Mask := CreateRegion(Bmp);
SetWindowRGN(Handle, Mask, True);
Form1.Canvas.Brush.Bitmap := Bitmap;
finally
Bmp.Free;
end;
end;
procedure TMainForm.Form1MouseDown(S
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGMOVE = $F012;
begin
if Button = mbleft then begin
ReleaseCapture;
MainForm.Perform(WM_SYSCOM
end;
end;
you need to assign the bitmap to the forms canvas.
modifying my code above by adding/changing the following will do it:
procedure TForm1.LoadMask(Filename: String);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(Filename) ;
Mask := CreateRegion(Bmp);
SetWindowRGN(Handle, Mask, True);
Form1.Canvas.Brush.Bitmap := Bmp;
finally
Bmp.Free;
end;
end;
procedure TMainForm.Form1MouseDown(S ender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGMOVE = $F012;
begin
if Button = mbleft then begin
ReleaseCapture;
MainForm.Perform(WM_SYSCOM MAND, SC_DRAGMOVE, 0);
end;
end;
modifying my code above by adding/changing the following will do it:
procedure TForm1.LoadMask(Filename: String);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(Filename)
Mask := CreateRegion(Bmp);
SetWindowRGN(Handle, Mask, True);
Form1.Canvas.Brush.Bitmap := Bmp;
finally
Bmp.Free;
end;
end;
procedure TMainForm.Form1MouseDown(S
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGMOVE = $F012;
begin
if Button = mbleft then begin
ReleaseCapture;
MainForm.Perform(WM_SYSCOM
end;
end;
opps sorry about the double post :)
I'm confused, The Bitmap is painted on the form in the form's OnPaint method. If you go to the object inspector for Form1 and look in the Events Tab and the Double Click the "OnPaint" event it will place a "FormPaint" procedure in your code and you then add the Canvas.Draw(0,0, SkinBmp);
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(0,0, SkinBmp);
end;
this will draw the Bitmap on your form, if there is a bitmap in the SkinBmp.
You can use the Drunkard_Englishman code to move your form with a mouse drag. Get your Form1 OnMouseDown Event
procedure TForm1.FormMouseDown(Sende r: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbleft then
begin
ReleaseCapture;
MainForm.Perform(WM_SYSCOM MAND, $F012, 0);
end;
end;
OH and Drunkard_Englishman, you use
Form1.Canvas.Brush.Bitmap := Bmp;
a brush bitmap only uses a 8x8 pixel bitmap
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(0,0, SkinBmp);
end;
this will draw the Bitmap on your form, if there is a bitmap in the SkinBmp.
You can use the Drunkard_Englishman code to move your form with a mouse drag. Get your Form1 OnMouseDown Event
procedure TForm1.FormMouseDown(Sende
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbleft then
begin
ReleaseCapture;
MainForm.Perform(WM_SYSCOM
end;
end;
OH and Drunkard_Englishman, you use
Form1.Canvas.Brush.Bitmap := Bmp;
a brush bitmap only uses a 8x8 pixel bitmap
http://www.lawrenz.com/coolform/
These guys wrote a very nice component. I dont know if you can change image during runtime. Anyway, is a good start.
best regards,
Manuel Lopez (lopem)