Solved

Force repaint of form inside TTabsheet / TPagecontrol

Posted on 2011-09-05
7
1,810 Views
Last Modified: 2012-05-12
I found some nice code by both Marco Cantu and Zarko that puts a form inside a TPagecontrol like this:

 
procedure Tfrm_FrontMain.tsStatistikShow(Sender: TObject);
    var
      Sheet: TTabSheet;

begin

     if FrmStatistik=Nil then begin
        if (Sender is TTabSheet)=False then raise Exception.Create('Should be tabsheet');
        Sheet:=Sender as TTabsheet;
        FrmStatistik:=TFrmStatistik.Create(Self);
        with FrmStatistik do begin
           Visible:=False;
           BorderStyle:=bsNone;
           Align:=alClient;
           Parent:=Sheet;
           Visible:=True;
        end;
           Sheet.PageControl.ActivePage:=Sheet;
     end;
end;

Open in new window


I have done one change, I dont create a new PageSheet - i use an existing and that creates a problem. Im using the "OnShow" event of the Tabsheet to create the form (tsStatistikShow) . The form does get created, but remains invisible until i change the active page and then clicks back to the tab that holds the form.

How can I get the form to be painted when its is created?
0
Comment
Question by:Sunsales
7 Comments
 
LVL 11

Expert Comment

by:dougaug
Comment Utility
Change your code and put it on the OnCreate event of the pagesheet's parent form:

procedure Tfrm_FrontMain.OnCreate(Sender: TObject);
    var
      Sheet: TTabSheet;

begin

     if FrmStatistik=Nil then begin
        Sheet:=PageControl1.Pages[0];
        FrmStatistik:=TFrmStatistik.Create(Self);
        with FrmStatistik do begin
           Visible:=False;
           BorderStyle:=bsNone;
           Align:=alClient;
           Parent:=Sheet;
           Visible:=True;
        end;
     end;
end;
0
 

Author Comment

by:Sunsales
Comment Utility
Thanx, but that have one drawback. For speed I don't want to create the form until the user select the tab. But it is a working solution so if there is no other answer i will accept it. I did find one way - to let the form send a message to itself:

 
uses ...

const
  WM_MY_MESSAGE = WM_USER + 0;


private

procedure OnMyMessage(var Msg: TMessage); message WM_MY_MESSAGE;

implementation

procedure Tfrm_FrontMain.OnMyMessage(var Msg: TMessage);
begin
    PageControl1.ActivePage.Visible:=False;
    PageControl1.ActivePage.Visible:=True;
end;

procedure Tfrm_FrontMain.tsStatistikShow(Sender: TObject);
    var
      Sheet: TTabSheet;

begin
     if FrmStatistik=Nil then begin
        if (Sender is TTabSheet)=False then raise Exception.Create('Should be tabsheet');
        Sheet:=Sender as TTabsheet;
        Sheet.Visible:=False;
        FrmStatistik:=TFrmStatistik.Create(Self);
        with FrmStatistik do begin
           Visible:=False;
           BorderStyle:=bsNone;
           Align:=alClient;
           Parent:=Sheet;
           Visible:=True;

        end;
           Sheet.PageControl.ActivePage:=Sheet;
           PostMessage(self.Handle,WM_MY_MESSAGE,0,0); // This one does it
     end;
end;

Open in new window


0
 
LVL 13

Expert Comment

by:Ashok
Comment Utility
I am not sure, but try following instead of PostMessage(.....) line.

PageControl1Change(Self);
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 13

Expert Comment

by:Ashok
Comment Utility
Try changing this line

FrmStatistik:=TFrmStatistik.Create(Sheet);
0
 
LVL 6

Expert Comment

by:bokist
Comment Utility
Try this way :

  In ObjectInspector at design time set  FrmStatistik  Visible  -> False

 with FrmStatistik do begin
           BorderStyle:=bsNone;
           FormStyle := fsNormal;
           SetWindowPos(FrmStatistik.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
           Application.NormalizeTopMosts;
           Visible := True;
           Update;
           Application.ProcessMessages;
        end;
0
 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 500 total points
Comment Utility
have you tried something like this
(i you have questions, please ask)

it creates 2 different form class instances in the 4 tabsheets
(notice not using the form variable)

main unit
unit uMain;

interface

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

type
  TFrmMain = class(TForm)
    pcMain: TPageControl;
    tsPage1: TTabSheet;
    tsPage2: TTabSheet;
    tsPage3: TTabSheet;
    tsPage4: TTabSheet;
    procedure tsPageShow(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    function PageFormClass(aPage: Integer): TCustomFormClass;
    function GetTabForms(Index: Integer): TForm;
  protected
    procedure ShowPageInTab(aTab: TTabSheet; aPage: Integer);
  public
    property TabForms[Index: Integer]: TForm read GetTabForms;
  end;

var
  FrmMain: TFrmMain;

implementation

uses uPage1, uPage2;

{$R *.dfm}

procedure TFrmMain.FormShow(Sender: TObject);
begin
  pcMain.ActivePage := tsPage1;
end;

function TFrmMain.GetTabForms(Index: Integer): TForm;
var
  tab: TTabSheet;
  I: Integer;
begin
  Result := nil;
  tab := pcMain.Pages[Index];
  for I := 0 to tab.ControlCount- 1 do
    if tab.Controls[I] is TForm then
    begin
      Result := TForm(tab.Controls[I]);
      Break;
    end;
end;

function TfrmMain.PageFormClass(aPage: Integer): TCustomFormClass;
begin
  Result := TForm;
  case aPage of
    1: Result := TfrmPage1;
    2: Result := TfrmPage2;
    3: Result := TfrmPage1;
    4: Result := TfrmPage2;
  end;
end;

procedure TFrmMain.ShowPageInTab(aTab: TTabSheet; aPage: Integer);
var frm: TForm;
begin
  if Assigned(aTab) then
  begin
    frm := TabForms[aTab.TabIndex];
    if not Assigned(frm) then
    begin
      frm := TForm(PageFormClass(aPage).Create(Self));
      frm.Parent := aTab;
      frm.BorderStyle := bsNone;
      frm.Align := alClient;
    end;
    frm.Show;
    frm.Update;
    aTab.Update;
  end;
end;

procedure TFrmMain.tsPageShow(Sender: TObject);
begin
  ShowPageInTab(TTabSheet(Sender), TTabSheet(Sender).Tag);
end;

end.

Open in new window


form code main unit
object FrmMain: TFrmMain
  Left = 250
  Top = 160
  Caption = 'FrmMain'
  ClientHeight = 561
  ClientWidth = 956
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object pcMain: TPageControl
    Left = 0
    Top = 0
    Width = 956
    Height = 561
    ActivePage = tsPage4
    Align = alClient
    TabOrder = 0
    object tsPage1: TTabSheet
      Tag = 1
      Caption = 'tsPage1'
      OnShow = tsPageShow
      ExplicitWidth = 689
      ExplicitHeight = 333
    end
    object tsPage2: TTabSheet
      Tag = 2
      Caption = 'tsPage2'
      ImageIndex = 1
      OnShow = tsPageShow
      ExplicitWidth = 689
      ExplicitHeight = 333
    end
    object tsPage3: TTabSheet
      Tag = 3
      Caption = 'tsPage3'
      ImageIndex = 2
      OnShow = tsPageShow
      ExplicitWidth = 689
      ExplicitHeight = 333
    end
    object tsPage4: TTabSheet
      Tag = 4
      Caption = 'tsPage4'
      ImageIndex = 3
      OnShow = tsPageShow
      ExplicitLeft = 8
      ExplicitTop = 28
    end
  end
end

Open in new window


sample unit for uPage1
unit uPage1;

interface

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

type
  TfrmPage1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmPage1: TfrmPage1;

implementation

{$R *.dfm}

end.

Open in new window


sample unit for uPage2
unit uPage2;

interface

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

type
  TfrmPage2 = class(TForm)
    Memo1: TMemo;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmPage2: TfrmPage2;

implementation

{$R *.dfm}

end.

Open in new window

0
 

Author Closing Comment

by:Sunsales
Comment Utility
Really nice, thank you.
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

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…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

762 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

7 Experts available now in Live!

Get 1:1 Help Now