Solved

Force repaint of form inside TTabsheet / TPagecontrol

Posted on 2011-09-05
7
1,892 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
ID: 36485996
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
ID: 36486064
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
ID: 36486391
I am not sure, but try following instead of PostMessage(.....) line.

PageControl1Change(Self);
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 13

Expert Comment

by:Ashok
ID: 36486430
Try changing this line

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

Expert Comment

by:bokist
ID: 36488054
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 37

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 36491055
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
ID: 36525165
Really nice, thank you.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Strange code, can use it, but i cant figure out what it does. 3 65
Correct Component for Shopping Cart. 2 112
oracle global variables 4 76
Create a path if not exists 7 86
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

791 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