howto make a TPageControl transparent

mhervais
mhervais used Ask the Experts™
on
and its relative sheets as well

All I would like to see on my pages are
the tabs, and the controls I drop on the pages.

This is because I have under the page control a nice image that I would like to see on the background

Another solution that would suit me would be to use the Canvas property of the TPageControl, to load this image when I create the form (if I have not to duplicate it over the tabsheets)

If you answer both ways, I will raise the reward to 120 points

Sorry about that it it is simple but I am generally useless as soon as it goes about drawing

regards Marc
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Listening

Author

Commented:
Hi RWilson. If you don't have the answer to that one I will begin to thinhk ythat it is not such an easy question :-(
Commented:
hi,
i have 2 examples of second method
the first draws the bmp on the sheets and the second example also adds the background on to the background of pagecontrol(hard to explain but you will see what i mean when you try examples ;-):

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    RadioButton1: TRadioButton; //component on  tabsheet1
    RadioButton2: TRadioButton; //component on  tabsheet1
    CheckBox1: TCheckBox;  //component on  tabsheet2
    CheckBox2: TCheckBox;  //component on  tabsheet2
    Memo1: TMemo;          //component on  tabsheet3
    DateTimePicker1: TDateTimePicker;  //component on  tabsheet4
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
 Background: TBitmap;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  close
end;
 
Function TabWndProc( wnd: HWND; msg: Cardinal;
          wparam: WPARAM; lparam: LPARAM ): Integer; stdcall;
var
  canvas: TCanvas;
  x, y: Integer;
  r: TRect;
  OldTabWndProc: Pointer;
begin
  If Msg = WM_ERASEBKGND Then Begin
    // tile window background with bitmap
    Result := 1;
    GetClientRect( wnd, r );
    canvas:= TCanvas.Create;
    try
      canvas.handle := HDC( wparam );
      y := 0;
      While y < r.Bottom Do Begin
        x:= 0;
        While x < r.right Do Begin
          canvas.Draw( x, y, Background );
          Inc( x, Background.Width );
        End;
        Inc( y, Background.Height );
      End;
    finally
      canvas.handle := 0;
      canvas.free;
    end;
  End
  Else Begin
    // pass message to old window proc
    OldTabWndProc := Pointer( GetWindowLong( wnd, GWL_USERDATA ));     Result := CallWindowProc( OldTabWndProc, wnd, msg, wparam, lparam );
  End;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  Background := TBitmap.Create;
  // could load bitmap from a resource here
  Background.Loadfromfile('C:\WINDOWS\KUGELN.BMP');
 
  // subclass the tabsheets, store old window proc in GWL_USERDATA   // field of window structure
  For i:= 0 to pagecontrol1.PageCount-1 do
    SetWindowLong( pagecontrol1.Pages[i].handle, GWL_USERDATA,
      SetWindowLong(pagecontrol1.Pages[i].handle,
                    GWL_WNDPROC, Integer(@TabWndProc)));
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Background.Free;
end;
 
end.
Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

Commented:
second example with thanks to "peter below of teamB":

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    RadioButton1: TRadioButton; //component on  tabsheet1
    RadioButton2: TRadioButton; //component on  tabsheet1
    CheckBox1: TCheckBox;  //component on  tabsheet2
    CheckBox2: TCheckBox;  //component on  tabsheet2
    Memo1: TMemo;          //component on  tabsheet3
    DateTimePicker1: TDateTimePicker;  //component on  tabsheet4
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PageControl1DrawTab(Control: TCustomTabControl;
      TabIndex: Integer; const Rect: TRect; Active: Boolean);
  private
    { Private declarations }
    FOldPageCOntrolWndProc: TWndMethod;
    procedure PageControlWndProc( Var Msg: TMessage );
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
 Background: TBitmap;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  close
end;
 
Function TabWndProc( wnd: HWND; msg: Cardinal;
          wparam: WPARAM; lparam: LPARAM ): Integer; stdcall;
var
  canvas: TCanvas;
  x, y: Integer;
  r: TRect;
  OldTabWndProc: Pointer;
begin
  If Msg = WM_ERASEBKGND Then Begin
    // tile window background with bitmap
    Result := 1;
    GetClientRect( wnd, r );
    canvas:= TCanvas.Create;
    try
      canvas.handle := HDC( wparam );
      y := 0;
      While y < r.Bottom Do Begin
        x:= 0;
        While x < r.right Do Begin
          canvas.Draw( x, y, Background );
          Inc( x, Background.Width );
        End;
        Inc( y, Background.Height );
      End;
    finally
      canvas.handle := 0;
      canvas.free;
    end;
  End
  Else Begin
    // pass message to old window proc
    OldTabWndProc := Pointer( GetWindowLong( wnd, GWL_USERDATA ));     Result := CallWindowProc( OldTabWndProc, wnd, msg, wparam, lparam );
  End;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  Background := TBitmap.Create;
  // could load bitmap from a resource here
  Background.Loadfromfile('C:\WINDOWS\KUGELN.BMP');
 
  // subclass the tabsheets, store old window proc in GWL_USERDATA   // field of window structure
  For i:= 0 to pagecontrol1.PageCount-1 do
    SetWindowLong( pagecontrol1.Pages[i].handle, GWL_USERDATA,
      SetWindowLong(pagecontrol1.Pages[i].handle,
                    GWL_WNDPROC, Integer(@TabWndProc)));
FoldPageControlWndProc := Pagecontrol1.WindowProc;
Pagecontrol1.WindowProc := PageControlWndProc;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Background.Free;
end;

procedure TForm1.PageControlWndProc(var Msg: TMessage);
var
  canvas: TCanvas;
  x, y: Integer;
  r: TRect;
begin
  If msg.Msg = WM_ERASEBKGND Then Begin
    msg.Result := 1;
    r:= pagecontrol1.clientrect;
    canvas:= TCanvas.Create;
    try
      canvas.handle := HDC(msg.wparam);
      y := 0;
      While y < r.Bottom Do Begin
        x:= 0;
        While x < r.right Do Begin
          canvas.Draw( x, y, Background );
          Inc( x, Background.Width );
        End;
        Inc( y, Background.Height );
      End;
    finally
      canvas.handle := 0;
      canvas.free;
    end;
  End
  Else
    FOldPageControlWndProc( Msg );
end;
 
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;   TabIndex: Integer; const Rect: TRect; Active: Boolean);
begin
  If Active Then
    Control.Canvas.Font.Style := [fsBold]
  Else
    Control.Canvas.Font.Style := [];
  Control.Canvas.Font.Color := clWhite;
  SetBKMode( control.canvas.handle, TRANSPARENT );
  Control.Canvas.TextOut( rect.left+2, rect.top+2,
                          (Control As
TPageControl).Pages[TabIndex].Caption );
end;

end.

Author

Commented:
Thanks Barry It looks like what I need.

I am going on hollidays for one week tomorrow morning (it is 10:30 pm here)
and I don't want you to wait like last time

so I will give you the points now.

If somebody has a solution on the first method, I am still client

regards,

Marc

Author

Commented:
I would never have found this one myself

:-)

Commented:
cheers
i never seen a transparent pagecontrol component or code (i also looked for one a while ago)so if you find one please let me know  ;-)

have a happy holiday
Regards Barry

Author

Commented:
thanks Barry I'l not bring my computer :-))))))

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial