Changeset 877 for cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas

Timestamp:

Jul 15, 2010, 8:02:17 PM (14 years ago)

Author:

Kevin Toppenberg

Message:

Dual sync of source code enabled: SVN + BZR

File:

• cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas (modified) (21 diffs)

cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas

@@ -12 +12 @@
 
 type
+  TImgDelMode = (idmNone,idmDelete,idmRetract); //NOTE: DO NOT change order
   TImageInfo = class
     private
@@ -81 +82 @@
     PickScanFolder: TMenuItem;
     OpenDialog: TOpenDialog;
+    mnuPopup: TPopupMenu;
+    mnuPopDeleteImage: TMenuItem;
+    mnuDeleteImage: TMenuItem;
     procedure mnuChartTabClick(Sender: TObject);
     procedure mnuActNewClick(Sender: TObject);
@@ -96 +100 @@
     procedure EnableAutoScanUploadClick(Sender: TObject);
     procedure PickScanFolderClick(Sender: TObject);
+    procedure TabControlMouseUp(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure mnuPopupPopup(Sender: TObject);
+    procedure mnuPopDeleteImageClick(Sender: TObject);
+    procedure mnuDeleteImageClick(Sender: TObject);
   private
     ImageInfoList : TList;
     LastDisplayedTIUIEN : AnsiString;
     ImageIndexLastDownloaded : integer;
+    FDeleteImageIndex : integer;
+    FEditIsActive : boolean;
+    FImageDeleteMode : TImgDelMode;
     procedure EnsureImageListLoaded();
     procedure ClearImageList();
@@ -112 +124 @@
     function GetImageInfo(Index : integer) : TImageInfo;
     procedure SetupTimer;
+    function CanDeleteImages : boolean;
+    procedure DeleteImageIndex(ImageIndex : integer; DeleteMode : TImgDelMode; boolPromptUser: boolean);
+    procedure DeleteImage(var DeleteSts: TActionRec; ImageFileName: string; ImageIEN, DocIEN: Integer;
+                          DeleteMode : TImgDelMode; const Reason: string);
   public
     CacheDir : AnsiString;
@@ -134 +150 @@
     procedure EnsureImagesDownloaded(ImagesList : TStringList);
     procedure EnsureALLImagesDownloaded;
+    procedure DeleteAll(DeleteMode: TImgDelMode);
     property ImagesCount : integer read GetImagesCount;
     property ImageInfo[index : integer] : TImageInfo read GetImageInfo;
@@ -169 +186 @@
      FIconLegend, fPCEEdit, fNoteIDParents, rSurgery, uSurgery, uTemplates,
      uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog, DateUtils,
-     StrUtils {//KT added 1-1-05},
-     mshtml,  {//kt added 5-2-05}
-     UploadImages, {//kt added 9/25/05}
-     //ImageTransferForm, {//kt 10-1-05}
+     StrUtils, mshtml, UploadImages,
      uTMGOptions,  //kt 3/10/10
-     rHTMLTools, fNotes, frmImageTransferProgress;  {//kt added 5-27-05 for IsHTMLDocument}
+     rHTMLTools, fNotes, frmImageTransferProgress, fImagePickExisting;  {//kt added 5-27-05 for IsHTMLDocument}
+
+
+procedure TfrmImages.FormCreate(Sender: TObject);
+//var i : integer;
+begin
+  inherited;
+  LastDisplayedTIUIEN := '0';
+  FDeleteImageIndex := -1;
+  ImageInfoList := TList.Create;
+  ClearImageList(); //sets up other needed variables.
+  DownloadImagesInBackground := true;
+  CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
+  NullImageName := 'about:blank';
+  if not DirectoryExists(CacheDir) then ForceDirectories(CacheDir);
+
+  TransferMethod := TImgTransferMethod(uTMGOptions.ReadInteger('ImageTransferMethod',2));
+  DropBoxDir := uTMGOptions.ReadString('Dropbox directory','??');
+  if DropBoxDir='??' then begin  //just on first run.
+    uTMGOptions.WriteBool('Use dropbox directory for transfers',false);
+    uTMGOptions.WriteString('Dropbox directory','');
+  end;
+  AutoScanUpload.Checked := uTMGOptions.ReadBool('Scan Enabled',false);
+end;
+
+procedure TfrmImages.FormDestroy(Sender: TObject);
+begin
+  inherited;
+  ClearImageList;
+  ImageInfoList.Free;
+  EmptyCache;
+end;
+
+procedure TfrmImages.FormShow(Sender: TObject);
+var  TIUIEN : AnsiString;
+begin
+  inherited;
+  mnuDeleteImage.Enabled := CanDeleteImages;
+  TIUIEN := IntToStr(frmNotes.lstNotes.ItemID);
+  DownloadImagesInBackground := false;
+  SetupTimer;
+  if LastDisplayedTIUIEN <> TIUIEN then begin
+    UpdateNoteInfoMemo();
+    LastDisplayedTIUIEN := TIUIEN;
+  end;
+end;
 
 
@@ -266 +325 @@
 begin
   inherited;
-end;
-
-procedure TfrmImages.FormCreate(Sender: TObject);
-//var i : integer;
-begin
-  inherited;
-  LastDisplayedTIUIEN := '0';
-  ImageInfoList := TList.Create;
-  ClearImageList(); //sets up other needed variables.
-  DownloadImagesInBackground := true;
-  CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
-  //NullImageName := ExtractFilePath(ParamStr(0)) + 'images\blank.htm';
-  NullImageName := 'about:blank';
-  if not DirectoryExists(CacheDir) then ForceDirectories(CacheDir);
-
-  TransferMethod := TImgTransferMethod(uTMGOptions.ReadInteger('ImageTransferMethod',2));
-  {if uTMGOptions.ReadInteger('ImageTransferMethod',0) = 0 then begin
-     UseDropBox := True;
-  end else begin
-     UseDropBox := False;
-  end;}
-  DropBoxDir := uTMGOptions.ReadString('Dropbox directory','??');
-  if DropBoxDir='??' then begin  //just on first run.
-    uTMGOptions.WriteBool('Use dropbox directory for transfers',false);
-    uTMGOptions.WriteString('Dropbox directory','');
-  end;
-  AutoScanUpload.Checked := uTMGOptions.ReadBool('Scan Enabled',false);
-end;
-
-procedure TfrmImages.FormDestroy(Sender: TObject);
-begin
-  inherited;
-  ClearImageList;
-  ImageInfoList.Free;
-  EmptyCache;
-end;
-
-procedure TfrmImages.FormShow(Sender: TObject);
-var  TIUIEN : AnsiString;
-begin
-  inherited;
-  TIUIEN := IntToStr(frmNotes.lstNotes.ItemID);
-  DownloadImagesInBackground := false;
-  SetupTimer;
-  if LastDisplayedTIUIEN <> TIUIEN then begin
-    UpdateNoteInfoMemo();
-    LastDisplayedTIUIEN := TIUIEN;
-  end;
 end;
 
@@ -475 +486 @@
 procedure TfrmImages.ClearImageList();
 //Note: !! This should also clear any visible images/thumbnails etc.
+//Note: Need to remove thumbnail image from image list.
 var i    : integer;
 begin
@@ -637 +649 @@
   end;
 
-  // CallV('TMG UPLOAD FILE DROPBOX', ...);
+  CallV('TMG UPLOAD FILE DROPBOX', [FPath,FName]);     //Move file into dropbox.
+  {
   RPCBrokerV.ClearParameters := true;
   RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE DROPBOX';
@@ -647 +660 @@
   RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
 
-  //RPCBrokerV.Call;  //Move file into dropbox.
-  CallBroker;
+  CallBroker; //Move file into dropbox.
+  }
   if RPCBrokerV.Results.Count>0 then begin
     Result := (Piece(RPCBrokerV.Results[0],'^',1)='1');  //1=success, 0=failure
@@ -700 +713 @@
   Application.ProcessMessages;
 
+  RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE';
   RPCBrokerV.ClearParameters := true;
   RPCBrokerV.Param[0].PType := literal;
@@ -706 +720 @@
   RPCBrokerV.Param[1].Value := FName;
   RPCBrokerV.Param[2].PType := literal;
-  RPCBrokerV.Param[2].Value := '1';
-  //Note: the '1' in the line above is hard-coding in to use
-  //IEN=1 in file 2005.2 (NETWORK LOCATION).  This file will
-  //instruct the server which relative path to store the file into
-  //If I want to have more than one NETWORK LOCATION, then I would
-  //need to create another RPC call that would determine which IEN
-  //to use.
-  //(This would be the same as the IEN stored in fields# 2, 2.1, 2.2
-  // of file 2005 (IMAGE).  This in turn is originally obtained from
-  //file IMAGING SITE PARAMETERS
+  RPCBrokerV.Param[2].Value := ''; //kt 7/11/10
+  //RPCBrokerV.Param[2].Value := '1'; //Specifying a NETWORK LOCATION is now depreciated.
 
   RPCBrokerV.Param[3].PType := list;
-
   ParamIndex := 0;
   RefreshCountdown := RefreshInterval;
@@ -738 +743 @@
         RefreshCountdown := RefreshInterval;
       end;
-
     end;
   until (ReadCount < BlockSize);
-
-  RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE';
 
   SavedCursor := Screen.Cursor;
@@ -750 +752 @@
 
   CallBroker;
+
   Screen.Cursor := SavedCursor;
   if RPCBrokerV.Results.Count > 0 then begin
@@ -772 +775 @@
   ErrMsg          : string;
 begin
-  // CallV('TMG DOWNLOAD FILE DROPBOX', ...);
-  RPCBrokerV.ClearParameters := true;
+  CallV('TMG DOWNLOAD FILE DROPBOX', [FPath,FName]);  //Move file into dropbox.
+ {RPCBrokerV.ClearParameters := true;
   RPCBrokerV.remoteprocedure := 'TMG DOWNLOAD FILE DROPBOX';
   RPCBrokerV.param[0].PType := literal;
@@ -781 +784 @@
   RPCBrokerV.Param[2].PType := literal;
   RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
-
-  //RPCBrokerV.Call;  //Move file into dropbox.
-  CallBroker;
+  CallBroker; }
   if RPCBrokerV.Results.Count > 0 then begin
     Result := (Piece(RPCBrokerV.Results[0],'^',1)='1');  //1=success, 0=failure
@@ -835 +836 @@
     DeleteFile(LocalSaveFNamePath);
   end;
-  //if UseDropBox then begin
   if TransferMethod = itmDropbox then begin
     Result := DownloadFileViaDropBox(FPath,FName,LocalSaveFNamePath,CurrentImage,TotalImages);
@@ -843 +843 @@
   Result := true; //default to success;
   StatusText('Retrieving full image...');
-  //Note: the '1' in the line below is hard-coding in to use
-  //IEN=1 in file 2005.2 (NETWORK LOCATION).  This file will
-  //instruct the server which relative path to store the file into
-  //If I want to have more than one NETWORK LOCATION, then I would
-  //need to create another RPC call that would determine which IEN
-  //to use.
-  //(This would be the same as the IEN stored in fields# 2, 2.1, 2.2
-  // of file 2005 (IMAGE).  This in turn is originally obtained from
-  //file IMAGING SITE PARAMETERS
-  CallV('TMG DOWNLOAD FILE', [FPath,FName,'1']);
+  //kt CallV('TMG DOWNLOAD FILE', [FPath,FName,'1']); //kt 7/10/10 Specifying a NETWORK LOCATION is depreciated.
+  CallV('TMG DOWNLOAD FILE', [FPath,FName]);
   Application.ProcessMessages;
   RefreshCountdown := RefreshInterval;
@@ -965 +957 @@
 
 var
-  //Result : AnsiString;  // RGZ1  //'Result' is implicitly declared by Pascal
-  i : integer;               //RGZ2
-  PlainTrio : longword;   //RGZ3   //unsigned 32-bit
-  j : integer;               //RGZ4
+  //Result : AnsiString;  //RGZ1  //'Result' is implicitly declared by Pascal
+  i : integer;            //RGZ2
+  PlainTrio : longword;   //RGZ3  //unsigned 32-bit
+  j : integer;            //RGZ4
   EncodedChar : char;
   PlainInt : integer;
@@ -1027 +1019 @@
   //If user selects images tab, then load will occur without delay.
   //Note: OnTimer calls timLoadImagesTimer()
+  FEditIsActive := EditIsActive;
   UploadImagesButton.Enabled := EditIsActive;
   UploadImagesMnuAction.Enabled := EditIsActive;
@@ -1347 +1340 @@
 
 
+procedure TfrmImages.TabControlMouseUp(Sender: TObject; Button: TMouseButton;
+                                       Shift: TShiftState; X, Y: Integer);
+//kt add 7/6/10
+var TabIndex : integer;
+    P : TPoint;
+begin
+  inherited;
+  if Button <> mbRight then exit;
+  TabIndex := TabControl.IndexOfTabAt(X,Y);
+  if TabIndex < 0 then exit;
+  FDeleteImageIndex := TabIndex;
+  P.X := X; P.Y := Y;
+  P := TabControl.ClientToScreen(P);
+  TabControl.PopupMenu := mnuPopup;
+  mnuPopup.Popup(P.X, P.Y);
+  TabControl.PopupMenu := nil;
+end;
+
+procedure TfrmImages.mnuPopupPopup(Sender: TObject);
+//Determine here if delete option should be enabled.
+begin
+  inherited;
+  mnuPopDeleteImage.Enabled := CanDeleteImages;
+end;
+
+function TfrmImages.CanDeleteImages : boolean;
+//Determine here if image can be deleted.
+var
+  ActionSts: TActionRec;
+const
+  ATTACHED_IMAGES_SERVER_REPLY = 'You must "delete" the Images using the Imaging package before proceeding.';
+begin
+  FImageDeleteMode := idmNone;
+  Result := false; //default action
+  if FEditIsActive then begin
+    Result := true;
+    FImageDeleteMode := idmDelete;
+    exit;
+  end;
+  //Will use same user class managment rules for images as for notes.
+  //So if user can delete a note, then they can also delete images.
+  ActOnDocument(ActionSts, frmNotes.lstNotes.ItemIEN, 'DELETE RECORD');
+  if (ActionSts.Success = false) then begin
+    if Pos(ATTACHED_IMAGES_SERVER_REPLY, ActionSts.Reason) > 0 then ActionSts.Success := true;
+  end;
+  Result := ActionSts.Success;
+  if Result then begin
+    if AuthorSignedDocument(frmNotes.lstNotes.ItemIEN) then FImageDeleteMode := idmRetract
+    else FImageDeleteMode := idmDelete;
+  end;
+end;
+
+procedure TfrmImages.mnuPopDeleteImageClick(Sender: TObject);
+begin
+  inherited;
+  DeleteImageIndex(FDeleteImageIndex, FImageDeleteMode, True);
+end;
+
+procedure TfrmImages.DeleteAll(DeleteMode: TImgDelMode);
+begin
+  EnsureALLImagesDownloaded;
+  while TabControl.Tabs.Count > 0 do begin
+    DeleteImageIndex(0,DeleteMode,False);
+    NewNoteSelected(False);
+    EnsureALLImagesDownloaded;
+    frmImages.Formshow(self);
+  end;
+end;
+
+
+procedure TfrmImages.DeleteImageIndex(ImageIndex : integer; DeleteMode : TImgDelMode; boolPromptUser: boolean);
+//Note: permissions must be checked before running this function
+var
+  ImageInfo : TImageInfo;
+  ReasonForDelete : string;
+  DeleteSts : TActionRec;
+
+CONST
+  TMG_PRIVACY  = 'FOR PRIVACY';  //Server message (don't translate)
+  TMG_ADMIN    = 'ADMINISTRATIVE'; //Server message (don't translate)
+
+begin
+  if (ImageIndex<0) or (ImageIndex>=ImagesCount) then begin
+    MessageDlg('Invalid image index to delete: '+IntToStr(ImageIndex), mtError,[mbOK],0);
+    exit;
+  end;
+  ImageInfo := Self.ImageInfo[ImageIndex];
+  if boolPromptUser then begin
+    ReasonForDelete := SelectDeleteReason(frmNotes.lstNotes.ItemIEN);
+    if ReasonForDelete = DR_CANCEL then Exit;
+    if ReasonForDelete = DR_PRIVACY then begin
+      ReasonForDelete := TMG_PRIVACY;
+    end else if ReasonForDelete = DR_ADMIN then begin
+      ReasonForDelete := TMG_ADMIN;
+    end;
+  end else begin
+    ReasonForDelete := 'DeleteAll';
+  end;
+
+  DeleteImage(DeleteSts, ImageInfo.ServerFName, ImageInfo.IEN, frmNotes.lstNotes.ItemIEN, DeleteMode, ReasonForDelete);
+end;
+
+procedure TfrmImages.DeleteImage(var DeleteSts: TActionRec;
+                                 ImageFileName: String;
+                                 ImageIEN, DocIEN: Integer;
+                                 DeleteMode : TImgDelMode;
+                                 const Reason: string);  //Reason should be 10-60 chars;
+
+  function ServerImageDelete(ImageIEN:integer; DeleteMode:tImgDelMode; Reason:String) : boolean;
+  //Returns success
+  var RPCResult,IEN,Mode : string;
+  begin
+    IEN := IntToStr(ImageIEN);
+    Mode := IntToStr(Ord(DeleteMode));
+    RPCResult := sCallV('TMG IMAGE DELETE', [IEN,Mode,Reason]);
+    Result := Piece(RPCResult,'^',1)= '1';
+    if Result = false then begin
+      MessageDlg(Piece(RPCResult,'^',2),mtError,[mbOK],0);
+    end;
+  end;
+
+  procedure NoteImageDelete(DocIEN:integer; FileName: string; DeleteMode:tImgDelMode; Reason:String);
+  var
+     NoteText, tempString: string;
+     Beginning, Ending: integer;
+     boolFound: boolean;
+  // <!-- Retracted By: UserName on Date  ...;..   -->
+  // FEditIsActive
+  begin
+     if FEditIsActive then begin
+       Ending := 1;
+       Beginning := 1;
+       boolFound := False;
+       While (boolFound = False) AND (Beginning > 0) Do Begin
+         NoteText := frmNotes.HtmlEditor.HTMLText;
+         Beginning := PosEx('<IMG',NoteText, Ending);
+         Ending :=  PosEx('>', NoteText, Beginning) + 1;
+         tempString := MidStr(NoteText, Beginning, Ending-Beginning);
+         if pos(FileName,tempString) > 0 then boolFound := True;
+       end;
+       if boolFound = false then  begin
+         Ending := 1;
+         Beginning := 1;
+         boolFound := False;
+         While (boolFound = False) AND (Beginning > 0) Do Begin
+           NoteText := frmNotes.HtmlEditor.HTMLText;
+           Beginning := PosEx('<embed',NoteText, Ending);
+           Ending :=  PosEx('>', NoteText, Beginning) + 1;
+           tempString := MidStr(NoteText, Beginning, Ending-Beginning);
+           if pos(FileName,tempString) > 0 then boolFound := True;
+         end;
+       end;
+       if boolFound = False then exit;
+       if DeleteMode = idmDelete then begin
+         frmnotes.HtmlEditor.HTMLText := AnsiReplaceStr(frmNotes.HtmlEditor.HTMLText, tempString, '');
+       end else if DeleteMode = idmRetract then begin
+         frmnotes.HtmlEditor.HTMLText := AnsiReplaceStr(frmNotes.HtmlEditor.HTMLText, tempString, ' <!-- ' + tempString + ' Retracted By: ' + User.Name + ' on ' +  DateToStr(Now));
+       end;
+       //ClearImageList;
+       //EmptyCache;
+       //frmImages.FormHide(self);
+       //LastDisplayedTIUIEN := '0';
+       //frmImages.Formshow(self);
+       NewNoteSelected(True);
+       frmImages.Formshow(self);
+     end else begin
+       //NewNoteSelected(True);
+       //frmImages.Formshow(self);
+     end;
+  end;
+
+begin
+  //'Permanently delete attached image or file?'
+  //Create dialog that gives option to export before deleting?
+  //"You are about to permanently delete this image. Would you like to export before deletion? Yes/No/Cancel
+  //Yes = export dialog then delete (if export is later cancelled assume cancel was pressed here), No=Only Delete, Cancel = No deletion
+  if Reason <> 'DeleteAll' then begin
+    if MessageDlg(DKLangConstW('fImages_ConfirmDelete'),mtConfirmation,mbOKCancel,0) <> mrOK then exit;
+  end;
+  if ServerImageDelete(ImageIEN,DeleteMode,Reason) = false then exit;
+  NoteImageDelete(DocIEN,ImageFileName,DeleteMode,Reason);
+  if DeleteMode = idmRetract then begin
+    InfoBox(DKLangConstW('fImages_Retract_1')+CRLF + // 'This image or file will now be RETRACTED.  As such, it has been'
+            DKLangConstW('fImages_Retract_2')+CRLF + // 'removed from public view, and from typical Releases of Information,'
+            DKLangConstW('fImages_Retract_2'),      // ' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
+            DKLangConstW('fImages_Retraction_Notice'),MB_OK);
+  end;
+end;
+
+
+procedure TfrmImages.mnuDeleteImageClick(Sender: TObject);
+var
+   SelectedImageTab,i : integer;
+   ImageInfo : TImageInfo;
+begin
+  inherited;
+  If TabControl.Tabs.Count < 1 then exit;
+  frmImagePickExisting := TfrmImagePickExisting.Create(Self);
+  if frmImagePickExisting.ShowModal = mrOK then begin
+    //ImageFName := frmImagePickExisting.SelectedImageFName;
+    if not assigned(frmImagePickExisting.SelectedImageInfo) then exit;
+    for i := 0 to TabControl.Tabs.Count - 1 do begin
+      ImageInfo := Self.ImageInfo[i];
+      if frmImagePickExisting.SelectedImageInfo.ServerFName = ImageInfo.ServerFName then begin
+        SelectedImageTab := i;
+      end;
+    end;
+    if frmNotes.HTMLEditor.Active then begin
+      FEditIsActive := true;
+      DeleteImageIndex(SelectedImageTab,idmDelete,True);
+    end else begin
+      FEditIsActive := false;
+      DeleteImageIndex(SelectedImageTab,idmRetract,True);
+    end;
+    NewNoteSelected(False);
+    EnsureALLImagesDownloaded;
+    frmImages.Formshow(self);
+  end;
+  FreeAndNil(frmImagePickExisting);
+end;
+
 initialization
   //put init code here