Creating shaped forms

Mirror

Creating shaped forms (Views: 713)

Problem/Question/Abstract:

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.

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

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!

<< Back to main page