source: cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas@ 748

Last change on this file since 748 was 738, checked in by Kevin Toppenberg, 15 years ago

Fixed Text Object Parameters
File size: 43.7 KB
RevLine 
[453]1unit fImages; //kt Entire unit and form added 8/19/05
2{$O-}
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fPage, StdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConst, ORDtTm,
9 uPCE, ORClasses, fDrawers, ImgList, rTIU, uTIU, uDocTree, fRptBox, fPrintList,
10 OleCtrls, SHDocVw,
11 ORNet, TRPCB, fHSplit, Buttons, ExtDlgs, DKLang;
12
13type
14 TImageInfo = class
15 private
16 public
17 IEN : int64; //IEN in file# 2005
18 ServerPathName : AnsiString;
19 ServerFName : AnsiString;
20 ServerThumbPathName: AnsiString;
21 ServerThumbFName : AnsiString;
22 //Note: if there is no thumbnail to download, CacheThumbFName will still
23 // contain a file name and path, but a test for FileExists() will wail.
24 CacheThumbFName : AnsiString; // local cache path and File name of thumbnail image
25 CacheFName : AnsiString; // local cache path and File name of image
26 ShortDesc : AnsiString;
27 LongDesc : TStringList; //will be nil unless holds data.
28 DateTime : AnsiString; //fileman format
29 ImageType : Integer;
30 ProcName : AnsiString;
31 DisplayDate : AnsiString;
32 ParentDataFileIEN: int64;
33 AbsType : char; //'M' magnetic 'W' worm 'O' offline
34 Accessibility : char; //'A' accessable or 'O' offline
35 DicomSeriesNum : int64;
36 DicomImageNum : int64;
37 GroupCount : integer;
38 TabIndex : integer;
39 TabImageIndex : integer;
40
41 published
42 end;
43
44 TfrmImages = class(TfrmPage)
45 mnuNotes: TMainMenu;
46 mnuView: TMenuItem;
47 mnuViewChart: TMenuItem;
48 mnuChartReports: TMenuItem;
49 mnuChartLabs: TMenuItem;
50 mnuChartDCSumm: TMenuItem;
51 mnuChartCslts: TMenuItem;
52 mnuChartNotes: TMenuItem;
53 mnuChartOrders: TMenuItem;
54 mnuChartMeds: TMenuItem;
55 mnuChartProbs: TMenuItem;
56 mnuChartCover: TMenuItem;
57 mnuAct: TMenuItem;
58 Z3: TMenuItem;
59 mnuOptions: TMenuItem;
60 timLoadImages: TTimer;
61 N3: TMenuItem;
62 mnuIconLegend: TMenuItem;
63 mnuChartSurgery: TMenuItem;
64 ThumbsImageList: TImageList;
65 CurrentNoteMemo: TMemo;
[729]66 pnlTop: TPanel;
67 HorizSplitter: TSplitter;
[453]68 Splitter2: TSplitter;
69 UploadImagesButton: TBitBtn;
70 OpenPictureDialog: TOpenPictureDialog;
71 ButtonPanel: TPanel;
72 CurrentImageMemo: TMemo;
73 MemosPanel: TPanel;
74 UploadImagesMnuAction: TMenuItem;
[729]75 pnlBottom: TPanel;
[453]76 TabControl: TTabControl;
77 WebBrowser: TWebBrowser;
[729]78 AutoScanUpload: TMenuItem;
79 PickScanFolder: TMenuItem;
80 OpenDialog: TOpenDialog;
[453]81 procedure mnuChartTabClick(Sender: TObject);
82 procedure mnuActNewClick(Sender: TObject);
83 procedure timLoadImagesTimer(Sender: TObject);
84 procedure FormCreate(Sender: TObject);
85 procedure FormDestroy(Sender: TObject);
86 procedure FormShow(Sender: TObject);
87 procedure mnuActClick(Sender: TObject);
88 procedure UploadImagesButtonClick(Sender: TObject);
89 procedure FormHide(Sender: TObject);
90 procedure TabControlChange(Sender: TObject);
91 procedure TabControlGetImageIndex(Sender: TObject; TabIndex: Integer;
92 var ImageIndex: Integer);
93 procedure TabControlResize(Sender: TObject);
[729]94 procedure EnableAutoScanUploadClick(Sender: TObject);
95 procedure PickScanFolderClick(Sender: TObject);
[453]96 private
97 ImageInfoList : TList;
98 LastDisplayedTIUIEN : AnsiString;
99 CurImageToLoad : integer;
100 InTimerFn : Boolean;
101 procedure EnsureImageListLoaded();
102 procedure ClearImageList();
103 procedure DownloadToCache(ImageIndex : integer);
104 procedure EmptyCache();
105 procedure ClearTabPages();
106 procedure SetupTab(i : integer);
107 procedure UpdateNoteInfoMemo();
108 procedure UpdateImageInfoMemo(Rec: TImageInfo);
[729]109 function FileSize(fileName : wideString) : Int64;
[453]110 public
111 CacheDir : AnsiString;
[738]112 UseDropBox : boolean;
113 DropBoxDir : string;
[453]114 NullImageName : AnsiString;
115 function Decode(input: AnsiString) : AnsiString;
116 function Encode(input: AnsiString) : AnsiString;
[729]117 function DownloadFileViaDropbox(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
118 function DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
119 function UploadFileViaDropBox(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
120 function UploadFile(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
[453]121 procedure SplitLinuxFilePath(FullPathName : AnsiString;
122 var Path : AnsiString;
123 var FName : AnsiString);
124 procedure GetImageList();
125 procedure NewNoteSelected(EditIsActive : boolean);
[729]126 function CreateBarcode(MsgStr: AnsiString; ImageType: AnsiString): AnsiString;
127 function DecodeBarcode(LocalFNamePath,ImageType: AnsiString): AnsiString;
[453]128 published
129 end;
130
131var
132 frmImages: TfrmImages;
133
134
135implementation
136
137{$R *.DFM}
138
139uses fFrame, fVisit, fEncnt, rCore, uCore, fNoteBA, fNoteBD, fSignItem, fEncounterFrame,
140 rPCE, Clipbrd, fNoteCslt, fNotePrt, rVitals, fAddlSigners, fNoteDR, fConsults, uSpell,
141 fTIUView, fTemplateEditor, uReminders, fReminderDialog, uOrders, rConsults, fReminderTree,
142 fNoteProps, fNotesBP, fTemplateFieldEditor, dShared, rTemplates,
143 FIconLegend, fPCEEdit, fNoteIDParents, rSurgery, uSurgery, uTemplates,
144 uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog, DateUtils,
145 StrUtils {//KT added 1-1-05},
146 mshtml, {//kt added 5-2-05}
147 UploadImages, {//kt added 9/25/05}
[729]148 //ImageTransferForm, {//kt 10-1-05}
149 uTMGOptions, //kt 3/10/10
150 rHTMLTools, fNotes, frmImageTransferProgress; {//kt added 5-27-05 for IsHTMLDocument}
[453]151
152
153procedure TfrmImages.timLoadImagesTimer(Sender: TObject);
154begin
155 inherited;
156 if InTimerFn=false then begin
157 InTimerFn := true;
158 EnsureImageListLoaded(); //only does RPC call if CurImageToLoad = 0
159 if CurImageToLoad <> -1 then begin //-1 means RPC-> no avail images.
160 if CurImageToLoad < ImageInfoList.Count then begin
[729]161 ImageTransferForm.ProgressMsg.Caption := 'Downloading Images';
162 //if ImageTransferForm.Visible = false then begin
163 // ImageTransferForm.Show;
164 //end;
[453]165 DownloadToCache(CurImageToLoad); //Only load 1 image per timer firing.
166 SetupTab(CurImageToLoad);
167 Inc(CurImageToLoad);
168 if TabControl.TabIndex < 0 then TabControl.TabIndex := 0;
169 TabControlChange(self);
170 end else begin
171 timLoadImages.Enabled := false;
[729]172 //ImageTransferForm.ProgressBar.Position := 100;
173 //Sleep(1000);
174 //ImageTransferForm.Hide;
[453]175 end;
176 end;
177 InTimerFn := false;
178 if self.Visible = true then begin
179 timLoadImages.Interval :=100;
180 end else begin
181 timLoadImages.Interval :=30000; //30 sec delay
182 end;
183 end;
184end;
185
186
187{ TPage common methods --------------------------------------------------------------------- }
188procedure TfrmImages.mnuChartTabClick(Sender: TObject);
189{ reroute to Chart Tab menu of the parent form: frmFrame }
190begin
191 inherited;
192 frmFrame.mnuChartTabClick(Sender);
193end;
194
195
196procedure TfrmImages.mnuActNewClick(Sender: TObject);
197const
198 IS_ID_CHILD = False;
199{ switches to current new note or creates a new note if none is being edited already }
200begin
201 inherited;
202end;
203
204procedure TfrmImages.FormCreate(Sender: TObject);
205//var i : integer;
206begin
207 inherited;
208 InTimerFn:=false;
209 LastDisplayedTIUIEN := '0';
210 ImageInfoList := TList.Create;
211 CurImageToLoad := 0;
212 CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
213 NullImageName := ExtractFilePath(ParamStr(0)) + 'images\blank.htm';
214 if not DirectoryExists(CacheDir) then ForceDirectories(CacheDir);
[729]215
[738]216 //UseDropBox := uTMGOptions.ReadBool('Use dropbox directory for transfers',false);
217 if uTMGOptions.ReadInteger('ImageTransferMethod',0) = 0 then begin
218 UseDropBox := True;
219 end else begin
220 UseDropBox := False;
221 end;
[729]222 DropBoxDir := uTMGOptions.ReadString('Dropbox directory','??');
223 if DropBoxDir='??' then begin //just on first run.
224 uTMGOptions.WriteBool('Use dropbox directory for transfers',false);
225 uTMGOptions.WriteString('Dropbox directory','');
226 end;
227 AutoScanUpload.Checked := uTMGOptions.ReadBool('Scan Enabled',false);
[453]228end;
229
230procedure TfrmImages.FormDestroy(Sender: TObject);
231begin
232 inherited;
233 ClearImageList;
234 ImageInfoList.Free;
235 EmptyCache;
236end;
237
238procedure TfrmImages.FormShow(Sender: TObject);
239var
240 TIUIEN : AnsiString;
[729]241
[453]242begin
243 inherited;
244 TIUIEN := IntToStr(frmNotes.lstNotes.ItemID);
245 timLoadImages.Enabled := true;
246 timLoadImages.Interval := 100;
247 if LastDisplayedTIUIEN <> TIUIEN then begin
248 UpdateNoteInfoMemo();
249 LastDisplayedTIUIEN := TIUIEN;
250 end;
251end;
252
253procedure TfrmImages.mnuActClick(Sender: TObject);
254begin
255 inherited;
256
257end;
258
259{ General procedures ----------------------------------------------------------------------- }
260
261procedure TfrmImages.UpdateImageInfoMemo(Rec : TImageInfo);
262var s : AnsiString;
263 i : integer;
264begin
265 CurrentImageMemo.Lines.Clear;
266 if Rec=nil then exit;
267 s := Trim(Rec.ShortDesc);
268 if s <> '' then CurrentImageMemo.Lines.Add('Description: ' + s);
269 s := Rec.ProcName;
270 if s <> '' then CurrentImageMemo.Lines.Add('Procedure: ' + s);
271 s := Rec.DisplayDate;
272 if s <> '' then CurrentImageMemo.Lines.Add('Upload Date: ' + s);
273 //s := Rec.DateTime;
274 //if s <> '' then CurrentImageMemo.Lines.Add('Date/Time: ' + s);
275 if Rec.LongDesc <> nil then begin
276 CurrentImageMemo.Lines.Add('Long Description:');
277 for i := 0 to Rec.LongDesc.Count-1 do begin
278 CurrentImageMemo.Lines.Add(' ' + Rec.LongDesc.Strings[i]);
279 end;
280 end;
281end;
282
283
284procedure TfrmImages.UpdateNoteInfoMemo();
285var
286 NoteInfo,s : AnsiString;
287 //dateS : AnsiString;
288const
289 U='^';
290begin
291 CurrentNoteMemo.Lines.Clear;
292 with frmNotes.lstNotes do begin
293 if ItemIndex > -1 then begin
294 NoteInfo := Items[ItemIndex]
295 (* example NoteInfo:
296 piece# 1: 14321^ //TIU IEN
297 piece# 2: PRESCRIPTION CALL IN^ //Document Title
298 piece# 3: 3050713.0947^ //Date/Time
299 piece# 4: TEST, KILLME D (T0101)^ //Patient
300 piece# 5: 133;JANE A DOE;DOE,JANE A^ //Author
301 piece# 6: Main_Office^ //Location of Visit
302 piece# 7: completed^ //Status of Document
303 piece# 8: Visit: 07/13/05;3050713.094721^ //Date/Time
304 piece# 9...: ;^^1^^^1^' //?
305 *)
306 end else NoteInfo := '';
307 end;
308 if NoteInfo <>'' then begin
309 s := Piece(NoteInfo, U, 2) + ' -- ';
310 s := s + Piece(Piece(NoteInfo, U, 8), ';', 1);
311 CurrentNoteMemo.Lines.Add(s);
312 s := 'Location: ' + Piece(NoteInfo, U, 6) + ' -- ';
313 s := s + 'Note Author: ' + Piece(Piece(NoteInfo, U, 5), ';', 2);
314 CurrentNoteMemo.Lines.Add(s);
315 end;
316end;
317
318procedure TfrmImages.SetupTab(i : integer);
319//i is index in ImageInfoList (array of TImageInfo's)
320var
321 Rec : TImageInfo; //this will be a copy of record, not pointer (I think)
322 Bitmap : TBitmap;
323 index : integer;
324 Ext : AnsiString;
325
326 (*Notice: A TabControl doesn't directly support specifying which
327 images in an ImageList to show for a given tab. To get
328 around this, the help documentation recommends setting up
329 a TabControlGetImageIndex event handler.
330 I am doing this. When the event is called, then RecInfo.TabImageIndex
331 is returned.
332 *)
333
334begin
335 if i < ImageInfoList.Count then begin
336 Rec := TImageInfo(ImageInfoList[i]);
337 if (Rec.TabImageIndex < 1) then begin
338 if FileExists(Rec.CacheThumbFName) then begin
339 Bitmap := TBitmap.Create;
340 Bitmap.Width := 1024; //something big enough to hold any thumbnail.
341 Bitmap.Height := 768;
342 Bitmap.LoadFromFile(Rec.CacheThumbFName);
343 Bitmap.Width := ThumbsImageList.Width; //shrinkage crops image
344 Bitmap.Height := ThumbsImageList.Height;
345 index := ThumbsImageList.Add(Bitmap,nil);
346 TImageInfo(ImageInfoList[i]).TabImageIndex := index;
347 Bitmap.Free;
348 end else begin
349 Ext := LowerCase(ExtractFileExt(Rec.CacheFName));
350 Ext := MidStr(Ext,2,99);
351 if (Ext='jpg')
352 or (Ext='jpeg')
353 or (Ext='png')
354 or (Ext='tif')
355 or (Ext='tiff')
356 or (Ext='gif')
357 or (Ext='bmp') then begin
358 TImageInfo(ImageInfoList[i]).TabImageIndex := 0; //camera image
359 end else
360 if (Ext='pdf') then begin
361 TImageInfo(ImageInfoList[i]).TabImageIndex := 1; //adobe icon
362 end else
363 if (Ext='avi')
364 or (Ext='qt')
365 or (Ext='mpg')
366 or (Ext='mpeg') then begin
367 TImageInfo(ImageInfoList[i]).TabImageIndex := 2; //video icon
368 end else
369 if (Ext='mp3')
370 or (Ext='wma')
371 or (Ext='au')
372 or (Ext='wav') then begin
373 TImageInfo(ImageInfoList[i]).TabImageIndex := 3; //sound icon
374 end else
375 begin
376 TImageInfo(ImageInfoList[i]).TabImageIndex := 4; // misc icon
377 end;
378 end;
379 end;
380 TabControl.Tabs.Add(' '); //add the tab. Thumbnail should exist before this
381 end;
382end;
383
384
385procedure TfrmImages.ClearTabPages();
386begin
387 TabControl.Tabs.Clear;
388 ClearImageList();
389end;
390
391
392procedure TfrmImages.ClearImageList();
393//Note: !! This should also clear any visible images/thumbnails etc.
394var i : integer;
395begin
396 for i := ImageInfoList.Count-1 downto 0 do begin
397 if TImageInfo(ImageInfoList[i]).LongDesc <> nil then begin
398 TImageInfo(ImageInfoList[i]).LongDesc.Free;
399 end;
400 TImageInfo(ImageInfoList[i]).Free;
401 ImageInfoList.Delete(i);
402 end;
403end;
404
405
406procedure TfrmImages.EnsureImageListLoaded();
407begin
408 if CurImageToLoad = 0 then begin
409 GetImageList();
410 if ImageInfoList.Count=0 then CurImageToLoad := -1;
411 end;
412end;
413
414procedure TfrmImages.GetImageList();
415var
416 i,j : integer;
417 s,s2 : AnsiString;
418 Rec : TImageInfo;
419 ImageIEN : integer;
420 TIUIEN : AnsiString;
421 ServerFName : AnsiString;
422 ServerPathName : AnsiString;
423 ImageFPathName : AnsiString; //path on server of image -- original data provided by server
424 ThumbnailFPathName : AnsiString; //path on server of thumbnail -- original data provided by server
425
426begin
427 inherited;
428 ClearImageList;
429 try
430 TIUIEN := IntToStr(frmNotes.lstNotes.ItemID);
431
432 except
433 //Error occurs after note is signed, and frmNotes.lstNotes.ItemID is "inaccessible"
434 on E: Exception do exit;
435 end;
[729]436 //----MOVED
437 StatusText('Retrieving images information...');
438 CallV('MAG3 CPRS TIU NOTE', [TIUIEN]);
439 for i:=0 to (RPCBrokerV.Results.Count-1) do begin
440 s :=RPCBrokerV.Results[i];
441 if i=0 then begin
442 if piece(s,'^',1)='0' then break //i.e. abort due to error signal
443 else continue; //ignore rest of header (record #0)
444 end;
445 if Pos('-1~',s)>0 then continue; //abort if error signal.
446 Rec := TImageInfo.Create; // ImageInfoList will own this.
447 Rec.LongDesc := nil;
448 Rec.TabIndex := -1;
449 Rec.TabImageIndex := 0;
450 s2 := piece(s,'^',2); if s2='' then s2 := '0'; //IEN
451 Rec.IEN := StrToInt(s2);
452 ImageFPathName := piece(s,'^',3); //Image FullPath and name
453 ThumbnailFPathName := piece(s,'^',4); //Abstract FullPath and Name
454 Rec.ShortDesc := piece(s,'^',5); //SHORT DESCRIPTION field
455 s2 := piece(s,'^',6); if s2='' then s2 := '0'; //PROCEDURE/ EXAM DATE/TIME field
456 Rec.DateTime := s2;
457 s2 := piece(s,'^',7); if s2='' then s2 := '0'; //OBJECT TYPE
458 Rec.ImageType := StrToInt(s2);
459 Rec.ProcName := piece(s,'^',8); //PROCEDURE field
460 Rec.DisplayDate := piece(s,'^',9); //Procedure Date in Display format
461 s2 := piece(s,'^',10); if s2='' then s2 := '0'; //PARENT DATA FILE image pointer
462 Rec.ParentDataFileIEN := StrToInt(s2);
463 Rec.AbsType := piece(s,'^',11)[1]; //the ABSTYPE : 'M' magnetic 'W' worm 'O' offline
464 s2 := piece(s,'^',12); if s2='' then s2 :='O';
465 Rec.Accessibility := s2[1]; //Image accessibility 'A' accessable or 'O' offline
466 s2 := piece(s,'^',13); if s2='' then s2 := '0'; //Dicom Series number
467 Rec.DicomSeriesNum := StrToInt(s2);
468 s2 := piece(s,'^',14); if s2='' then s2 := '0'; //Dicom Image Number
469 Rec.DicomImageNum := StrToInt(s2);
470 s2 := piece(s,'^',15); if s2='' then s2 := '0'; //Count of images in the group, or 1 if a single image
471 Rec.GroupCount := StrToInt(s2);
472
473 SplitLinuxFilePath(ImageFPathName,ServerPathName,ServerFName);
474 Rec.ServerPathName := ServerPathName;
475 Rec.ServerFName := ServerFName;
476 Rec.CacheFName := CacheDir + '\' + ServerFName;
477 SplitLinuxFilePath(ThumbnailFPathName,ServerPathName,ServerFName);
478 Rec.ServerThumbPathName := ServerPathName;
479 Rec.ServerThumbFName := ServerFName;
480 Rec.CacheThumbFName := CacheDir + '\' + ServerFName;
481 ImageInfoList.Add(Rec); // ImageInfoList will own Rec.
482 end;
483 for i:= 0 to ImageInfoList.Count-1 do begin
484 Rec := TImageInfo(ImageInfoList.Items[i]);
485 ImageIEN := Rec.IEN;
486 CallV('TMG GET IMAGE LONG DESCRIPTION', [ImageIEN]);
487 for j:=0 to (RPCBrokerV.Results.Count-1) do begin
488 if (j>0) then begin
489 if Rec.LongDesc = nil then Rec.LongDesc := TStringList.Create;
490 Rec.LongDesc.Add(RPCBrokerV.Results.Strings[j]);
491 end else begin
492 if RPCBrokerV.Results[j]='' then break;
493 end;
494 end;
495 end;
496 //----END MOVED
[453]497 StatusText('');
498end;
499
500
501procedure TfrmImages.DownloadToCache(ImageIndex : integer);
502//Loads image specified in ImageInfoList to Cache (unless already present)
503var
504 Rec : TImageInfo;
505 ServerFName : AnsiString;
506 ServerPathName : AnsiString;
507
508begin
509 Rec := TImageInfo(ImageInfoList[ImageIndex]);
510 ServerFName := Rec.ServerFName;
511 ServerPathName := Rec.ServerPathName;
512 if not FileExists(Rec.CacheFName) then begin
[729]513 DownloadFile(ServerPathName,ServerFName,Rec.CacheFName,(ImageIndex*2)-1,ImageInfoList.Count*2);
[453]514 end;
515 ServerFName := Rec.ServerThumbFName;
516 ServerPathName := Rec.ServerThumbPathName;
517 if not FileExists(Rec.CacheThumbFName) then begin
[729]518 DownloadFile(ServerPathName,ServerFName,Rec.CacheThumbFName,ImageIndex*2,ImageInfoList.Count*2);
[453]519 end;
520 Application.ProcessMessages;
521end;
522
523procedure TfrmImages.SplitLinuxFilePath(FullPathName : AnsiString;
524 var Path : AnsiString;
525 var FName : AnsiString);
526var p : integer;
527begin
528 Path := ''; FName := '';
529 repeat
530 p := Pos('/',FullPathName);
531 if p > 0 then begin
532 Path := Path + MidStr(FullPathName,1,p);
533 FullPathName := MidStr(FullPathName,p+1,1000);
534 end else begin
535 FName := FullPathName;
536 FullPathName := '';
537 end;
538 until (FullPathName = '');
539end;
540
541
[729]542function TfrmImages.UploadFileViaDropBox(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
543var
544 DropboxFile : AnsiString;
545begin
546 //First copy LocalFileNamePath --> DropBox\FileName
547 DropboxFile := ExcludeTrailingBackslash(DropboxDir) + '\' + FName;
548 if CopyFile(pchar(LocalFNamePath),pchar(DropboxFile),false)=false then begin
549 MessageDlg('Dropbox file transfer failed. Code='+InttoStr(GetLastError),
550 mtError,[mbOK],0);
551 result := false;
552 exit;
553 end;
554
555 // CallV('TMG UPLOAD FILE DROPBOX', ...);
556 RPCBrokerV.ClearParameters := true;
557 RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE DROPBOX';
558 RPCBrokerV.param[0].PType := literal;
559 RPCBrokerV.param[0].Value := FPath;
560 RPCBrokerV.Param[1].PType := literal;
561 RPCBrokerV.Param[1].Value := FName;
562 RPCBrokerV.Param[2].PType := literal;
563 RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
564
565 RPCBrokerV.Call; //Move file into dropbox.
566 Result := (Piece(RPCBrokerV.Results[0],'^',1)='1'); //1=success, 0=failure
567end;
568
569
570function TfrmImages.UploadFile(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
[453]571const
572 RefreshInterval = 500;
573 BlockSize = 512;
574
575var
576 ReadCount : Word;
577 totalReadCount : Integer;
578 ParamIndex : LongWord;
579 j : word;
580 InFile : TFileStream;
581 LocalOutFile : TFileStream;
582 Buffer : array[0..1024] of byte;
583 RefreshCountdown : integer;
584 OneLine : AnsiString;
585 RPCResult : AnsiString;
586 SavedCursor : TCursor;
587
588begin
589 result := false; //default of failure
590 if not FileExists(LocalFNamePath) then exit;
[729]591 if UseDropBox then begin
592 Result := UploadFileViaDropBox(LocalFNamePath,FPath,FName,CurrentImage,TotalImages);
593 exit;
594 end;
[453]595 try
596 InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat);
597 LocalOutFile := TFileStream.Create(CacheDir+'\'+FName,fmCreate or fmOpenWrite); //for local copy
598 //Note: I may well cut this out. Most of the delay occurs during
599 // the RPC call, and I can't make a progress bar change during that...
600 // (or I could, but I'm not going to change the RPC broker...)
[729]601 ImageTransferForm.setMax(InFile.Size);
602 //ImageTransferForm.ResetStartTime;
603 ImageTransferForm.ProgressMsg.Caption := 'Preparing to upload...';
604 ImageTransferForm.Show;
[453]605 totalReadCount := 0;
606 except
607 // catch failure here... on eError...
608 exit;
609 end;
610
611 StatusText('Uploading full image...');
612 Application.ProcessMessages;
613
614 RPCBrokerV.ClearParameters := true;
615 RPCBrokerV.Param[0].PType := literal;
616 RPCBrokerV.Param[0].Value := FPath;
617 RPCBrokerV.Param[1].PType := literal;
618 RPCBrokerV.Param[1].Value := FName;
619 RPCBrokerV.Param[2].PType := literal;
620 RPCBrokerV.Param[2].Value := '1';
621 //Note: the '1' in the line above is hard-coding in to use
622 //IEN=1 in file 2005.2 (NETWORK LOCATION). This file will
623 //instruct the server which relative path to store the file into
624 //If I want to have more than one NETWORK LOCATION, then I would
625 //need to create another RPC call that would determine which IEN
626 //to use.
627 //(This would be the same as the IEN stored in fields# 2, 2.1, 2.2
628 // of file 2005 (IMAGE). This in turn is originally obtained from
629 //file IMAGING SITE PARAMETERS
630
631 RPCBrokerV.Param[3].PType := list;
632
633 ParamIndex := 0;
634 RefreshCountdown := RefreshInterval;
635 repeat
636 ReadCount := InFile.Read(Buffer,BlockSize);
637 LocalOutFile.Write(Buffer,ReadCount); //for local copy
638 totalReadCount := totalReadCount + ReadCount;
[729]639 ImageTransferForm.updateProgress(totalReadCount);
[453]640 OneLine := '';
641 if ReadCount > 0 then begin
642 SetLength(OneLine,ReadCount);
643 for j := 1 to ReadCount do OneLine[j] := char(Buffer[j-1]);
644 RPCBrokerV.Param[3].Mult[IntToStr(ParamIndex)] := Encode(OneLine);
645 Inc(ParamIndex);
646
647 Dec(RefreshCountdown);
648 if RefreshCountdown < 1 then begin
649 Application.ProcessMessages;
650 RefreshCountdown := RefreshInterval;
651 end;
652
653 end;
654 until (ReadCount < BlockSize);
655
656 RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE';
657
658 SavedCursor := Screen.Cursor;
659 Screen.Cursor := crHourGlass;
[729]660 ImageTransferForm.ProgressMsg.Caption := 'Uploading file to server...';
[453]661 Application.ProcessMessages;
662
663 CallBroker;
664 Screen.Cursor := SavedCursor;
665 RPCResult := RPCBrokerV.Results[0];
666 result := (Piece(RPCResult,'^',1)='1');
[729]667 ImageTransferForm.Hide;
[453]668 if result=false then begin
669 Application.MessageBox('Error uploading file','Error');
670 end;
671
672 InFile.Free;
673 LocalOutFile.Free;
674 StatusText('');
675end;
676
677
[729]678function TfrmImages.DownloadFileViaDropbox(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
[453]679var
[729]680 DropboxFile : AnsiString;
681 CurrentFileSize : Integer;
[735]682 ErrMsg : string;
[729]683begin
684 // CallV('TMG DOWNLOAD FILE DROPBOX', ...);
685 RPCBrokerV.ClearParameters := true;
686 RPCBrokerV.remoteprocedure := 'TMG DOWNLOAD FILE DROPBOX';
687 RPCBrokerV.param[0].PType := literal;
688 RPCBrokerV.param[0].Value := FPath;
689 RPCBrokerV.Param[1].PType := literal;
690 RPCBrokerV.Param[1].Value := FName;
691 RPCBrokerV.Param[2].PType := literal;
692 RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
693
694 RPCBrokerV.Call; //Move file into dropbox.
[735]695 if RPCBrokerV.Results.Count > 0 then begin
696 Result := (Piece(RPCBrokerV.Results[0],'^',1)='1'); //1=success, 0=failure
697 if Result = false then ErrMsg := Piece(RPCBrokerV.Results[0],'^',2);
698 end else begin
699 Result := false;
700 ErrMsg := 'Error communicating with server to retrieve image.';
701 end;
[729]702
703 if Result=true then begin
[735]704 CurrentFileSize := strtoint(Piece(RPCBrokerV.Results[0],'^',3)); //Piece 3 = file size
[729]705 DropboxFile := ExcludeTrailingBackslash(DropboxDir) + '\' + FName;
706 if ImageTransferForm.visible = False then ImageTransferForm.show;
707 while FileSize(DropboxFile) <> CurrentFileSize do sleep(1000); //elh
708 ImageTransferForm.ProgressBar.Max := TotalImages; //elh
709 ImageTransferForm.ProgressBar.Position := CurrentImage+2; //elh
710 if TotalImages = (CurrentImage+2) then begin
711 Sleep(1000);
712 ImageTransferForm.hide;
713 end;
714 //Now move DropBox\FileName --> LocalFileNamePath
715 if MoveFile(pchar(DropboxFile),pchar(LocalSaveFNamePath))=false then begin
716 MessageDlg('Dropbox file transfer failed. Code='+InttoStr(GetLastError),
717 mtError,[mbOK],0);
718 end;
[735]719 end else begin
720 MessageDlg('ERROR: '+ErrMsg,mtError,[mbOK],0);
[729]721 end;
722end;
723
724
725function TfrmImages.DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
726var
[453]727 i,count : integer;
728 j : word;
729 OutFile : TFileStream;
730 s : AnsiString;
731 Buffer : array[0..1024] of byte;
732 RefreshCountdown : integer;
733
734const
735 RefreshInterval = 500;
736
737begin
738 if FileExists(LocalSaveFNamePath) then begin
739 DeleteFile(LocalSaveFNamePath);
740 end;
[729]741 if UseDropBox then begin
742 Result := DownloadFileViaDropBox(FPath,FName,LocalSaveFNamePath,CurrentImage,TotalImages);
743 exit;
744 end;
[453]745 Result := true; //default to success;
746 StatusText('Retrieving full image...');
747 //Note: the '1' in the line below is hard-coding in to use
748 //IEN=1 in file 2005.2 (NETWORK LOCATION). This file will
749 //instruct the server which relative path to store the file into
750 //If I want to have more than one NETWORK LOCATION, then I would
751 //need to create another RPC call that would determine which IEN
752 //to use.
753 //(This would be the same as the IEN stored in fields# 2, 2.1, 2.2
754 // of file 2005 (IMAGE). This in turn is originally obtained from
755 //file IMAGING SITE PARAMETERS
756 CallV('TMG DOWNLOAD FILE', [FPath,FName,'1']);
757 Application.ProcessMessages;
758 RefreshCountdown := RefreshInterval;
759 //Note:RPCBrokerV.Results[0]=1 if successful load, =0 if failure
760 if (RPCBrokerV.Results.Count>0) and (RPCBrokerV.Results[0]='1') then begin
761 OutFile := TFileStream.Create(LocalSaveFNamePath,fmCreate);
762 for i:=1 to (RPCBrokerV.Results.Count-1) do begin
763 s :=Decode(RPCBrokerV.Results[i]);
764 count := Length(s);
765 if count>1024 then begin
766 Result := false; //failure of load.
767 break;
768 end;
769 for j := 1 to count do Buffer[j-1] := ord(s[j]);
770 OutFile.Write(Buffer,count);
771 Dec(RefreshCountdown);
772 if RefreshCountdown < 1 then begin
773 Application.ProcessMessages;
774 RefreshCountdown := RefreshInterval;
775 end;
776 end;
777 OutFile.Free;
778 end else begin
779 result := false;
780 end;
781 StatusText('');
782end;
783
784
785function TfrmImages.Encode(Input: AnsiString) : AnsiString;
786//This function is based on ENCODE^RGUTUU, which is match for
787//DECODE^RGUTUU that is used to decode (ascii armouring) on the
788//server side. This is a base64 encoder.
789const
790 //FYI character set is 64 characters (starting as 'A')
791 // (65 characters if intro '=' is counted)
792 CharSet = '=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
793var
794 //Result : AnsiString; // RGZ1 //'Result' is implicitly declared by Pascal
795
796 i : integer; //RGZ2
797 j : integer; //RGZ4
798 PlainTrio : longword; //RGZ3 //unsigned 32-bit
799 EncodedByte : Byte;
800 PlainByte : byte; //RGZ5
801 EncodedQuad : string[4];//RGZ6
802
803begin
804 //e.g. input (10 bytes):
805 // 174 231 193 16 29 251 93 138 4 57
806 // AE E7 C1 10 1D FB 5D 8A 04 39
807 Result := '';
808 i := 1;
809 while i<= Length(Input) do begin //cycle in groups of 3
810 PlainTrio := 0;
811 EncodedQuad := '';
812 //Get 3 bytes, to be converted into 4 characters eventually.
813 //Fill with 0's if needed to make an even 3-byte group.
814 For j:=0 to 2 do begin
815 //e.g. '174'->PlainByte=174
816 if (i+j) <= Length(Input) then PlainByte := ord(Input[i+j])
817 else PlainByte := 0;
818 PlainTrio := (PlainTrio shl 8) or PlainByte;
819 end;
820 //e.g. first 3 bytes--> PlainTrio= $AEE7C1 (10101110 11100111 11000001)
821 //e.g. last 3 bytes--> PlainTrio= $390000 (00111001 00000000 00000000) (note padded 0's)
822
823 //Take each 6 bits and convert into a character.
824 //e.g. first 3 bytes--> (101011 101110 011111 000001)
825 // 43 46 31 1
826
827 //e.g. last 3 bytes-->(001110 010000 000000 000000) (after redivision)
828 // 14 16 0 0 <-- last 2 bytes are padded 0
829 // ^ last 4 bits of '16' are padded 0's
830 For j := 1 to 4 do begin
831 //e.g. $AEE7C1 --> (43+2)=45 (46+2)=48 (31+2)=33 (1+2)=3
832 // r u f b
833
834 //e.g. $39AF00 --> (14+2)=16 (16+2)=18 (0+2)=2 (0+2)=2
835 // O Q A A <-- 2 padded bytes
836 EncodedByte := (PlainTrio and 63)+2; //63=$3F=b0111111; 0->A 1->B etc
837 EncodedQuad := CharSet[EncodedByte]+ EncodedQuad; //string Concat, not math add
838 PlainTrio := PlainTrio shr 6
839 end;
840
841 //Append result with latest quad
842 Result := Result + EncodedQuad;
843 Inc(i,3);
844 end;
845
846 // e.g. result: rufb .... .... OQAA <-- 2 padded bytes (and part of Q is padded also)
847 i := 3-(Length(Input) mod 3); //returns 1,2,or 3 (3 needs to be set to 0)
848 if (i=3) then i:=0; //e.g. input=10 -> i=2
849 j := Length(Result);
850 //i is the number of padded characters that need to be replaced with '='
851 if i>=1 then Result[j] := '='; //replace 1st paddeded char
852 if i>=2 then Result[Length(Result)-1] := '=';//replace 2nd paddeded char
853 // e.g. result: rufb .... .... OQ==
854
855 //results passed out in Result
856end;
857
858
859function TfrmImages.Decode(Input: AnsiString) : AnsiString;
860//This function is based on DECODE^RGUTUU, which is match for
861//ENCODE^RGUTUU that is used to encode (ascii armouring) on the
862//server side. This is a Base64 decoder
863const
864 //FYI character set is 64 characters (starting as 'A')
865 // (65 characters if intro '=' is counted)
866 CharSet = '=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
867
868var
869 //Result : AnsiString; // RGZ1 //'Result' is implicitly declared by Pascal
870 i : integer; //RGZ2
871 PlainTrio : longword; //RGZ3 //unsigned 32-bit
872 j : integer; //RGZ4
873 EncodedChar : char;
874 PlainInt : integer;
875 PlainByte : byte; //RGZ5
876 DecodedTrio : string[3];//RGZ6
877
878begin
879 Result:='';
880 i := 1;
881 //e.g. input: rufb .... .... OQ==
882
883 while i <= Length(Input) Do begin //cycle in groups of 4
884 PlainTrio :=0;
885 DecodedTrio :='';
886 //Get 4 characters, to be converted into 3 bytes.
887 For j :=0 to 3 do begin
888 //e.g. last 4 chars --> 0A==
889 if (i+j) <= Length(Input) then begin
890 EncodedChar := Input[i+j];
891 PlainInt := Pos(EncodedChar,CharSet)-2; //A=0, B=1 etc.
892 if (PlainInt>=0) then PlainByte := (PlainInt and $FF) else PlainByte := 0;
893 end else PlainByte := 0;
894 //e.g. with last 4 characters:
895 //e.g. '0'->14=(b001110) 'Q'->16=(b010000) '='-> -1 -> 0=(b000000) '=' -> 0=(b000000)
896 //e.g.-- So last PlainTrio = 001110 010000 000000 000000 = 00111001 00000000 00000000
897 //Each encoded character contributes 6 bytes to final 3 bytes.
898 //4 chars * 6 bits/char=24 bits --> 24 bits / 8 bits/byte = 3 bytes
899 PlainTrio := (PlainTrio shl 6) or PlainByte; //PlainTrio := PlainTrio*64 + PlainByte;
900 end;
901 //Now take 3 bytes, and add to cumulative output (in same order)
902 For j :=0 to 2 do begin
903 DecodedTrio := Chr(PlainTrio and $FF) + DecodedTrio; //string concat (not math addition)
904 PlainTrio := PlainTrio shr 8; // PlainTrio := PlainTrio div 256
905 end;
906 //e.g. final DecodedTrio = 'chr($39) + chr(0) + chr(0)'
907 Result := Result + DecodedTrio;
908 Inc(i,4);
909 end;
910
911 //Now remove 1 byte from the output for each '=' in input string
912 //(each '=' represents 1 padded 0 added to allow for even groups of 3)
913 for j :=0 to 1 do begin
914 if (Input[Length(Input)-j] = '=') then begin
915 Result := MidStr(Result,1,Length(Result)-1);
916 end;
917 end;
918end;
919
920procedure TfrmImages.NewNoteSelected(EditIsActive : boolean);
921//Will be called by fNotes when a new note has been selected.
922//var
923begin
924 ClearTabPages();
925 CurImageToLoad := 0; //a -1 would signal that no images avail to load.
926 //this will start downloading images after 5 second delay (so that if
927 //user is just browsing past note, this won't waste effort.
928 //If user selects images tab, then load will occur without delay.
929 timLoadImages.Enabled := true;
930 timLoadImages.Interval := 60000; //60 sec delay -- also set in timLoadImagesTimer
931 //Note: OnTimer calls timLoadImagesTimer()
932 UploadImagesButton.Enabled := EditIsActive;
933 UploadImagesMnuAction.Enabled := EditIsActive;
934 WebBrowser.Navigate(NullImageName);
935end;
936
937
938procedure TfrmImages.EmptyCache();
939//This will delete ALL files in the Cache directory
940//Note: This will include the html_note file created by
941// the notes tab.
942var
943 //CacheDir : AnsiString;
944 FoundFile : boolean;
945 FSearch : TSearchRec;
946 Files : TStringList;
947 i : integer;
948 FName : AnsiString;
949
950begin
951 Files := TStringList.Create;
952// CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
953 FoundFile := (FindFirst(CacheDir+'\*.*',faAnyFile,FSearch)=0);
954 while FoundFile do Begin
955 FName := FSearch.Name;
956 if (FName <> '.') and (FName <> '..') then begin
957 FName := CacheDir + '\' + FName;
958 Files.Add(FName);
959 end;
960 FoundFile := (FindNext(FSearch)=0);
961 end;
962
963 for i := 0 to Files.Count-1 do begin
964 FName := Files.Strings[i];
965 if DeleteFile(FName) = false then begin
[612]966 //kt raise Exception.Create('Unable to delete file: '+FSearch.Name+#13+'Will try again later...');
[453]967 end;
968 end;
969 Files.Free;
970end;
971
972
973
974procedure TfrmImages.UploadImagesButtonClick(Sender: TObject);
975var
976 Node: TORTreeNode;
977 AddResult : TModalResult;
978begin
979 inherited;
980 AddResult := UploadForm.ShowModal;
981 if not IsAbortResult(AddResult) then begin
982 NewNoteSelected(true); //force a reload to show recently added image.
983 timLoadImages.Interval := 100;
984 Node := TORTreeNode(frmNotes.tvNotes.Selected);
985 case Node.StateIndex of
986 IMG_NO_IMAGES : Node.StateIndex := IMG_1_IMAGE;
987 IMG_1_IMAGE : Node.StateIndex := IMG_2_IMAGES;
988 IMG_2_IMAGES : Node.StateIndex := IMG_MANY_IMAGES;
989 IMG_MANY_IMAGES : Node.StateIndex := IMG_MANY_IMAGES;
990 end;
991 end;
992end;
993
994procedure TfrmImages.FormHide(Sender: TObject);
995begin
996 inherited;
997// Application.MessageBox('Here I can hide images.','title');
998end;
999
1000procedure TfrmImages.TabControlChange(Sender: TObject);
1001var
1002 FileName : AnsiString;
1003 Rec : TImageInfo;
1004 Selected : integer;
1005begin
1006 inherited;
1007 //here tab has been changed.
1008 Selected := TabControl.TabIndex;
1009 if Selected > -1 then begin
1010 Rec := TImageInfo(ImageInfoList[Selected]);
1011 FileName := Rec.CacheFName;
1012 UpdateImageInfoMemo(Rec);
1013 end else begin
1014 FileName := NullImageName;
1015 UpdateImageInfoMemo(nil);
1016 end;
1017 WebBrowser.Navigate(FileName);
1018end;
1019
1020procedure TfrmImages.TabControlGetImageIndex(Sender: TObject;
1021 TabIndex: Integer;
1022 var ImageIndex: Integer);
1023//specify which image to display, from ThumbsImageList
1024begin
1025 inherited;
1026 if (ImageInfoList <> nil) and (TabIndex < ImageInfoList.Count) then begin
1027 ImageIndex := TImageInfo(ImageInfoList[TabIndex]).TabImageIndex;
1028 end else ImageIndex := 0;
1029end;
1030
1031procedure TfrmImages.TabControlResize(Sender: TObject);
1032begin
1033 inherited;
1034 if TabControl.Width < 80 then begin
1035 TabControl.Width := 80;
1036 end;
1037end;
1038
[729]1039function TfrmImages.CreateBarcode(MsgStr: AnsiString; ImageType: AnsiString): AnsiString;
1040//Create a local barcode file, in .png format, from MsgStr
1041//ImageType is optional, default ='png'. It should NOT contain '.'
1042//Returns file path on local client of new barcode image.
1043//Note: this function is not related to uploading or downloading images
1044// to the server for attaching to progress notes. It is included
1045// in this unit because the functionality used is nearly identical to
1046// the other code.
1047 function UniqueFName : AnsiString;
1048 var FName,tempFName : AnsiString;
1049 count : integer;
1050 begin
1051 FName := 'Barcode-Image';
1052 count := 0;
1053 repeat
1054 tempFName := CacheDir + '\' + FName + '.' + ImageType;
1055 FName := FName + '1';
1056 count := count+1;
1057 until (fileExists(tempFName)=false) or (count> 32);
1058 result := tempFName;
1059 end;
1060
1061var
1062 i,count : integer;
1063 j : word;
1064 OutFile : TFileStream;
1065 s : AnsiString;
1066 Buffer : array[0..1024] of byte;
1067 LocalSaveFNamePath : AnsiString;
1068
1069begin
1070 StatusText('Getting Barcode...');
1071 LocalSaveFNamePath := UniqueFName;
1072 Result := LocalSaveFNamePath; //default to success;
1073
1074 // CallV('TMG BARCODE ENCODE', [MsgStr]);
1075 RPCBrokerV.ClearParameters := true;
1076 RPCBrokerV.remoteprocedure := 'TMG BARCODE ENCODE';
1077 RPCBrokerV.param[0].Value := MsgStr;
1078 RPCBrokerV.param[0].PType := literal;
1079 RPCBrokerV.Param[1].Value := '.X'; //<-- is this needed or used?
1080 RPCBrokerV.Param[1].PType := list;
1081 RPCBrokerV.Param[1].Mult['"IMAGE TYPE"'] := ImageType;
1082 RPCBrokerV.Call;
1083
1084 Application.ProcessMessages;
1085 //Note:RPCBrokerV.Results[0]=1 if successful load, =0 if failure
1086 if (RPCBrokerV.Results.Count>0) and (RPCBrokerV.Results[0]='1') then begin
1087 OutFile := TFileStream.Create(LocalSaveFNamePath,fmCreate);
1088 for i:=1 to (RPCBrokerV.Results.Count-1) do begin
1089 s :=Decode(RPCBrokerV.Results[i]);
1090 count := Length(s);
1091 if count>1024 then begin
1092 Result := ''; //failure of load.
1093 break;
1094 end;
1095 for j := 1 to count do Buffer[j-1] := ord(s[j]);
1096 OutFile.Write(Buffer,count);
1097 end;
1098 OutFile.Free;
1099 end else begin
1100 result := '';
1101 end;
1102 StatusText('');
1103end;
1104
1105
1106function TfrmImages.DecodeBarcode(LocalFNamePath,ImageType: AnsiString): AnsiString;
1107//Decode data from barcode on image, or return '' if none
1108//Note: if I could find a cost-effective way of decoding this on client side,
1109// then that code be done here in the function, instead of uploading image
1110// to the server for decoding.
1111const
1112 RefreshInterval = 500;
1113 BlockSize = 512;
1114
1115var
1116 ReadCount : Word;
1117 ParamIndex : LongWord;
1118 j : word;
1119 InFile : TFileStream;
1120 Buffer : array[0..1024] of byte;
1121 RefreshCountdown : integer;
1122 OneLine : AnsiString;
1123 RPCResult : AnsiString;
1124 SavedCursor : TCursor;
1125 totalReadCount : integer;
1126begin
1127 result := ''; //default of failure
1128 if not FileExists(LocalFNamePath) then exit;
1129 try
1130 InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat);
1131 //Note: I may well cut this out. Most of the delay occurs during
1132 // the RPC call, and I can't make a progress bar change during that...
1133 // (or I could, but I'm not going to change the RPC broker...)
1134 ImageTransferForm.setMax(InFile.Size);
1135 //ImageTransferForm.ResetStartTime;
1136 ImageTransferForm.ProgressMsg.Caption := 'Preparing to upload...';
1137 ImageTransferForm.Show;
1138 totalReadCount := 0;
1139 except
1140 // catch failure here... on eError...
1141 exit;
1142 end;
1143
1144 StatusText('Checking image for barcodes...');
1145 Application.ProcessMessages;
1146
1147 RPCBrokerV.ClearParameters := true;
1148 RPCBrokerV.Param.Clear;
1149 RPCBrokerV.Param[0].PType := list;
1150 ParamIndex := 0;
1151 RefreshCountdown := RefreshInterval;
1152 //Put image data into parameter 0 (ARRAY parameter of RPC on server side)
1153 repeat
1154 ReadCount := InFile.Read(Buffer,BlockSize);
1155 OneLine := '';
1156 totalReadCount := totalReadCount + ReadCount;
1157 ImageTransferForm.updateProgress(totalReadCount);
1158 if ReadCount > 0 then begin
1159 SetLength(OneLine,ReadCount);
1160 for j := 1 to ReadCount do OneLine[j] := char(Buffer[j-1]);
1161 RPCBrokerV.Param[0].Mult[IntToStr(ParamIndex)] := Encode(OneLine);
1162 Inc(ParamIndex);
1163 Dec(RefreshCountdown);
1164 if RefreshCountdown < 1 then begin
1165 Application.ProcessMessages;
1166 RefreshCountdown := RefreshInterval;
1167 end;
1168 end;
1169 until (ReadCount < BlockSize);
1170 RPCBrokerV.Param[1].PType := literal;
1171 RPCBrokerV.Param[1].Value := ImageType;
1172
1173 RPCBrokerV.remoteprocedure := 'TMG BARCODE DECODE';
1174
1175 SavedCursor := Screen.Cursor;
1176 Screen.Cursor := crHourGlass;
1177 ImageTransferForm.ProgressMsg.Caption := 'Uploading file to server...';
1178 Application.ProcessMessages;
1179
1180 CallBroker; //this is the slow step, pass to server and get response.
1181
1182 Screen.Cursor := SavedCursor;
1183 ImageTransferForm.Hide;
1184 //Get result: 1^DecodedMessage, or 0^Error Message
1185 RPCResult := RPCBrokerV.Results[0];
1186 if Piece(RPCResult,'^',1)='0' then begin
1187 MessageDlg(Piece(RPCResult,'^',2),mtError,[mbOK],0);
1188 end else begin
1189 result := Piece(RPCResult,'^',2);
1190 end;
1191
1192 InFile.Free;
1193 StatusText('');
1194end;
1195
1196
1197procedure TfrmImages.EnableAutoScanUploadClick(Sender: TObject);
1198begin
1199 inherited;
1200 AutoScanUpload.Checked := not AutoScanUpload.Checked;
1201 uTMGOptions.WriteBool('Scan Enabled',AutoScanUpload.Checked);
1202end;
1203
1204
1205procedure TfrmImages.PickScanFolderClick(Sender: TObject);
1206var
1207 CurScanDir : string;
1208begin
1209 inherited;
1210 CurScanDir := UploadForm.ScanDir;
1211 OpenDialog.InitialDir := CurScanDir;
1212 MessageDlg('Please pick ANY file in the desired directory.',mtInformation,[mbOK],0);
1213 if OpenDialog.Execute then begin
1214 UploadForm.SetScanDir(ExtractFilePath(OpenDialog.FileName));
1215 end;
1216 AutoScanUpload.Checked := true;
1217end;
1218
1219function TfrmImages.FileSize(fileName : wideString) : Int64;
1220var
1221 sr : TSearchRec;
1222begin
1223 if FindFirst(fileName, faAnyFile, sr ) = 0 then
1224 result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) + Int64(sr.FindData.nFileSizeLow)
1225 else
1226 result := -1;
1227
1228 FindClose(sr) ;
1229end;
1230
[453]1231initialization
1232 //put init code here
1233
1234finalization
1235 //put finalization code here
1236
1237end.
1238
Note: See TracBrowser for help on using the repository browser.