File: frmexportprogress.pp

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (82 lines) | stat: -rw-r--r-- 1,791 bytes parent folder | download | duplicates (10)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
{
 **********************************************************************
  This file is part of the Free Pascal run time library.

  See the file COPYING.FPC, included in this distribution,
  for details about the license.
 **********************************************************************

 DataExport progress bar form.

 Copyright (c) 2007 by Michael Van Canneyt, member of the Free Pascal development team
}
unit frmexportprogress;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, sdb_consts;

type

  { TExportProgressForm }

  TExportProgressForm = class(TForm)
    BCancel: TButton;
    LProgress: TLabel;
    PBExport: TProgressBar;
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    FCount : Integer;
    function GetOnCancel: TNotifyEvent;
    procedure SetOnCancel(const AValue: TNotifyEvent);
  public
    { public declarations }
    Procedure StepIt;
    Property OnCancel : TNotifyEvent Read GetOnCancel Write SetOnCancel;
  end;

var
  ExportProgressForm: TExportProgressForm;

implementation

{$R *.lfm}

{ TExportProgressForm }

procedure TExportProgressForm.FormCreate(Sender: TObject);
begin
  //
  Caption := sdb_Exportprogress;
  LProgress.Caption:= Format(SProgress,[0]);
  BCancel.Caption:= sdb_Cancel;
  //
end;

function TExportProgressForm.GetOnCancel: TNotifyEvent;
begin
  Result:=BCancel.OnClick;
end;

procedure TExportProgressForm.SetOnCancel(const AValue: TNotifyEvent);
begin
  BCancel.OnClick:=AValue;
end;

procedure TExportProgressForm.StepIt;
begin
  Inc(FCount);
  LProgress.Caption:=Format(SProgress,[FCount]);
  If (PBExport.Position>=PBExport.Max) then
    PBExport.Position:=0;
  PBExport.StepIt;
  Application.ProcessMessages;
end;

end.