Solved

Transparent forms

Posted on 1998-10-29
28
361 Views
Last Modified: 2010-04-06
I'd like to know how to do a transparent form in Delphi 3.
It should be able to show a bitmap hiding the rest of the form, even the title bar.
0
Comment
Question by:forns
  • 13
  • 7
  • 5
  • +2
28 Comments
 
LVL 4

Expert Comment

by:BoRiS
ID: 1344950
forns

to create the form transparent use this code...

procedure TForm1.FormCreate(Sender: TObject);
 begin
   Form1.Brush.Style := bsClear;
   Form1.BorderStyle := bsNone
 end;

just palce a image on the form with your bitmap, and set the borderstyle of your form to bsNone

this will make the form transparent, with no tiltilebar and a bitmap on top of it...

Later
BoRiS

0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344951
hey ! try this:


      Drop a panel and 2 buttons to the form and use this:



      unit Unit1;

      interface

      uses
        Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
        ExtCtrls, StdCtrls;

      type
        TForm1 = class(TForm)
          Button1: TButton;
          Panel1: TPanel;
          Button2: TButton;
          procedure FormDestroy(Sender: TObject);
          procedure FormCreate(Sender: TObject);
          procedure Button1Click(Sender: TObject);
          procedure Button2Click(Sender: TObject);
          procedure FormResize(Sender: TObject);
        private
          { Private declarations }
          procedure DoVisible;
          procedure DoInvisible;
        public
          { Public declarations }
        end;

      var
        Form1: TForm1;
        FullRgn, ClientRgn, CtlRgn : THandle;

      implementation

      {$R *.DFM}

      procedure TForm1.DoInvisible;
      var
        AControl : TControl;
        A, Margin, X, Y, CtlX, CtlY : Integer;
      begin
        Margin := ( Width - ClientWidth ) div 2;
        //First, get form region
        FullRgn := CreateRectRgn(0, 0, Width, Height);
        //Find client area region
        X := Margin;
        Y := Height - ClientHeight - Margin;
        ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
        //'Mask' out all but non-client areas
        CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );

        //Now, walk through all the controls on the form and 'OR' them
        // into the existing Full region.
        for A := 0 to ControlCount - 1 do begin
          AControl := Controls[A];
          if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
              then with AControl do begin
            if Visible then begin
              CtlX := X + Left;
              CtlY := Y + Top;
              CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
              CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
            end;
          end;
        end;
        //When the region is all ready, put it into effect:
        SetWindowRgn(Handle, FullRgn, TRUE);
      end;

      procedure TForm1.FormDestroy(Sender: TObject);
      begin
        //Clean up the regions we created
        DeleteObject(ClientRgn);
        DeleteObject(FullRgn);
        DeleteObject(CtlRgn);
      end;

      procedure TForm1.DoVisible;
      begin
        //To restore complete visibility:
        FullRgn := CreateRectRgn(0, 0, Width, Height);
        CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
        SetWindowRgn(Handle, FullRgn, TRUE);
      end;

      procedure TForm1.FormCreate(Sender: TObject);
      begin
        //We start out as a transparent form....
        DoInvisible;
      end;

      procedure TForm1.Button1Click(Sender: TObject);
      begin
        //This button just toggles between transparent and not trans..
        if Button1.Caption = 'Show Form' then begin
          DoVisible;
          Button1.Caption := 'Hide Form';
        end
        else begin
          DoInvisible;
          Button1.Caption := 'Show Form';
        end;
      end;

      procedure TForm1.Button2Click(Sender: TObject);
      begin
        Application.Terminate;
      end;

      procedure TForm1.FormResize(Sender: TObject);
      begin
        //Need to address the transparency if the form gets re-sized.
        //Also, note that Form1 scroll bars are set to VISIBLE/FALSE.
        //I did that to save a little coding here....
        if Button1.Caption = 'Show Form' then
          DoInvisible
        else
          DoVisible;
      end;

      end.



      ok, I hope it helps you,   see ya !

Ps: To hide the title bar set the Main Form border style to bsNone
(Form1.BorderStyle := bsNone)

bryan

0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344952
hey ! try this:


      Drop a panel and 2 buttons to the form and use this:



      unit Unit1;

      interface

      uses
        Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
        ExtCtrls, StdCtrls;

      type
        TForm1 = class(TForm)
          Button1: TButton;
          Panel1: TPanel;
          Button2: TButton;
          procedure FormDestroy(Sender: TObject);
          procedure FormCreate(Sender: TObject);
          procedure Button1Click(Sender: TObject);
          procedure Button2Click(Sender: TObject);
          procedure FormResize(Sender: TObject);
        private
          { Private declarations }
          procedure DoVisible;
          procedure DoInvisible;
        public
          { Public declarations }
        end;

      var
        Form1: TForm1;
        FullRgn, ClientRgn, CtlRgn : THandle;

      implementation

      {$R *.DFM}

      procedure TForm1.DoInvisible;
      var
        AControl : TControl;
        A, Margin, X, Y, CtlX, CtlY : Integer;
      begin
        Margin := ( Width - ClientWidth ) div 2;
        //First, get form region
        FullRgn := CreateRectRgn(0, 0, Width, Height);
        //Find client area region
        X := Margin;
        Y := Height - ClientHeight - Margin;
        ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
        //'Mask' out all but non-client areas
        CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );

        //Now, walk through all the controls on the form and 'OR' them
        // into the existing Full region.
        for A := 0 to ControlCount - 1 do begin
          AControl := Controls[A];
          if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
              then with AControl do begin
            if Visible then begin
              CtlX := X + Left;
              CtlY := Y + Top;
              CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
              CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
            end;
          end;
        end;
        //When the region is all ready, put it into effect:
        SetWindowRgn(Handle, FullRgn, TRUE);
      end;

      procedure TForm1.FormDestroy(Sender: TObject);
      begin
        //Clean up the regions we created
        DeleteObject(ClientRgn);
        DeleteObject(FullRgn);
        DeleteObject(CtlRgn);
      end;

      procedure TForm1.DoVisible;
      begin
        //To restore complete visibility:
        FullRgn := CreateRectRgn(0, 0, Width, Height);
        CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
        SetWindowRgn(Handle, FullRgn, TRUE);
      end;

      procedure TForm1.FormCreate(Sender: TObject);
      begin
        //We start out as a transparent form....
        DoInvisible;
      end;

      procedure TForm1.Button1Click(Sender: TObject);
      begin
        //This button just toggles between transparent and not trans..
        if Button1.Caption = 'Show Form' then begin
          DoVisible;
          Button1.Caption := 'Hide Form';
        end
        else begin
          DoInvisible;
          Button1.Caption := 'Show Form';
        end;
      end;

      procedure TForm1.Button2Click(Sender: TObject);
      begin
        Application.Terminate;
      end;

      procedure TForm1.FormResize(Sender: TObject);
      begin
        //Need to address the transparency if the form gets re-sized.
        //Also, note that Form1 scroll bars are set to VISIBLE/FALSE.
        //I did that to save a little coding here....
        if Button1.Caption = 'Show Form' then
          DoInvisible
        else
          DoVisible;
      end;

      end.



      ok, I hope it helps you,   see ya !

Ps: To hide the title bar set the Main Form border style to bsNone
(Form1.BorderStyle := bsNone)

bryan

0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344953
And if you don't hide the tittle bar,
you can move it, and you can see the things on the background,
and you can even move an icon through the main form, as if the form
wasn't there.

Try it without hiding the title bar, it's really cool.

bryan

0
 

Author Comment

by:forns
ID: 1344954
The form is showed transparent that way, but the screen background is not repainted, so it looks really uggly.
Thank you, anyway :))
0
 
LVL 4

Expert Comment

by:BoRiS
ID: 1344955
forns

Well that was the questioned asked how to make forms transparent if you want the background on your desktop painted that's a whole new ball game...

Later
BoRiS
0
 
LVL 4

Expert Comment

by:BoRiS
ID: 1344956
forns

Here is another way to make your forms transparent...hope the previous comment didn't come through as rude (maybe not the right wording) :-)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  private
    //procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WM_EraseBkGnd(Var Msg : TWMEraseBkGnd); Message     WM_EraseBkGnd;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CreateParams( var Params: TCreateParams );
begin
  inherited CreateParams( Params );
   Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TForm1.WM_EraseBkGnd(var Msg : TWMEraseBkGnd);
begin
  inherited;
   msg.Result := 1;
end;

end.

But for what you are looking for I think bryan7 might have it...

Later
BoRiS
0
 

Expert Comment

by:tleforge
ID: 1344957
I thought that Bryans code and mine did pretty much the same thing, but maybe not.  I've never had problems with the background not being repainted, so try this code... I think it will work fine for you.  Don't worry about giving me any points, this was given away free, elsewhere.

//************************************************************
// Begin code
//************************************************************

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, Grids,
  DBGrids;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure TransForm(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.TransForm(Sender: TObject);
var
  FullRgn, ClientRgn, ButtonRgn: THandle;
  Margin, x, y, z: Integer;
  l,t,h,w: Integer;
begin
  Margin := (Width - ClientWidth) div 2;
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  x := Margin;
  y := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn(x, y, x + ClientWidth, y + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  for z := ComponentCount - 1 downto 0 do begin
    if Components[z] is {TControl} TWinControl then
      if (Components[z].GetParentComponent is TForm) then
      with Components[z] as {TControl} TWinControl do begin
        l := Left;
        t := Top;
        h := Height;
        w := Width;
      end;
      x := Margin + l;
      y := (Height - ClientHeight - Margin) + t;
    ButtonRgn := CreateRectRgn(x, y, x + w, y + h);
    CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
  end;
  SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TransForm(Sender);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  TransForm(Sender);
end;

end.

//************************************************************
// End code
//************************************************************


After making these changes to your forms unit, place some components on it (if you haven't already) and run it.  Hope this helps.

CYa!!!

0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344958
tleforge: I also haven't had problems with the background repainted.
How do you toggle from transparent/not transparent and viceversa ?
you should have a function for that, as "my" code has.

bryan

0
 

Expert Comment

by:tleforge
ID: 1344959
Actually, I never needed to toggle so I didn't bother with that functionality.  You're right, though, it IS nice to have just in case.

I wonder what repainting problems 'forns' is talking about...
Hmmmmm.
0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344960
forns ? hi ? where are you ?

what are you gonna do ?

bryan

0
 

Author Comment

by:forns
ID: 1344961
1st o'all: thanx much, everyone.

tleforge: i had problems repainting the background using boris' code.
i think i didn't explain the problem clearly. here i go again:
once upon a time i saw a pretty app that showed mr.bean's face and his eyes moved arround looking at the mouse pointer. the bitmap (or whatever it was) with mr.bean's face i supose it was in a form, where if not? it was nice cuz the desktop under mr.b's face was repainted when you moved it (just had to click and move the mouse so the "form" did so) and the face's edges where much clean, so it realy looked like it was not in a form.
and so i wandered "how the **** do they do it?"

well, that's all. don't worry about the damn points, bryan. as they say there in spain: "Todos obtenemos lo que nos merecemos."
(sorry for my english, i'm catalan).
be patient...
0
 
LVL 4

Expert Comment

by:BoRiS
ID: 1344962
forns

I think what you are looking for is cliping the regions of a form, what happens there is the form around the bitmap is not set to transparent but actully delete (in a way) this is the way they get the bitmap to appear like that...

Here is a code snippet on how to do clipping, but its quite involved...you can also download coolforms from www.torry.ru this comonent does all the work for you all you do is pass it a bitmap and select the color you want to remove then the form is show with the color choosen as clipped...hard to explain you need to see the effect...

procedure TForm1.FreeRegion;
begin
  if (rTest > 0) then
    DeleteObject(rTest);
   
  rTest := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  imgCorner.Left := 0;
  imgCorner.Top := Self.ClientHeight - imgCorner.Height;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
//
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i, j: Integer;
  s: string;
  rText: TRect;
begin
  DrawFrameControl(Canvas.Handle, Rect(0, 0, Width, Height), DFC_BUTTON, DFCS_BUTTONPUSH);
  Canvas.Font.Name := 'Arial';
  Canvas.Font.Size := 24;
  Canvas.Font.Style := [fsBold];
  SetBkMode(Canvas.Handle, TRANSPARENT);
  s := 'Region Demo';
  rText := Rect(0, 40, Width, 80);
  DrawText(Canvas.Handle, PChar(s), Length(s), rText, DT_CENTER);
  Canvas.Font.Size := 9;
  Canvas.Font.Style := [];
  s := 'This demo shows what a window looks';
  rText := Rect(0, 100, Width, 120);
  DrawText(Canvas.Handle, PChar(s), Length(s), rText, DT_CENTER);
  s := 'like on the reverse side.';
  rText := Rect(0, 120, Width, 140);
  DrawText(Canvas.Handle, PChar(s), Length(s), rText, DT_CENTER);
  SetBkMode(Canvas.Handle, OPAQUE);
 
  if (RgnOn) then
    begin
      for i := 0 to 1 do
        for j := 0 to 18 do
          Canvas.Pixels[40 + (i * 2), Height - 36 + (j * 2)] := clGray;
    end
  else
    begin
      Canvas.Pen.Color := clGray;
      Canvas.MoveTo(2, Height - 40);
      Canvas.LineTo(40, Height - 2);
      Canvas.Pen.Color := clWhite;
      Canvas.MoveTo(2, Height - 39);
      Canvas.LineTo(39, Height - 2);
    end;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.btnFlipClick(Sender: TObject);
var
  RPts: array[1..5] of TPoint;
begin
  RgnOn := not RgnOn;
  Self.imgCorner.Visible := RgnOn;
  if (RgnOn) then
    begin
      RPts[1].x := 0;
      RPts[1].y := 0;
      RPts[2].x := 0;
      RPts[2].y := Height - 40;
      RPts[3].x := 40;
      RPts[3].y := Height;
      RPts[4].x := Width;
      RPts[4].y := Height;
      RPts[5].x := Width;
      RPts[5].y := 0;
      FreeRegion;
      rTest := CreatePolygonRgn(RPts, 5, WINDING);
      SetWindowRgn(Self.Handle, rTest, True);
    end
  else
    begin
      FreeRegion;
      SetWindowRgn(Self.Handle, 0, True);
    end;
  Self.Invalidate;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeRegion;
end;

This is what you are looking for, check out coolforms...

Later
BoRiS
0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344963
Hi there Boris.

I've got some problems running your example. Could you send me a zipped example ?
I'm using Delphi 3 C/S.

forms: I also have a code to make your form move by clicking ON THE FORM in stead
of clicking on the form's bar( well, at both places )
This means: you can move the form ( or just the image, if you hide the rest of the form ),
by cliking on it and dragging, as if it was the form's upper bar.
( something like Winamp's EasyMove function)

bryan
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 4

Expert Comment

by:BoRiS
ID: 1344964
bryan

what's your email address...

Later
BoRiS
0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344965
this is:   AerithFantasy@earthling.net      AERITHFANTASY@EARTHLING.NET

thanx , =)


0
 

Author Comment

by:forns
ID: 1344966
I'll try that, boris.

Brian: wich code do you use to move the form by clicking and moving on it?
0
 
LVL 4

Expert Comment

by:dwwang
ID: 1344967
Why not directly download and try Coolform anyway? as others suggested. It's with full source.
0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344968
to move the form by clicking on it, do this:

Add these lines at the    OnMouseMove     event of any component, for what you need, add it to the TImage OnMouseMove event.
To move the form, add it to the form's OnMouseMove event.

I can send you a program example, just drop me your address.

bryan =)

0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344969
oops.. sorry... forgot the lines....   =(

if ssleft in shift then
   begin
     releasecapture; //restore mouse input to prevent from moving too far
     form1.perform(WM_syscommand, $F012, 0);
   end;

bryan =)

0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344970
try this: ( and Double click on the Onmousemove on the Object Inspector )



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if ssleft in shift then
   begin
   releasecapture; //restore mouse input to prevent from moving too far
   form1.perform(WM_syscommand, $F012, 0);
   end;
end;

end.



ok, now click on the form and move it.

bryan
0
 

Author Comment

by:forns
ID: 1344971
Here's my mail adress:

itg@seker.es

I tried to download the Coolform, but couldn't find it. Can anyone give me some clues such as the www adress of the page to download it or even send it to me via mail.
0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344972
ok, I sent you a zipped program example.
If that's what you need, I'll send you the code and explain you the way to use it.

bryan

0
 

Author Comment

by:forns
ID: 1344973
Hi, bryan.

That's exactly what i was looking for. Could you send me the code and the explain the way to use it to me?
0
 

Author Comment

by:forns
ID: 1344974
Hi, bryan.

That's exactly what i was looking for. Could you send me the code and the explain the way to use it to me?
0
 
LVL 3

Accepted Solution

by:
bryan7 earned 200 total points
ID: 1344975
hey, I sent you long time ago.. did it work ?

bryan
0
 

Author Comment

by:forns
ID: 1344976
Hi, bryan!
I didn't recieve you mail. I asked you to send me the source code of that app.
My adress is: itg@seker.es

I'm giving the points to you, cuz you app is the only one that did what I expected.
See you!
0
 
LVL 3

Expert Comment

by:bryan7
ID: 1344977
? u didn't receive it ?
well, I'll send it again.
I zipped an example, and a txt explaining how to use everything.

I'll mail it tomorrow, so I don't have the Delphi and stuff here, it's all at my job,

bryan
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now