source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/SearchAnimationU.pas@ 1593

Last change on this file since 1593 was 801, checked in by Kevin Toppenberg, 14 years ago

Bug fixes. Improved Adding Image

File size: 4.1 KB
Line 
1unit SearchAnimationU;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, ImgList;
8
9type
10 TfrmTMGServerSearch = class(TForm)
11 AnimationImageList: TImageList;
12 AnimationImage: TImage;
13 lblSearching: TLabel;
14 ProgressBar: TProgressBar;
15 btnCancel: TBitBtn;
16 AnimationTimer: TTimer;
17 CheckServerTimer: TTimer;
18 lblMessages: TLabel;
19 procedure AnimationTimerTimer(Sender: TObject);
20 procedure FormCreate(Sender: TObject);
21 procedure FormDestroy(Sender: TObject);
22 procedure FormShow(Sender: TObject);
23 procedure FormHide(Sender: TObject);
24 procedure btnCancelClick(Sender: TObject);
25 procedure CheckServerTimerTimer(Sender: TObject);
26 private
27 { Private declarations }
28 ImageIndex : integer;
29 Picture : TPicture;
30 FJobNumber : string;
31 procedure UpdatePicture;
32 function JobActive(JobNumber : String; OUT PercentDone : Integer;
33 OUT Comments : string): Boolean;
34 public
35 { Public declarations }
36 FoundRecsCount : string; //Out parameter only.
37 function ActivateForm(JobNumber : string) : integer;
38 end;
39
40var
41 frmTMGServerSearch: TfrmTMGServerSearch;
42
43implementation
44
45{$R *.dfm}
46
47 uses ORNet, ORFn, Trpcb, ORCtrls;
48
49 const
50 MAX_NUM_IMAGE_INDEX = 15;
51
52
53 procedure TfrmTMGServerSearch.FormCreate(Sender: TObject);
54 begin
55 ImageIndex := 0;
56 Picture := TPicture.Create;
57 end;
58
59 procedure TfrmTMGServerSearch.FormDestroy(Sender: TObject);
60 begin
61 Picture.Free;
62 end;
63
64 procedure TfrmTMGServerSearch.FormShow(Sender: TObject);
65 begin
66 AnimationTimer.Enabled := true;
67 CheckServerTimer.Enabled := true;
68 end;
69
70 procedure TfrmTMGServerSearch.FormHide(Sender: TObject);
71 begin
72 AnimationTimer.Enabled := false;
73 CheckServerTimer.Enabled := false;
74 end;
75
76 function TfrmTMGServerSearch.ActivateForm(JobNumber : string) : integer;
77 begin
78 FJobNumber := JobNumber;
79 Result := ShowModal;
80 end;
81
82 procedure TfrmTMGServerSearch.UpdatePicture;
83 begin
84 Inc(ImageIndex);
85 if ImageIndex > MAX_NUM_IMAGE_INDEX then ImageIndex := 0;
86 AnimationImageList.GetBitmap(ImageIndex,Picture.Bitmap);
87 AnimationImage.Picture.Assign(Picture);
88 end;
89
90 procedure TfrmTMGServerSearch.AnimationTimerTimer(Sender: TObject);
91 begin
92 AnimationTimer.Enabled := false;
93 UpdatePicture;
94 AnimationTimer.Enabled := true;
95 end;
96
97 procedure TfrmTMGServerSearch.CheckServerTimerTimer(Sender: TObject);
98 var PctDone : Integer;
99 Comments : string;
100 begin
101 CheckServerTimer.Enabled := false;
102 if JobActive(FJobNumber, PctDone, Comments) = false then begin
103 ModalResult := mrOK;
104 end;
105 ProgressBar.Position := PctDone;
106 lblMessages.Caption := Comments;
107 CheckServerTimer.Enabled := true;
108 end;
109
110
111 procedure TfrmTMGServerSearch.btnCancelClick(Sender: TObject);
112 begin
113 //Do anything needed here before closing form.
114 //(Hide function is executed next)
115 Self.ModalResult := mrCancel;
116 end;
117
118
119 function TfrmTMGServerSearch.JobActive(JobNumber : String;
120 OUT PercentDone : Integer;
121 OUT Comments : string): Boolean;
122 //Check the job status
123 var cmd, RPCResult : string;
124 begin
125 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
126 RPCBrokerV.param[0].ptype := list;
127 RPCBrokerV.Param[0].Value := '.X';
128 cmd := 'STATUS';
129 cmd := cmd + '^' + JobNumber;
130 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
131 //RPCBrokerV.Call;
132 CallBroker;
133 if RPCBrokerV.Results.Count > 0 then begin
134 RPCResult := RPCBrokerV.Results[0];
135 //Check piece 1 for -1 that indicates an error...
136 if Piece(RPCResult,'^',1) = '-1' then begin
137 result := false;
138 exit;
139 end;
140 PercentDone := StrToIntDef(piece(RPCResult,'^',2),0);
141 Comments := piece(RPCResult,'^',3);
142 FoundRecsCount := piece(RPCResult,'^',4);
143 Result := (Comments <> '#DONE#');
144 end else begin
145 result := true;
146 end;
147 end;
148
149
150
151
152end.
153
Note: See TracBrowser for help on using the repository browser.