Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 252
  • Last Modified:

transparent form

How can i make the form transparent and can click or make other program active when click inside my transparent form.

0
girlswants_me
Asked:
girlswants_me
  • 6
  • 2
  • 2
  • +2
1 Solution
 
girlswants_meAuthor Commented:
helpme please
0
 
MotazCommented:
Set form's BorderStyle to None.
at form's OnCreate event write:

  Self.Brush.Style:= bsClear;

About your second part, actually I don't know how to do it
0
 
girlswants_meAuthor Commented:
i already know that one i need the second part
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
ITugayCommented:
Hi girlswants_me,

all forms has assigned windowsregion. You can play with regions to make hole in you forms or compose form's region from few rectangle or ellipse regions. Rest part of the form will be transparent for mouse as well as for eye.

Look at SetWindowRgn API function.

-----
Igor
0
 
girlswants_meAuthor Commented:
can you make me some codes for it? please
0
 
ginsonicCommented:
This is a classic sample, named 'Dougnut':

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    rTitleBar : THandle;
    Center    : TPoint;
    SB1       : TSpeedButton;
    RL, RR    : Double;
    procedure TitleBar(Act : Boolean);
    procedure WMNCHITTEST(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE); message WM_NCACTIVATE;
    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
VAR
  rTemp, rTemp2    : THandle;
  Vertices : ARRAY[0..2] OF TPoint;
  X, Y     : INteger;
  CapY     : Integer;
begin
  Caption := 'OOOH! Doughnuts!';
  BorderStyle := bsNone; {required}
  IF Width > Height THEN Width := Height
  ELSE Height := Width;  {harder to calc if width <> height}
  Center  := Point(Width DIV 2, Height DIV 2);
  CapY := GetSystemMetrics(SM_CYCAPTION)+8;
  rTemp := CreateEllipticRgn(0, 0, Width, Height);
  rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),
    3*(Width DIV 4), 3*(Height DIV 4));
  CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);
  SetWindowRgn(Handle, rTemp, True);
  DeleteObject(rTemp2);
  rTitleBar  := CreateEllipticRgn(4, 4, Width-4, Height-4);
  rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);
  Vertices[0] := Point(0,0);
  Vertices[1] := Point(Width, 0);
  Vertices[2] := Point(Width DIV 2, Height DIV 2);
  rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);
  DeleteObject(rTemp);
  RL := ArcTan(Width / Height);
  RR := -RL + (22 / Center.X);
  X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));
  Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));
  SB1 := TSpeedButton.Create(Self);
  WITH SB1 DO
    BEGIN
      Parent     := Self;
      Left       := X;
      Top        := Y;
      Width      := 14;
      Height     := 14;
      OnClick    := Button1Click;
      Caption    := 'X';
      Font.Style := [fsBold];
    END;
end;

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

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
  Inherited;
  WITH Msg DO
    WITH ScreenToClient(Point(XPos,YPos)) DO
      IF PtInRegion(rTitleBar, X, Y) AND
       (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN
        Result := htCaption;
end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
  Inherited;
  TitleBar(Msg.Active);
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  Inherited;
  TitleBar(Active);
end;

procedure TForm1.TitleBar(Act: Boolean);
CONST
  TitlColors: ARRAY[Boolean] OF TColor = (clInactiveCaption, clActiveCaption);
  TxtColors: ARRAY[Boolean] OF TColor = (clInactiveCaptionText, clCaptionText);
VAR
  TF      : TLogFont;
  R       : Double;
  N, X, Y : Integer;
begin
  IF Center.X = 0 THEN Exit;
  WITH Canvas DO
    begin
      Brush.Style := bsSolid;
      Brush.Color := TitlColors[Act];
      PaintRgn(Handle, rTitleBar);
      R  := RL;
      Brush.Color := TitlColors[Act];
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Color := TxtColors[Act];
      Font.Style := [fsBold];
      GetObject(Font.Handle, SizeOf(TLogFont), @TF);
      FOR N := 1 TO Length(Caption) DO
        BEGIN
          X := Center.X-Round((Center.X-6)*Sin(R));
          Y := Center.Y-Round((Center.Y-6)*Cos(R));
          TF.lfEscapement := Round(R * 1800 / pi);
          Font.Handle := CreateFontIndirect(TF);
          TextOut(X, Y, Caption[N]);
          R := R - (((TextWidth(Caption[N]))+2) / Center.X);
          IF R < RR THEN Break;
        END;
      Font.Name := 'MS Sans Serif';
      Font.Size := 8;
      Font.Color := clWindowText;
      Font.Style := [];
    end;
  SB1.Repaint;
end;


procedure TForm1.FormPaint(Sender: TObject);
begin
  WITH Canvas DO
    BEGIN
      Brush.Style := bsClear;
      // Outer edge
        Pen.Width := 4;
        Pen.Color := cl3DLight;
        Arc(0, 0, Width, Height, Width, 0, 0, Height);
        Pen.Color := clBtnShadow;
        Arc(0, 0, Width, Height, 0, Height, Width, 0);
        Pen.Width := 2;
        Pen.Color := clBtnHighlight;
        Arc(0, 0, Width, Height, Width, 0, 0, Height);
        Pen.Color := cl3DDkShadow;
        Arc(0, 0, Width, Height, 0, Height, Width, 0);
      // Inner edge
        Pen.Width := 4;
        Pen.Color := clBtnHighlight;
        Arc(Width DIV 4, Height DIV 4,
          3*(Width DIV 4), 3*(Height DIV 4), 0, Height, Width, 0);
        Pen.Color := clBtnShadow;
        Arc(Width DIV 4, Height DIV 4,
          3*(Width DIV 4), 3*(Height DIV 4), Width, 0, 0, Height);
        Pen.Width := 2;
        Pen.Color := cl3DLight;
        Arc(Width DIV 4, Height DIV 4,
          3*(Width DIV 4), 3*(Height DIV 4), 0, Height, Width, 0);
        Pen.Color := cl3DDkShadow;
        Arc(Width DIV 4, Height DIV 4,
          3*(Width DIV 4), 3*(Height DIV 4), Width, 0, 0, Height);
    END;
  TitleBar(Active);
end;

end.
0
 
girlswants_meAuthor Commented:
you know what ginsonic your CODE works fine and its very GOOD. but a little i dont understand some codes you delivered. well hope you can change it to..
  only at the middle side of the form will be transparent
 and with 200width size and 200height size. with borders and form is on NORMAL mode.
0
 
girlswants_meAuthor Commented:
i will raise the points to 100
0
 
ITugayCommented:
place this code onCreateForm

var
  R1, R2, R3: HRgn;
begin
  R1 := CreateRectRgn(0, 0, Width, Height);
  R2 := CreateRectRgn(40, 40, Width - 40, Height - 40);
  R3 := CreateRectRgn(60, 60, Width - 60, Height - 60);
  CombineRgn(R1, R1, R2, RGN_DIFF);
  CombineRgn(R1, R1, R3, RGN_OR);
  SetWindowRgn(Handle, R1, False);
  DeleteObject(R2);
  DeleteObject(R3);

------
Igor
0
 
girlswants_meAuthor Commented:
Thank you so much i already edited your code it works fine.
0
 
lottolCommented:
About transperancy.
Previous decision isn't good, if you want to move you from

If you need full transparent form it's better to use SetLayeredWindowAttributes, but it'd not work for Win98, NT 4.

This function is described here http://www.delphipages.com/news/detaildocs.cfm?ID=63
0
 
lottolCommented:
Sorry. I didn't update page, so I didn't see answer
0
 
ginsonicCommented:
Just a B grade ? :(
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 2
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now