Mega Code Archive
Creating shaped forms
<![CDATA[
Cool Bitmap shaped forms the easy way
--------------------------------------------------------------------------------
Hey! Bored with rectangular windows? HERE'S THE CODE to make any shape you want based on a bitmap picture. How to do it:
1. First, make or choose any background bitmap you want your form to have. Then fill areas you want to go transparent with a distinct color (In this example, it is white). NOTE: The bitmap's size must be the actual size you want on your form. No stretching in Delphi will work.
2. In Delphi, add a TImage(Image1) component on the form. Choose your bitmap and put the component where you want it. Autosize must be true. Other visual components must be on top of the "visible" part of the picture so that they will be seen.
3. Add the following code (...I mean short code) to your FormCreate procedure. I know I should have made a component for it so that no code would be needed. But just to show you how, I guess this would suffice.
procedure TForm1.FormCreate(Sender: TObject);
const
// Image Color to be made transparent
MASKCOLOR = clWhite;
// Cutting adjustments
ADJ_TOP = 22;{TitleBar}
ADJ_BOTTOM = 22 ;{TitleBar}
ADJ_LEFT = 3;{Border}
ADJ_RIGHT = 3;{Border}
var
ShowRegion,CutRegion: HRgn;
y,x1,x2:integer;
PixelColor:TColor;
begin
ShowRegion:=CreateRectRgn(Image1.Left+ADJ_LEFT,Image1.Top+ADJ_TOP,
Image1.Left+Image1.Width+ADJ_RIGHT,Image1.Top+Image1.Height+ADJ_BOTTOM);
// Cut the parts whose color is equal to MASKCOLOR by rows
for y:=0 to Image1.Picture.Bitmap.Height-1 do
begin
x1:=0; // starting point of cutting
x2:=0; // end point of cutting
repeat
PixelColor:=Image1.Picture.Bitmap.Canvas.Pixels[x2,y];
// the above will return -1 if x2 reached beyond the image
if (PixelColor=MaskColor) then
Inc(x2)
else
begin
//do following if pixel reached beyond image or if color of pixel is not MaskColor
if x1 <> x2 then
begin
// Create the region to be cut. The region will be one line of pixels/a pixel with color of // MaskColor
CutRegion:=CreateRectRgn(
X1+Image1.Left+ADJ_LEFT ,
Y+Image1.Top+ADJ_TOP,
X2+Image1.Left+ADJ_RIGHT ,
Y+Image1.Top+ADJ_TOP+1);
try
CombineRgn(ShowRegion,ShowRegion,CutRegion,RGN_DIFF);
// RGN_DIFF will get the difference of ShowRegion
finally
DeleteObject(CutRegion);
end;
end;
Inc(x2);
x1:=x2;
end;
until PixelColor=-1;
end;
// Set the window to have the above defined region
SetWindowRgn(Form1.Handle,ShowRegion,True);
// NOTE : Do not free close/delete ShowRegion because it will become owned
// by the operating system
// You can manually disable the showing of the whole
//form while dragging, with the following line but
// just leave it since it is dependent on your
// windows settings. Some people may want to have their
// windows show its contents while dragging.
// SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0, nil, 0); {Disable drag showing}
// SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1, nil, 0); {Enable drag showing}
end;
NOW FOR THE FORM DRAGGING PART (Thanks to delphi.about.com)
1. Add this line to the private declarations of your Form:
procedure WMNCHitTest(var Msg: TWMNCHitTest); message wm_NCHitTest;
2. In the implementation part. Add the following (assuming your Form name is Form1):
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
if Msg.Result = htClient then
Msg.Result := htCaption;
end;
Also, add a button to close the form because the title bar cannot be seen. That's all!
Christopher Brian L. Jurado
]]>