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

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

Added functions to Templates, and Images tab
File size: 43.2 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;
677begin
678 // CallV('TMG DOWNLOAD FILE DROPBOX', ...);
679 RPCBrokerV.ClearParameters := true;
680 RPCBrokerV.remoteprocedure := 'TMG DOWNLOAD FILE DROPBOX';
681 RPCBrokerV.param[0].PType := literal;
682 RPCBrokerV.param[0].Value := FPath;
683 RPCBrokerV.Param[1].PType := literal;
684 RPCBrokerV.Param[1].Value := FName;
685 RPCBrokerV.Param[2].PType := literal;
686 RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
687
688 RPCBrokerV.Call; //Move file into dropbox.
689 Result := (Piece(RPCBrokerV.Results[0],'^',1)='1'); //1=success, 0=failure
690 CurrentFileSize := strtoint(Piece(RPCBrokerV.Results[0],'^',3)); //Piece 3 = file size
691
692 if Result=true then begin
693 DropboxFile := ExcludeTrailingBackslash(DropboxDir) + '\' + FName;
694 if ImageTransferForm.visible = False then ImageTransferForm.show;
695 while FileSize(DropboxFile) <> CurrentFileSize do sleep(1000); //elh
696 ImageTransferForm.ProgressBar.Max := TotalImages; //elh
697 ImageTransferForm.ProgressBar.Position := CurrentImage+2; //elh
698 if TotalImages = (CurrentImage+2) then begin
699 Sleep(1000);
700 ImageTransferForm.hide;
701 end;
702 //Now move DropBox\FileName --> LocalFileNamePath
703 if MoveFile(pchar(DropboxFile),pchar(LocalSaveFNamePath))=false then begin
704 MessageDlg('Dropbox file transfer failed. Code='+InttoStr(GetLastError),
705 mtError,[mbOK],0);
706 end;
707 end;
708end;
709
710
711function TfrmImages.DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
712var
713 i,count : integer;
714 j : word;
715 OutFile : TFileStream;
716 s : AnsiString;
717 Buffer : array[0..1024] of byte;
718 RefreshCountdown : integer;
719
720const
721 RefreshInterval = 500;
722
723begin
724 if FileExists(LocalSaveFNamePath) then begin
725 DeleteFile(LocalSaveFNamePath);
726 end;
727 if UseDropBox then begin
728 Result := DownloadFileViaDropBox(FPath,FName,LocalSaveFNamePath,CurrentImage,TotalImages);
729 exit;
730 end;
731 Result := true; //default to success;
732 StatusText('Retrieving full image...');
733 //Note: the '1' in the line below is hard-coding in to use
734 //IEN=1 in file 2005.2 (NETWORK LOCATION). This file will
735 //instruct the server which relative path to store the file into
736 //If I want to have more than one NETWORK LOCATION, then I would
737 //need to create another RPC call that would determine which IEN
738 //to use.
739 //(This would be the same as the IEN stored in fields# 2, 2.1, 2.2
740 // of file 2005 (IMAGE). This in turn is originally obtained from
741 //file IMAGING SITE PARAMETERS
742 CallV('TMG DOWNLOAD FILE', [FPath,FName,'1']);
743 Application.ProcessMessages;
744 RefreshCountdown := RefreshInterval;
745 //Note:RPCBrokerV.Results[0]=1 if successful load, =0 if failure
746 if (RPCBrokerV.Results.Count>0) and (RPCBrokerV.Results[0]='1') then begin
747 OutFile := TFileStream.Create(LocalSaveFNamePath,fmCreate);
748 for i:=1 to (RPCBrokerV.Results.Count-1) do begin
749 s :=Decode(RPCBrokerV.Results[i]);
750 count := Length(s);
751 if count>1024 then begin
752 Result := false; //failure of load.
753 break;
754 end;
755 for j := 1 to count do Buffer[j-1] := ord(s[j]);
756 OutFile.Write(Buffer,count);
757 Dec(RefreshCountdown);
758 if RefreshCountdown < 1 then begin
759 Application.ProcessMessages;
760 RefreshCountdown := RefreshInterval;
761 end;
762 end;
763 OutFile.Free;
764 end else begin
765 result := false;
766 end;
767 StatusText('');
768end;
769
770
771function TfrmImages.Encode(Input: AnsiString) : AnsiString;
772//This function is based on ENCODE^RGUTUU, which is match for
773//DECODE^RGUTUU that is used to decode (ascii armouring) on the
774//server side. This is a base64 encoder.
775const
776 //FYI character set is 64 characters (starting as 'A')
777 // (65 characters if intro '=' is counted)
778 CharSet = '=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
779var
780 //Result : AnsiString; // RGZ1 //'Result' is implicitly declared by Pascal
781
782 i : integer; //RGZ2
783 j : integer; //RGZ4
784 PlainTrio : longword; //RGZ3 //unsigned 32-bit
785 EncodedByte : Byte;
786 PlainByte : byte; //RGZ5
787 EncodedQuad : string[4];//RGZ6
788
789begin
790 //e.g. input (10 bytes):
791 // 174 231 193 16 29 251 93 138 4 57
792 // AE E7 C1 10 1D FB 5D 8A 04 39
793 Result := '';
794 i := 1;
795 while i<= Length(Input) do begin //cycle in groups of 3
796 PlainTrio := 0;
797 EncodedQuad := '';
798 //Get 3 bytes, to be converted into 4 characters eventually.
799 //Fill with 0's if needed to make an even 3-byte group.
800 For j:=0 to 2 do begin
801 //e.g. '174'->PlainByte=174
802 if (i+j) <= Length(Input) then PlainByte := ord(Input[i+j])
803 else PlainByte := 0;
804 PlainTrio := (PlainTrio shl 8) or PlainByte;
805 end;
806 //e.g. first 3 bytes--> PlainTrio= $AEE7C1 (10101110 11100111 11000001)
807 //e.g. last 3 bytes--> PlainTrio= $390000 (00111001 00000000 00000000) (note padded 0's)
808
809 //Take each 6 bits and convert into a character.
810 //e.g. first 3 bytes--> (101011 101110 011111 000001)
811 // 43 46 31 1
812
813 //e.g. last 3 bytes-->(001110 010000 000000 000000) (after redivision)
814 // 14 16 0 0 <-- last 2 bytes are padded 0
815 // ^ last 4 bits of '16' are padded 0's
816 For j := 1 to 4 do begin
817 //e.g. $AEE7C1 --> (43+2)=45 (46+2)=48 (31+2)=33 (1+2)=3
818 // r u f b
819
820 //e.g. $39AF00 --> (14+2)=16 (16+2)=18 (0+2)=2 (0+2)=2
821 // O Q A A <-- 2 padded bytes
822 EncodedByte := (PlainTrio and 63)+2; //63=$3F=b0111111; 0->A 1->B etc
823 EncodedQuad := CharSet[EncodedByte]+ EncodedQuad; //string Concat, not math add
824 PlainTrio := PlainTrio shr 6
825 end;
826
827 //Append result with latest quad
828 Result := Result + EncodedQuad;
829 Inc(i,3);
830 end;
831
832 // e.g. result: rufb .... .... OQAA <-- 2 padded bytes (and part of Q is padded also)
833 i := 3-(Length(Input) mod 3); //returns 1,2,or 3 (3 needs to be set to 0)
834 if (i=3) then i:=0; //e.g. input=10 -> i=2
835 j := Length(Result);
836 //i is the number of padded characters that need to be replaced with '='
837 if i>=1 then Result[j] := '='; //replace 1st paddeded char
838 if i>=2 then Result[Length(Result)-1] := '=';//replace 2nd paddeded char
839 // e.g. result: rufb .... .... OQ==
840
841 //results passed out in Result
842end;
843
844
845function TfrmImages.Decode(Input: AnsiString) : AnsiString;
846//This function is based on DECODE^RGUTUU, which is match for
847//ENCODE^RGUTUU that is used to encode (ascii armouring) on the
848//server side. This is a Base64 decoder
849const
850 //FYI character set is 64 characters (starting as 'A')
851 // (65 characters if intro '=' is counted)
852 CharSet = '=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
853
854var
855 //Result : AnsiString; // RGZ1 //'Result' is implicitly declared by Pascal
856 i : integer; //RGZ2
857 PlainTrio : longword; //RGZ3 //unsigned 32-bit
858 j : integer; //RGZ4
859 EncodedChar : char;
860 PlainInt : integer;
861 PlainByte : byte; //RGZ5
862 DecodedTrio : string[3];//RGZ6
863
864begin
865 Result:='';
866 i := 1;
867 //e.g. input: rufb .... .... OQ==
868
869 while i <= Length(Input) Do begin //cycle in groups of 4
870 PlainTrio :=0;
871 DecodedTrio :='';
872 //Get 4 characters, to be converted into 3 bytes.
873 For j :=0 to 3 do begin
874 //e.g. last 4 chars --> 0A==
875 if (i+j) <= Length(Input) then begin
876 EncodedChar := Input[i+j];
877 PlainInt := Pos(EncodedChar,CharSet)-2; //A=0, B=1 etc.
878 if (PlainInt>=0) then PlainByte := (PlainInt and $FF) else PlainByte := 0;
879 end else PlainByte := 0;
880 //e.g. with last 4 characters:
881 //e.g. '0'->14=(b001110) 'Q'->16=(b010000) '='-> -1 -> 0=(b000000) '=' -> 0=(b000000)
882 //e.g.-- So last PlainTrio = 001110 010000 000000 000000 = 00111001 00000000 00000000
883 //Each encoded character contributes 6 bytes to final 3 bytes.
884 //4 chars * 6 bits/char=24 bits --> 24 bits / 8 bits/byte = 3 bytes
885 PlainTrio := (PlainTrio shl 6) or PlainByte; //PlainTrio := PlainTrio*64 + PlainByte;
886 end;
887 //Now take 3 bytes, and add to cumulative output (in same order)
888 For j :=0 to 2 do begin
889 DecodedTrio := Chr(PlainTrio and $FF) + DecodedTrio; //string concat (not math addition)
890 PlainTrio := PlainTrio shr 8; // PlainTrio := PlainTrio div 256
891 end;
892 //e.g. final DecodedTrio = 'chr($39) + chr(0) + chr(0)'
893 Result := Result + DecodedTrio;
894 Inc(i,4);
895 end;
896
897 //Now remove 1 byte from the output for each '=' in input string
898 //(each '=' represents 1 padded 0 added to allow for even groups of 3)
899 for j :=0 to 1 do begin
900 if (Input[Length(Input)-j] = '=') then begin
901 Result := MidStr(Result,1,Length(Result)-1);
902 end;
903 end;
904end;
905
906procedure TfrmImages.NewNoteSelected(EditIsActive : boolean);
907//Will be called by fNotes when a new note has been selected.
908//var
909begin
910 ClearTabPages();
911 CurImageToLoad := 0; //a -1 would signal that no images avail to load.
912 //this will start downloading images after 5 second delay (so that if
913 //user is just browsing past note, this won't waste effort.
914 //If user selects images tab, then load will occur without delay.
915 timLoadImages.Enabled := true;
916 timLoadImages.Interval := 60000; //60 sec delay -- also set in timLoadImagesTimer
917 //Note: OnTimer calls timLoadImagesTimer()
918 UploadImagesButton.Enabled := EditIsActive;
919 UploadImagesMnuAction.Enabled := EditIsActive;
920 WebBrowser.Navigate(NullImageName);
921end;
922
923
924procedure TfrmImages.EmptyCache();
925//This will delete ALL files in the Cache directory
926//Note: This will include the html_note file created by
927// the notes tab.
928var
929 //CacheDir : AnsiString;
930 FoundFile : boolean;
931 FSearch : TSearchRec;
932 Files : TStringList;
933 i : integer;
934 FName : AnsiString;
935
936begin
937 Files := TStringList.Create;
938// CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
939 FoundFile := (FindFirst(CacheDir+'\*.*',faAnyFile,FSearch)=0);
940 while FoundFile do Begin
941 FName := FSearch.Name;
942 if (FName <> '.') and (FName <> '..') then begin
943 FName := CacheDir + '\' + FName;
944 Files.Add(FName);
945 end;
946 FoundFile := (FindNext(FSearch)=0);
947 end;
948
949 for i := 0 to Files.Count-1 do begin
950 FName := Files.Strings[i];
951 if DeleteFile(FName) = false then begin
952 //kt raise Exception.Create('Unable to delete file: '+FSearch.Name+#13+'Will try again later...');
953 end;
954 end;
955 Files.Free;
956end;
957
958
959
960procedure TfrmImages.UploadImagesButtonClick(Sender: TObject);
961var
962 Node: TORTreeNode;
963 AddResult : TModalResult;
964begin
965 inherited;
966 AddResult := UploadForm.ShowModal;
967 if not IsAbortResult(AddResult) then begin
968 NewNoteSelected(true); //force a reload to show recently added image.
969 timLoadImages.Interval := 100;
970 Node := TORTreeNode(frmNotes.tvNotes.Selected);
971 case Node.StateIndex of
972 IMG_NO_IMAGES : Node.StateIndex := IMG_1_IMAGE;
973 IMG_1_IMAGE : Node.StateIndex := IMG_2_IMAGES;
974 IMG_2_IMAGES : Node.StateIndex := IMG_MANY_IMAGES;
975 IMG_MANY_IMAGES : Node.StateIndex := IMG_MANY_IMAGES;
976 end;
977 end;
978end;
979
980procedure TfrmImages.FormHide(Sender: TObject);
981begin
982 inherited;
983// Application.MessageBox('Here I can hide images.','title');
984end;
985
986procedure TfrmImages.TabControlChange(Sender: TObject);
987var
988 FileName : AnsiString;
989 Rec : TImageInfo;
990 Selected : integer;
991begin
992 inherited;
993 //here tab has been changed.
994 Selected := TabControl.TabIndex;
995 if Selected > -1 then begin
996 Rec := TImageInfo(ImageInfoList[Selected]);
997 FileName := Rec.CacheFName;
998 UpdateImageInfoMemo(Rec);
999 end else begin
1000 FileName := NullImageName;
1001 UpdateImageInfoMemo(nil);
1002 end;
1003 WebBrowser.Navigate(FileName);
1004end;
1005
1006procedure TfrmImages.TabControlGetImageIndex(Sender: TObject;
1007 TabIndex: Integer;
1008 var ImageIndex: Integer);
1009//specify which image to display, from ThumbsImageList
1010begin
1011 inherited;
1012 if (ImageInfoList <> nil) and (TabIndex < ImageInfoList.Count) then begin
1013 ImageIndex := TImageInfo(ImageInfoList[TabIndex]).TabImageIndex;
1014 end else ImageIndex := 0;
1015end;
1016
1017procedure TfrmImages.TabControlResize(Sender: TObject);
1018begin
1019 inherited;
1020 if TabControl.Width < 80 then begin
1021 TabControl.Width := 80;
1022 end;
1023end;
1024
1025function TfrmImages.CreateBarcode(MsgStr: AnsiString; ImageType: AnsiString): AnsiString;
1026//Create a local barcode file, in .png format, from MsgStr
1027//ImageType is optional, default ='png'. It should NOT contain '.'
1028//Returns file path on local client of new barcode image.
1029//Note: this function is not related to uploading or downloading images
1030// to the server for attaching to progress notes. It is included
1031// in this unit because the functionality used is nearly identical to
1032// the other code.
1033 function UniqueFName : AnsiString;
1034 var FName,tempFName : AnsiString;
1035 count : integer;
1036 begin
1037 FName := 'Barcode-Image';
1038 count := 0;
1039 repeat
1040 tempFName := CacheDir + '\' + FName + '.' + ImageType;
1041 FName := FName + '1';
1042 count := count+1;
1043 until (fileExists(tempFName)=false) or (count> 32);
1044 result := tempFName;
1045 end;
1046
1047var
1048 i,count : integer;
1049 j : word;
1050 OutFile : TFileStream;
1051 s : AnsiString;
1052 Buffer : array[0..1024] of byte;
1053 LocalSaveFNamePath : AnsiString;
1054
1055begin
1056 StatusText('Getting Barcode...');
1057 LocalSaveFNamePath := UniqueFName;
1058 Result := LocalSaveFNamePath; //default to success;
1059
1060 // CallV('TMG BARCODE ENCODE', [MsgStr]);
1061 RPCBrokerV.ClearParameters := true;
1062 RPCBrokerV.remoteprocedure := 'TMG BARCODE ENCODE';
1063 RPCBrokerV.param[0].Value := MsgStr;
1064 RPCBrokerV.param[0].PType := literal;
1065 RPCBrokerV.Param[1].Value := '.X'; //<-- is this needed or used?
1066 RPCBrokerV.Param[1].PType := list;
1067 RPCBrokerV.Param[1].Mult['"IMAGE TYPE"'] := ImageType;
1068 RPCBrokerV.Call;
1069
1070 Application.ProcessMessages;
1071 //Note:RPCBrokerV.Results[0]=1 if successful load, =0 if failure
1072 if (RPCBrokerV.Results.Count>0) and (RPCBrokerV.Results[0]='1') then begin
1073 OutFile := TFileStream.Create(LocalSaveFNamePath,fmCreate);
1074 for i:=1 to (RPCBrokerV.Results.Count-1) do begin
1075 s :=Decode(RPCBrokerV.Results[i]);
1076 count := Length(s);
1077 if count>1024 then begin
1078 Result := ''; //failure of load.
1079 break;
1080 end;
1081 for j := 1 to count do Buffer[j-1] := ord(s[j]);
1082 OutFile.Write(Buffer,count);
1083 end;
1084 OutFile.Free;
1085 end else begin
1086 result := '';
1087 end;
1088 StatusText('');
1089end;
1090
1091
1092function TfrmImages.DecodeBarcode(LocalFNamePath,ImageType: AnsiString): AnsiString;
1093//Decode data from barcode on image, or return '' if none
1094//Note: if I could find a cost-effective way of decoding this on client side,
1095// then that code be done here in the function, instead of uploading image
1096// to the server for decoding.
1097const
1098 RefreshInterval = 500;
1099 BlockSize = 512;
1100
1101var
1102 ReadCount : Word;
1103 ParamIndex : LongWord;
1104 j : word;
1105 InFile : TFileStream;
1106 Buffer : array[0..1024] of byte;
1107 RefreshCountdown : integer;
1108 OneLine : AnsiString;
1109 RPCResult : AnsiString;
1110 SavedCursor : TCursor;
1111 totalReadCount : integer;
1112begin
1113 result := ''; //default of failure
1114 if not FileExists(LocalFNamePath) then exit;
1115 try
1116 InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat);
1117 //Note: I may well cut this out. Most of the delay occurs during
1118 // the RPC call, and I can't make a progress bar change during that...
1119 // (or I could, but I'm not going to change the RPC broker...)
1120 ImageTransferForm.setMax(InFile.Size);
1121 //ImageTransferForm.ResetStartTime;
1122 ImageTransferForm.ProgressMsg.Caption := 'Preparing to upload...';
1123 ImageTransferForm.Show;
1124 totalReadCount := 0;
1125 except
1126 // catch failure here... on eError...
1127 exit;
1128 end;
1129
1130 StatusText('Checking image for barcodes...');
1131 Application.ProcessMessages;
1132
1133 RPCBrokerV.ClearParameters := true;
1134 RPCBrokerV.Param.Clear;
1135 RPCBrokerV.Param[0].PType := list;
1136 ParamIndex := 0;
1137 RefreshCountdown := RefreshInterval;
1138 //Put image data into parameter 0 (ARRAY parameter of RPC on server side)
1139 repeat
1140 ReadCount := InFile.Read(Buffer,BlockSize);
1141 OneLine := '';
1142 totalReadCount := totalReadCount + ReadCount;
1143 ImageTransferForm.updateProgress(totalReadCount);
1144 if ReadCount > 0 then begin
1145 SetLength(OneLine,ReadCount);
1146 for j := 1 to ReadCount do OneLine[j] := char(Buffer[j-1]);
1147 RPCBrokerV.Param[0].Mult[IntToStr(ParamIndex)] := Encode(OneLine);
1148 Inc(ParamIndex);
1149 Dec(RefreshCountdown);
1150 if RefreshCountdown < 1 then begin
1151 Application.ProcessMessages;
1152 RefreshCountdown := RefreshInterval;
1153 end;
1154 end;
1155 until (ReadCount < BlockSize);
1156 RPCBrokerV.Param[1].PType := literal;
1157 RPCBrokerV.Param[1].Value := ImageType;
1158
1159 RPCBrokerV.remoteprocedure := 'TMG BARCODE DECODE';
1160
1161 SavedCursor := Screen.Cursor;
1162 Screen.Cursor := crHourGlass;
1163 ImageTransferForm.ProgressMsg.Caption := 'Uploading file to server...';
1164 Application.ProcessMessages;
1165
1166 CallBroker; //this is the slow step, pass to server and get response.
1167
1168 Screen.Cursor := SavedCursor;
1169 ImageTransferForm.Hide;
1170 //Get result: 1^DecodedMessage, or 0^Error Message
1171 RPCResult := RPCBrokerV.Results[0];
1172 if Piece(RPCResult,'^',1)='0' then begin
1173 MessageDlg(Piece(RPCResult,'^',2),mtError,[mbOK],0);
1174 end else begin
1175 result := Piece(RPCResult,'^',2);
1176 end;
1177
1178 InFile.Free;
1179 StatusText('');
1180end;
1181
1182
1183procedure TfrmImages.EnableAutoScanUploadClick(Sender: TObject);
1184begin
1185 inherited;
1186 AutoScanUpload.Checked := not AutoScanUpload.Checked;
1187 uTMGOptions.WriteBool('Scan Enabled',AutoScanUpload.Checked);
1188end;
1189
1190
1191procedure TfrmImages.PickScanFolderClick(Sender: TObject);
1192var
1193 CurScanDir : string;
1194begin
1195 inherited;
1196 CurScanDir := UploadForm.ScanDir;
1197 OpenDialog.InitialDir := CurScanDir;
1198 MessageDlg('Please pick ANY file in the desired directory.',mtInformation,[mbOK],0);
1199 if OpenDialog.Execute then begin
1200 UploadForm.SetScanDir(ExtractFilePath(OpenDialog.FileName));
1201 end;
1202 AutoScanUpload.Checked := true;
1203end;
1204
1205function TfrmImages.FileSize(fileName : wideString) : Int64;
1206var
1207 sr : TSearchRec;
1208begin
1209 if FindFirst(fileName, faAnyFile, sr ) = 0 then
1210 result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) + Int64(sr.FindData.nFileSizeLow)
1211 else
1212 result := -1;
1213
1214 FindClose(sr) ;
1215end;
1216
1217initialization
1218 //put init code here
1219
1220finalization
1221 //put finalization code here
1222
1223end.
1224
Note: See TracBrowser for help on using the repository browser.