Changeset 801 for cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas
- Timestamp:
- Jun 16, 2010, 8:23:07 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas
r800 r801 41 41 published 42 42 end; 43 44 TImgTransferMethod = (itmDropbox,itmDirect,itmRPC); 43 45 44 46 TfrmImages = class(TfrmPage) … … 97 99 ImageInfoList : TList; 98 100 LastDisplayedTIUIEN : AnsiString; 99 CurImageToLoad: integer;100 I nTimerFn : Boolean;101 NumImagesAvailableOnServer : integer; 102 ImageIndexLastDownloaded : integer; 101 103 procedure EnsureImageListLoaded(); 102 104 procedure ClearImageList(); … … 108 110 procedure UpdateImageInfoMemo(Rec: TImageInfo); 109 111 function FileSize(fileName : wideString) : Int64; 112 function GetImagesCount : integer; 113 function GetImageInfo(Index : integer) : TImageInfo; 114 procedure SetupTimer; 110 115 public 111 116 CacheDir : AnsiString; 112 UseDropBox : boolean;117 TransferMethod : TImgTransferMethod; 113 118 DropBoxDir : string; 114 119 NullImageName : AnsiString; 120 DownloadImagesInBackground : boolean; 115 121 function Decode(input: AnsiString) : AnsiString; 116 122 function Encode(input: AnsiString) : AnsiString; … … 127 133 function DecodeBarcode(LocalFNamePath,ImageType: AnsiString): AnsiString; 128 134 procedure EnsureImagesDownloaded(ImagesList : TStringList); 135 procedure EnsureALLImagesDownloaded; 136 property ImagesCount : integer read GetImagesCount; 137 property ImageInfo[index : integer] : TImageInfo read GetImageInfo; 138 procedure GetThumbnailBitmapForFName (FName : string; Bitmap : TBitmap); 139 function ThumbnailIndexForFName (FName : string) : integer; 129 140 published 130 141 end; 142 143 Const 144 IMAGE_TRANSFER_METHODS : Array[itmDropbox..itmRPC] of string[32] = ( 145 'Dropbox Transfer', 'Direct Access', 'Embedded in RPCs'); 146 IMAGE_DOWNLOAD_DELAY_BACKGROUND = 30000; 147 IMAGE_DOWNLOAD_DELAY_FOREGROUND = 100; 148 NOT_YET_CHECKED_SERVER = -2; 149 150 //NOTE: If order is changed in ThumbsImageList, these numbers should be changed 151 IMAGE_INDEX_IMAGE = 0; 152 IMAGE_INDEX_ADOBE = 1; 153 IMAGE_INDEX_VIDEO = 2; 154 IMAGE_INDEX_SOUND = 3; 155 IMAGE_INDEX_MISC = 4; 131 156 132 157 var … … 157 182 begin 158 183 inherited; 159 if InTimerFn=false then begin 160 InTimerFn := true; 161 EnsureImageListLoaded(); //only does RPC call if CurImageToLoad = 0 162 if CurImageToLoad <> -1 then begin //-1 means RPC-> no avail images. 163 if CurImageToLoad < ImageInfoList.Count then begin 164 ImageTransferForm.ProgressMsg.Caption := 'Downloading Images'; 165 //if ImageTransferForm.Visible = false then begin 166 // ImageTransferForm.Show; 167 //end; 168 DownloadToCache(CurImageToLoad); //Only load 1 image per timer firing. 169 SetupTab(CurImageToLoad); 170 Inc(CurImageToLoad); 171 if TabControl.TabIndex < 0 then TabControl.TabIndex := 0; 172 TabControlChange(self); 173 end else begin 174 timLoadImages.Enabled := false; 175 //ImageTransferForm.ProgressBar.Position := 100; 176 //Sleep(1000); 177 //ImageTransferForm.Hide; 178 end; 179 end; 180 InTimerFn := false; 181 if self.Visible = true then begin 182 timLoadImages.Interval :=100; 183 end else begin 184 timLoadImages.Interval :=30000; //30 sec delay 185 end; 186 end; 187 end; 188 184 timLoadImages.Enabled := false; 185 EnsureImageListLoaded(); 186 if NumImagesAvailableOnServer = 0 then exit; 187 if (ImageIndexLastDownloaded >= (ImageInfoList.Count-1)) then exit; 188 ImageTransferForm.ProgressMsg.Caption := 'Downloading Images'; 189 DownloadToCache(ImageIndexLastDownloaded+1); //Only load 1 image per timer firing. 190 SetupTab(ImageIndexLastDownloaded+1); 191 Inc(ImageIndexLastDownloaded); 192 if TabControl.TabIndex < 0 then TabControl.TabIndex := 0; 193 TabControlChange(self); 194 SetupTimer; 195 end; 196 197 procedure TfrmImages.SetupTimer; 198 begin 199 if DownloadImagesInBackground then begin 200 timLoadImages.Interval := IMAGE_DOWNLOAD_DELAY_BACKGROUND; 201 end else begin 202 timLoadImages.Interval := IMAGE_DOWNLOAD_DELAY_FOREGROUND; 203 end; 204 timLoadImages.Enabled := true; 205 end; 189 206 190 207 procedure TfrmImages.EnsureImagesDownloaded(ImagesList : TStringList); … … 219 236 end; 220 237 238 procedure TfrmImages.EnsureALLImagesDownloaded; 239 //This function's goal is to download ALL images in the FOREground. 240 begin 241 EnsureImageListLoaded(); 242 if NumImagesAvailableOnServer = 0 then exit; 243 ImageTransferForm.ProgressMsg.Caption := 'Downloading Images'; 244 while (ImageIndexLastDownloaded < (ImageInfoList.Count-1)) do begin 245 DownloadToCache(ImageIndexLastDownloaded+1); //Only load 1 image per timer firing. 246 SetupTab(ImageIndexLastDownloaded+1); 247 Inc(ImageIndexLastDownloaded); 248 if TabControl.TabIndex < 0 then TabControl.TabIndex := 0; 249 TabControlChange(self); 250 end; 251 end; 221 252 222 253 { TPage common methods --------------------------------------------------------------------- } … … 241 272 begin 242 273 inherited; 243 InTimerFn:=false;244 274 LastDisplayedTIUIEN := '0'; 245 275 ImageInfoList := TList.Create; 246 CurImageToLoad := 0; 276 ClearImageList(); //sets up other needed variables. 277 DownloadImagesInBackground := true; 247 278 CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache'; 248 279 //NullImageName := ExtractFilePath(ParamStr(0)) + 'images\blank.htm'; … … 250 281 if not DirectoryExists(CacheDir) then ForceDirectories(CacheDir); 251 282 252 //UseDropBox := uTMGOptions.ReadBool('Use dropbox directory for transfers',false);253 if uTMGOptions.ReadInteger('ImageTransferMethod',0) = 0 then begin283 TransferMethod := TImgTransferMethod(uTMGOptions.ReadInteger('ImageTransferMethod',2)); 284 {if uTMGOptions.ReadInteger('ImageTransferMethod',0) = 0 then begin 254 285 UseDropBox := True; 255 286 end else begin 256 287 UseDropBox := False; 257 end; 288 end;} 258 289 DropBoxDir := uTMGOptions.ReadString('Dropbox directory','??'); 259 290 if DropBoxDir='??' then begin //just on first run. … … 273 304 274 305 procedure TfrmImages.FormShow(Sender: TObject); 275 var 276 TIUIEN : AnsiString; 277 306 var TIUIEN : AnsiString; 278 307 begin 279 308 inherited; 280 309 TIUIEN := IntToStr(frmNotes.lstNotes.ItemID); 281 timLoadImages.Enabled := true;282 timLoadImages.Interval := 100;310 DownloadImagesInBackground := false; 311 SetupTimer; 283 312 if LastDisplayedTIUIEN <> TIUIEN then begin 284 313 UpdateNoteInfoMemo(); … … 380 409 Bitmap.Height := ThumbsImageList.Height; 381 410 index := ThumbsImageList.Add(Bitmap,nil); 382 TImageInfo(ImageInfoList[i]).TabImageIndex := index; 411 //TImageInfo(ImageInfoList[i]).TabImageIndex := index; 412 Rec.TabImageIndex := index; 383 413 Bitmap.Free; 384 414 end else begin 385 Ext := LowerCase(ExtractFileExt(Rec.CacheFName)); 386 Ext := MidStr(Ext,2,99); 387 if (Ext='jpg') 388 or (Ext='jpeg') 389 or (Ext='png') 390 or (Ext='tif') 391 or (Ext='tiff') 392 or (Ext='gif') 393 or (Ext='bmp') then begin 394 TImageInfo(ImageInfoList[i]).TabImageIndex := 0; //camera image 395 end else 396 if (Ext='pdf') then begin 397 TImageInfo(ImageInfoList[i]).TabImageIndex := 1; //adobe icon 398 end else 399 if (Ext='avi') 400 or (Ext='qt') 401 or (Ext='mpg') 402 or (Ext='mpeg') then begin 403 TImageInfo(ImageInfoList[i]).TabImageIndex := 2; //video icon 404 end else 405 if (Ext='mp3') 406 or (Ext='wma') 407 or (Ext='au') 408 or (Ext='wav') then begin 409 TImageInfo(ImageInfoList[i]).TabImageIndex := 3; //sound icon 410 end else 411 begin 412 TImageInfo(ImageInfoList[i]).TabImageIndex := 4; // misc icon 413 end; 415 Rec.TabImageIndex := ThumbnailIndexForFName(Rec.CacheFName); 414 416 end; 415 417 end; 416 418 TabControl.Tabs.Add(' '); //add the tab. Thumbnail should exist before this 417 419 end; 420 end; 421 422 function TfrmImages.ThumbnailIndexForFName (FName : string) : integer; 423 var 424 index : integer; 425 Ext : AnsiString; 426 begin 427 Result := 4; //default 428 Ext := LowerCase(ExtractFileExt(FName)); 429 Ext := MidStr(Ext,2,99); 430 if (Ext='jpg') 431 or (Ext='jpeg') 432 or (Ext='png') 433 or (Ext='tif') 434 or (Ext='tiff') 435 or (Ext='gif') 436 or (Ext='bmp') then begin 437 Result := IMAGE_INDEX_IMAGE; //camera image 438 end else 439 if (Ext='pdf') then begin 440 Result := IMAGE_INDEX_ADOBE; //adobe icon 441 end else 442 if (Ext='avi') 443 or (Ext='qt') 444 or (Ext='mpg') 445 or (Ext='mpeg') then begin 446 Result := IMAGE_INDEX_VIDEO; //video icon 447 end else 448 if (Ext='mp3') 449 or (Ext='wma') 450 or (Ext='au') 451 or (Ext='wav') then begin 452 Result := IMAGE_INDEX_SOUND; //sound icon 453 end else 454 begin 455 Result := IMAGE_INDEX_MISC; // misc icon 456 end; 457 end; 458 459 460 procedure TfrmImages.GetThumbnailBitmapForFName (FName : string; Bitmap : TBitmap); 461 var index: integer; 462 begin 463 index := ThumbnailIndexForFName(FName); 464 ThumbsImageList.GetBitmap(index,Bitmap); 418 465 end; 419 466 … … 437 484 ImageInfoList.Delete(i); 438 485 end; 486 NumImagesAvailableOnServer := NOT_YET_CHECKED_SERVER; 487 ImageIndexLastDownloaded := -1; 439 488 end; 440 489 … … 442 491 procedure TfrmImages.EnsureImageListLoaded(); 443 492 begin 444 if CurImageToLoad = 0then begin493 if NumImagesAvailableOnServer = NOT_YET_CHECKED_SERVER then begin 445 494 GetImageList(); 446 if ImageInfoList.Count=0 then CurImageToLoad := -1;447 495 end; 448 496 end; 449 497 450 498 procedure TfrmImages.GetImageList(); 499 //Sets up ImageInfoList 451 500 var 452 501 i,j : integer; … … 470 519 on E: Exception do exit; 471 520 end; 472 //----MOVED473 521 StatusText('Retrieving images information...'); 474 522 CallV('MAG3 CPRS TIU NOTE', [TIUIEN]); … … 530 578 end; 531 579 end; 532 //----END MOVED533 580 StatusText(''); 581 NumImagesAvailableOnServer := ImageInfoList.Count; 534 582 end; 535 583 … … 628 676 result := false; //default of failure 629 677 if not FileExists(LocalFNamePath) then exit; 630 if UseDropBox then begin 678 //if UseDropBox then begin 679 if TransferMethod = itmDropbox then begin 631 680 Result := UploadFileViaDropBox(LocalFNamePath,FPath,FName,CurrentImage,TotalImages); 632 681 exit; 633 682 end; 683 //LATER add support for itmDirect mode 634 684 try 635 685 InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat); … … 639 689 // (or I could, but I'm not going to change the RPC broker...) 640 690 ImageTransferForm.setMax(InFile.Size); 641 //ImageTransferForm.ResetStartTime;642 691 ImageTransferForm.ProgressMsg.Caption := 'Preparing to upload...'; 643 692 ImageTransferForm.Show; … … 786 835 DeleteFile(LocalSaveFNamePath); 787 836 end; 788 if UseDropBox then begin 837 //if UseDropBox then begin 838 if TransferMethod = itmDropbox then begin 789 839 Result := DownloadFileViaDropBox(FPath,FName,LocalSaveFNamePath,CurrentImage,TotalImages); 790 840 exit; 791 841 end; 842 //LATER add support for itmDirect mode 792 843 Result := true; //default to success; 793 844 StatusText('Retrieving full image...'); … … 970 1021 begin 971 1022 ClearTabPages(); 972 CurImageToLoad := 0; //a -1 would signal that no images avail to load. 973 //this will start downloading images after 5 second delay (so that if 1023 DownloadImagesInBackground := true; 1024 SetupTimer; 1025 //This will start downloading images after few second delay (so that if 974 1026 //user is just browsing past note, this won't waste effort. 975 1027 //If user selects images tab, then load will occur without delay. 976 timLoadImages.Enabled := true;977 timLoadImages.Interval := 60000; //60 sec delay -- also set in timLoadImagesTimer978 1028 //Note: OnTimer calls timLoadImagesTimer() 979 1029 UploadImagesButton.Enabled := EditIsActive; … … 1028 1078 if not IsAbortResult(AddResult) then begin 1029 1079 NewNoteSelected(true); //force a reload to show recently added image. 1030 timLoadImages.Interval := 100;1080 timLoadImages.Interval := IMAGE_DOWNLOAD_DELAY_FOREGROUND; 1031 1081 Node := TORTreeNode(frmNotes.tvNotes.Selected); 1032 1082 case Node.StateIndex of … … 1042 1092 begin 1043 1093 inherited; 1094 DownloadImagesInBackground := true; 1095 1044 1096 // Application.MessageBox('Here I can hide images.','title'); 1045 1097 end; … … 1277 1329 end; 1278 1330 1331 function TfrmImages.GetImagesCount : integer; 1332 //Returns number of images possible, not just those already downloaded. 1333 begin 1334 EnsureImageListLoaded(); 1335 Result := NumImagesAvailableOnServer; 1336 end; 1337 1338 function TfrmImages.GetImageInfo(Index : integer) : TImageInfo; 1339 begin 1340 if (Index > -1) and (Index < ImageInfoList.Count) then begin 1341 Result := TImageInfo(ImageInfoList[Index]); 1342 end else begin 1343 Result := nil; 1344 end; 1345 end; 1346 1347 1348 1279 1349 initialization 1280 1350 //put init code here
Note:
See TracChangeset
for help on using the changeset viewer.