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