Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project SCREEN2
Project StructureSCREEN2.DPRprogram Screen2; uses Forms, ScreenF in 'ScreenF.pas' {MainForm}, SecondF in 'SecondF.pas' {SecondForm}; {$R *.RES} begin Application.CreateForm(TMainForm, MainForm); Application.Run; end. SCREENF.PASunit ScreenF; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TMainForm = class(TForm) FormsLabel: TLabel; FormsListBox: TListBox; NewButton: TButton; ActiveLabel: TLabel; procedure FormCreate(Sender: TObject); procedure NewButtonClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormsListBoxClick(Sender: TObject); private nForms: Integer; protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public procedure ActiveFormChange (Sender: TObject); procedure FillFormsList; end; var MainForm: TMainForm; implementation {$R *.DFM} uses SecondF; procedure TMainForm.FormCreate(Sender: TObject); begin FillFormsList; // set the secondary forms counter to 0 nForms := 0; // activate an event handler of the screen object Screen.OnActiveFormChange := ActiveFormChange; end; procedure TMainForm.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Showing and (AComponent is TForm) then FillFormsList; end; procedure TMainForm.FillFormsList; var I: Integer; begin FormsLabel.Caption := 'Forms: ' + IntToStr (Screen.FormCount); FormsListBox.Clear; // write class name and form title to the list box for I := 0 to Screen.FormCount - 1 do FormsListBox.Items.Add (Screen.Forms[I].ClassName + ' - ' + Screen.Forms[I].Caption); ActiveLabel.Caption := 'Active Form : ' + Screen.ActiveForm.Caption; end; procedure TMainForm.ActiveFormChange (Sender: TObject); begin FillFormsList; end; procedure TMainForm.NewButtonClick(Sender: TObject); begin // create a new form, set its caption, and run it. with TSecondForm.Create(Application) do begin Inc (nForms); Caption := 'Second ' + IntToStr (nForms); Show; end; end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin // VERY IMPORTANT! disable the event handler to avoid a GPFault Screen.OnActiveFormChange := nil; end; procedure TMainForm.FormsListBoxClick(Sender: TObject); begin // activate the form the user has clicked onto Screen.Forms [FormsListBox.ItemIndex].BringToFront; end; end. SECONDF.PASunit SecondF; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TSecondForm = class(TForm) CloseButton: TButton; procedure CloseButtonClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var SecondForm: TSecondForm; implementation {$R *.DFM} uses ScreenF; procedure TSecondForm.CloseButtonClick(Sender: TObject); begin Close; end; procedure TSecondForm.FormClose(Sender: TObject; var Action: TCloseAction); begin // actually delete the form. Action := caFree; end; end. SCREENF.DFMobject MainForm: TMainForm Left = 229 Top = 155 Width = 296 Height = 253 BorderWidth = 1 Caption = 'Screen Info' Color = clBtnFace ParentFont = True OldCreateOrder = False Visible = True OnClose = FormClose OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object FormsLabel: TLabel Left = 8 Top = 32 Width = 34 Height = 13 Caption = 'Forms: ' end object ActiveLabel: TLabel Left = 8 Top = 8 Width = 56 Height = 13 Caption = 'ActiveLabel' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False end object FormsListBox: TListBox Left = 8 Top = 48 Width = 273 Height = 169 ItemHeight = 13 TabOrder = 0 OnClick = FormsListBoxClick end object NewButton: TButton Left = 232 Top = 8 Width = 49 Height = 25 Caption = 'New' TabOrder = 1 OnClick = NewButtonClick end end SECONDF.DFMobject SecondForm: TSecondForm Left = 223 Top = 153 Width = 144 Height = 118 Caption = 'Second' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = True Position = poDefaultPosOnly OnClose = FormClose PixelsPerInch = 96 TextHeight = 13 object CloseButton: TButton Left = 40 Top = 31 Width = 56 Height = 28 Caption = 'Close' TabOrder = 0 OnClick = CloseButtonClick end end
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |