[fpc-pascal] TFPTimer: how can I use it to closse a window?

Graeme Geldenhuys graemeg.lists at gmail.com
Fri Jul 9 10:27:38 CEST 2010


Op 2010-07-09 09:54, luca_manganelli at comune.trento.it het geskryf:

> 
> How can I do it?

You don't say what GUI toolkit you are using, but either way, the usage
should be very similar. Here is a working example of what you want using
fpGUI Toolkit.

Basic usage:
  * you set the interval in milliseconds
  * you define the OnTimer event handler
  * you start the timer via .StartTimer.
  * Under Linux you need cthreads because the FPTimer using threading.

--------------------[ project1.pas ]-----------------------------
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, fpg_main, fpg_form, fpg_label, fpg_button, fpTimer;

type

  TMainForm = class(TfpgForm)
    procedure ButtonPressed(Sender: TObject);
  public
    {@VFD_HEAD_BEGIN: MainForm}
    Button1: TfpgButton;
    {@VFD_HEAD_END: MainForm}
    procedure AfterCreate; override;
  end;

  TTimedForm = class(TfpgForm)
    procedure TimerFired(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClosing(Sender: TObject; var CloseAction: TCloseAction);
  private
    {@VFD_HEAD_BEGIN: TimedForm}
    Label1: TfpgLabel;
    {@VFD_HEAD_END: TimedForm}
    FTimer: TFPTimer;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AfterCreate; override;
  end;

{@VFD_NEWFORM_DECL}



{@VFD_NEWFORM_IMPL}

procedure TTimedForm.TimerFired(Sender: TObject);
begin
  Close;
end;

procedure TTimedForm.FormShow(Sender: TObject);
begin
  // only start the timer when the form is actually visible
  FTimer.StartTimer;
end;

procedure TTimedForm.FormClosing(Sender: TObject; var CloseAction:
TCloseAction);
begin
  CloseAction := caFree;
end;

constructor TTimedForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TFPTimer.Create(self);
  FTimer.Interval := 15000; // in milliseconds
  FTimer.OnTimer  := @TimerFired;
  OnShow  := @FormShow;
  OnClose  := @FormClosing;
end;

procedure TTimedForm.AfterCreate;
begin
  {%region 'Auto-generated GUI code' -fold}
  {@VFD_BODY_BEGIN: TimedForm}
  Name := 'TimedForm';
  SetPosition(438, 398, 277, 95);
  WindowTitle := 'TimedForm';
  Hint := '';

  Label1 := TfpgLabel.Create(self);
  with Label1 do
  begin
    Name := 'Label1';
    SetPosition(68, 40, 148, 16);
    Alignment := taCenter;
    FontDesc := '#Label1';
    Hint := '';
    Text := 'Show for 15 seconds';
  end;

  {@VFD_BODY_END: TimedForm}
  {%endregion}
end;

procedure TMainForm.ButtonPressed(Sender: TObject);
var
  frm: TTimedForm;
begin
  frm := TTimedForm.Create(nil);
  frm.Show;
end;

procedure TMainForm.AfterCreate;
begin
  {%region 'Auto-generated GUI code' -fold}
  {@VFD_BODY_BEGIN: MainForm}
  Name := 'MainForm';
  SetPosition(316, 186, 300, 250);
  WindowTitle := 'MainForm';
  Hint := '';

  Button1 := TfpgButton.Create(self);
  with Button1 do
  begin
    Name := 'Button1';
    SetPosition(116, 44, 80, 24);
    Text := 'Button';
    FontDesc := '#Label1';
    Hint := '';
    ImageName := '';
    TabOrder := 1;
    OnClick  := @ButtonPressed;
  end;

  {@VFD_BODY_END: MainForm}
  {%endregion}
end;


procedure MainProc;
var
  frm: TMainForm;
begin
  fpgApplication.Initialize;
  frm := TMainForm.Create(nil);
  try
    frm.Show;
    fpgApplication.Run;
  finally
    frm.Free;
  end;
end;

{$R *.res}

begin
  MainProc;
end.

----------------------------------------------------


Regards,
  - Graeme -

-- 
fpGUI Toolkit - a cross-platform GUI toolkit using Free Pascal
http://opensoft.homeip.net/fpgui/




More information about the fpc-pascal mailing list