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

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

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