Author: Lou Adler
Title: Creating shaped forms
Cool Bitmap shaped forms the easy way
Answer:
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.
1 procedure TForm1.FormCreate(Sender: TObject);
2 const
3 // Image Color to be made transparent
4 MASKCOLOR = clWhite;
5
6 // Cutting adjustments
7 ADJ_TOP = 22; {TitleBar}
8 ADJ_BOTTOM = 22; {TitleBar}
9 ADJ_LEFT = 3; {Border}
10 ADJ_RIGHT = 3; {Border}
11 var
12 ShowRegion, CutRegion: HRgn;
13 y, x1, x2: integer;
14 PixelColor: TColor;
15 begin
16
17 ShowRegion := CreateRectRgn(Image1.Left + ADJ_LEFT, Image1.Top + ADJ_TOP,
18 Image1.Left + Image1.Width + ADJ_RIGHT, Image1.Top + Image1.Height +
19 ADJ_BOTTOM);
20
21 // Cut the parts whose color is equal to MASKCOLOR by rows
22 for y := 0 to Image1.Picture.Bitmap.Height - 1 do
23 begin
24 x1 := 0; // starting point of cutting
25 x2 := 0; // end point of cutting
26 repeat
27 PixelColor := Image1.Picture.Bitmap.Canvas.Pixels[x2, y];
28 // the above will return -1 if x2 reached beyond the image
29 if (PixelColor = MaskColor) then
30 Inc(x2)
31 else
32 begin
33 //do following if pixel reached beyond image or if color of pixel
34 is not MaskColor
35 if x1 <> x2 then
36 begin
37 // Create the region to be cut. The region will be one line of
38 pixels/a pixel with color of
39 // MaskColor
40 CutRegion := CreateRectRgn(
41 X1 + Image1.Left + ADJ_LEFT,
42 Y + Image1.Top + ADJ_TOP,
43 X2 + Image1.Left + ADJ_RIGHT,
44 Y + Image1.Top + ADJ_TOP + 1);
45
46 try
47 CombineRgn(ShowRegion, ShowRegion, CutRegion, RGN_DIFF);
48 // RGN_DIFF will get the difference of ShowRegion
49 finally
50 DeleteObject(CutRegion);
51 end;
52 end;
53
54 Inc(x2);
55 x1 := x2;
56 end;
57 until PixelColor = -1;
58 end;
59
60 // Set the window to have the above defined region
61 SetWindowRgn(Form1.Handle, ShowRegion, True);
62
63 // NOTE : Do not free close/delete ShowRegion because it will become owned
64 // by the operating system
65
66 // You can manually disable the showing of the whole
67 //form while dragging, with the following line but
68 // just leave it since it is dependent on your
69 // windows settings. Some people may want to have their
70 // windows show its contents while dragging.
71
72 // SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0, nil, 0); {Disable drag showing}
73 // SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1, nil, 0); {Enable drag showing}
74 end;
NOW FOR THE FORM DRAGGING PART
1. Add this line to the private declarations of your Form:
75
76 procedure WMNCHitTest(var Msg: TWMNCHitTest); message wm_NCHitTest;
2. In the implementation part. Add the following (assuming your Form name is Form1):
77
78 procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
79 begin
80 inherited;
81 if Msg.Result = htClient then
82 Msg.Result := htCaption;
83 end;
Also, add a button to close the form because the title bar cannot be seen. That's all!
|
