Mega Code Archive
Drawing a form by the shape of a bitmap the simple way
<![CDATA[
Title: Drawing a form by the shape of a bitmap - the simple way.
Question: How do i shape a form by the outlines of a TBitmap image?
Answer:
How to make this work for your application :
-------------------------------------------------
(I rewrote this part since some people didn't
manage to run the application)
1. Create new application.
2. Insert a TBitmap object called 'image1'
and place it in the most top-left location
by setting the top and left properties of
the TImage object to zero.
(selecting a bmp for it will be cool too-
do that by clicking the 'Picture' property
of the TImage object)
3. Paste my code into you project.
4. Assign the FormCreate proc of your form.
(by double clicking the 'OnCreate' event
in the object inspector)
5. Set the form's border style to bsNone.
6. Press F9 :)
(in order to close the application
press Alt+F4)
Some comments
-------------------------------------------------
1. The image must be saved as 24bit format.
(However , you CAN make it work in other
formats too, but that'll require some
changes in the code)
2. This code will assume that the [0,0]
pixel is background color and should
not be visable.(you can change that
by assigning something else to the
'transp' variable located at the
beggining of the FormCreate proc)
All pixels in your image, that has
the same color as [0,0] will become
transparent.
3. I wrote this one after I read the an
article in the GUI category and decided
that there must be a shorter way of
doing this.
The code
---------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
//structure of the bitmap
bit24=record
r,g,b:byte;
end;
bit24array=array[0..0] of bit24;
pbit24array=^bit24array;
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
x,y,rc:integer;
tmprgn,tmprgn2,tmprgn3: HRGN;
NewRgn : HRGN;
b:tbitmap;
p:pbit24Array;
transp:bit24;
begin
NewRgn := CreateRectRgn(0,0,0,0);
b:=image1.Picture.Bitmap;
p:= b.scanline[0];
//change this in order to set other color as bg
transp:=p[0];
//loop for lines
for y := 0 to b.height-1 do
begin
p:= b.scanline[y];
x:=0;
//loop for rows :
//this loop looks very stupid...
//but it didn't work any other way:
while x if (p[x].rtransp.r)or(p[x].gtransp.g)
or(p[x].btransp.b) then
begin
rc:=1;
while (p[x+rc].rtransp.r)and(p[x+rc].gtransp.g)
and(p[x+rc].btransp.b) do inc(rc);
tmprgn:=CreateRectRgn(x,y,x+rc,y+1);
tmpRgn2:=CreateRectRgn(0,0,0,0);
CombineRgn(tmpRgn2,newRgn,tmpRgn,RGN_OR);
DeleteObject(newrgn);
newrgn := tmprgn2;
inc(x,rc);
end else inc(x);
end;
//set to the new region
SetWindowRgn(handle,NewRgn,false);
DeleteObject(newrgn);
DeleteObject(tmprgn);
DeleteObject(tmprgn2);
end;
end.
Enjoy !
Shlomi Loubaton
]]>