unit fImages;   //kt Entire unit and form added 8/19/05
{$O-}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fPage, StdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConst, ORDtTm,
  uPCE, ORClasses, fDrawers, ImgList, rTIU, uTIU, uDocTree, fRptBox, fPrintList,
  OleCtrls, SHDocVw,
  ORNet, TRPCB, fHSplit, Buttons, ExtDlgs, DKLang;

type
  TImageInfo = class
    private
    public
      IEN :                int64;    //IEN in file# 2005
      ServerPathName :     AnsiString;
      ServerFName :        AnsiString;
      ServerThumbPathName: AnsiString;
      ServerThumbFName :   AnsiString;
      //Note: if there is no thumbnail to download, CacheThumbFName will still
      //      contain a file name and path, but a test for FileExists() will wail.
      CacheThumbFName :    AnsiString; // local cache path and File name of thumbnail image
      CacheFName :         AnsiString; // local cache path and File name of image
      ShortDesc :          AnsiString;
      LongDesc :           TStringList; //will be nil unless holds data.
      DateTime :           AnsiString;  //fileman format
      ImageType :          Integer;
      ProcName :           AnsiString;
      DisplayDate :        AnsiString;
      ParentDataFileIEN:   int64;
      AbsType :            char;      //'M' magnetic 'W' worm  'O' offline
      Accessibility :      char;      //'A' accessable  or  'O' offline
      DicomSeriesNum :     int64;
      DicomImageNum :      int64;
      GroupCount :         integer;
      TabIndex :           integer;
      TabImageIndex :      integer;

    published
  end;

  TfrmImages = class(TfrmPage)
    mnuNotes: TMainMenu;
    mnuView: TMenuItem;
    mnuViewChart: TMenuItem;
    mnuChartReports: TMenuItem;
    mnuChartLabs: TMenuItem;
    mnuChartDCSumm: TMenuItem;
    mnuChartCslts: TMenuItem;
    mnuChartNotes: TMenuItem;
    mnuChartOrders: TMenuItem;
    mnuChartMeds: TMenuItem;
    mnuChartProbs: TMenuItem;
    mnuChartCover: TMenuItem;
    mnuAct: TMenuItem;
    Z3: TMenuItem;
    mnuOptions: TMenuItem;
    timLoadImages: TTimer;
    N3: TMenuItem;
    mnuIconLegend: TMenuItem;
    mnuChartSurgery: TMenuItem;
    ThumbsImageList: TImageList;
    CurrentNoteMemo: TMemo;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    UploadImagesButton: TBitBtn;
    OpenPictureDialog: TOpenPictureDialog;
    ButtonPanel: TPanel;
    CurrentImageMemo: TMemo;
    MemosPanel: TPanel;
    UploadImagesMnuAction: TMenuItem;
    Panel2: TPanel;
    TabControl: TTabControl;
    WebBrowser: TWebBrowser;
    procedure mnuChartTabClick(Sender: TObject);
    procedure mnuActNewClick(Sender: TObject);
    procedure timLoadImagesTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mnuActClick(Sender: TObject);
    procedure UploadImagesButtonClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure TabControlChange(Sender: TObject);
    procedure TabControlGetImageIndex(Sender: TObject; TabIndex: Integer;
      var ImageIndex: Integer);
    procedure TabControlResize(Sender: TObject);
  private
    ImageInfoList : TList;
    LastDisplayedTIUIEN : AnsiString;
    CurImageToLoad : integer;
    InTimerFn : Boolean;
    procedure EnsureImageListLoaded();
    procedure ClearImageList();
    procedure DownloadToCache(ImageIndex : integer);
    procedure EmptyCache();
    procedure ClearTabPages();
    procedure SetupTab(i : integer);
    procedure UpdateNoteInfoMemo();
    procedure UpdateImageInfoMemo(Rec: TImageInfo);
  public
    CacheDir : AnsiString;
    NullImageName : AnsiString;
    function Decode(input: AnsiString) : AnsiString;
    function Encode(input: AnsiString) : AnsiString;
    function DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString): boolean;
    function UploadFile(LocalFNamePath,FPath,FName: AnsiString): boolean;
    procedure SplitLinuxFilePath(FullPathName : AnsiString;
                                 var Path : AnsiString;
                                 var FName : AnsiString);
    procedure GetImageList();
    procedure NewNoteSelected(EditIsActive : boolean);
  published
  end;

var
  frmImages: TfrmImages;


implementation

{$R *.DFM}

uses fFrame, fVisit, fEncnt, rCore, uCore, fNoteBA, fNoteBD, fSignItem, fEncounterFrame,
     rPCE, Clipbrd, fNoteCslt, fNotePrt, rVitals, fAddlSigners, fNoteDR, fConsults, uSpell,
     fTIUView, fTemplateEditor, uReminders, fReminderDialog, uOrders, rConsults, fReminderTree,
     fNoteProps, fNotesBP, fTemplateFieldEditor, dShared, rTemplates,
     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}
     UPloadProgress, {//kt 10-1-05}
     rHTMLTools, fNotes;  {//kt added 5-27-05 for IsHTMLDocument}


procedure TfrmImages.timLoadImagesTimer(Sender: TObject);
begin
  inherited;
  if InTimerFn=false then begin
    InTimerFn := true;
    EnsureImageListLoaded(); //only does RPC call if CurImageToLoad = 0
    if CurImageToLoad <> -1 then begin //-1 means RPC-> no avail images.
      if CurImageToLoad < ImageInfoList.Count then begin
        DownloadToCache(CurImageToLoad); //Only load 1 image per timer firing.
        SetupTab(CurImageToLoad);
        Inc(CurImageToLoad);
        if TabControl.TabIndex < 0 then TabControl.TabIndex := 0;
        TabControlChange(self);
      end else begin
        timLoadImages.Enabled := false;
      end;
    end;
    InTimerFn := false;
    if self.Visible = true then begin
      timLoadImages.Interval :=100;
    end else begin
      timLoadImages.Interval :=30000; //30 sec delay
    end;
  end;
end;


{ TPage common methods --------------------------------------------------------------------- }
procedure TfrmImages.mnuChartTabClick(Sender: TObject);
{ reroute to Chart Tab menu of the parent form: frmFrame }
begin
  inherited;
  frmFrame.mnuChartTabClick(Sender);
end;


procedure TfrmImages.mnuActNewClick(Sender: TObject);
const
  IS_ID_CHILD = False;
{ switches to current new note or creates a new note if none is being edited already }
begin
  inherited;
end;

procedure TfrmImages.FormCreate(Sender: TObject);
//var i : integer;
begin
  inherited;
  InTimerFn:=false;
  LastDisplayedTIUIEN := '0';
  ImageInfoList := TList.Create;
  CurImageToLoad := 0;
  CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
  NullImageName := ExtractFilePath(ParamStr(0)) + 'images\blank.htm';
  if not DirectoryExists(CacheDir) then ForceDirectories(CacheDir);
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);
  timLoadImages.Enabled := true;
  timLoadImages.Interval := 100;
  if LastDisplayedTIUIEN <> TIUIEN then begin
    UpdateNoteInfoMemo();
    LastDisplayedTIUIEN := TIUIEN;
  end;
end;

procedure TfrmImages.mnuActClick(Sender: TObject);
begin
  inherited;

end;

{ General procedures ----------------------------------------------------------------------- }

procedure TfrmImages.UpdateImageInfoMemo(Rec  : TImageInfo);
var s : AnsiString;
    i : integer;
begin
  CurrentImageMemo.Lines.Clear;
  if Rec=nil then exit;
  s := Trim(Rec.ShortDesc);
  if s <> '' then CurrentImageMemo.Lines.Add('Description: ' + s);
  s := Rec.ProcName;
  if s <> '' then CurrentImageMemo.Lines.Add('Procedure: ' + s);
  s := Rec.DisplayDate;
  if s <> '' then CurrentImageMemo.Lines.Add('Upload Date: ' + s);
  //s := Rec.DateTime;
  //if s <> '' then CurrentImageMemo.Lines.Add('Date/Time: ' + s);
  if Rec.LongDesc <> nil then begin
    CurrentImageMemo.Lines.Add('Long Description:');
    for i := 0 to Rec.LongDesc.Count-1 do begin
      CurrentImageMemo.Lines.Add('  ' + Rec.LongDesc.Strings[i]);
    end;
  end;
end;


procedure TfrmImages.UpdateNoteInfoMemo();
var
  NoteInfo,s : AnsiString;
  //dateS      : AnsiString;
const
  U='^';
begin
  CurrentNoteMemo.Lines.Clear;
  with frmNotes.lstNotes do begin
    if ItemIndex > -1 then begin
      NoteInfo := Items[ItemIndex]
      (* example NoteInfo:
        piece# 1:  14321^                        //TIU IEN
        piece# 2:  PRESCRIPTION CALL IN^         //Document Title
        piece# 3:  3050713.0947^                 //Date/Time
        piece# 4:  TEST, KILLME D (T0101)^       //Patient
        piece# 5:  133;JANE A DOE;DOE,JANE A^    //Author
        piece# 6:  Main_Office^                  //Location of Visit
        piece# 7:  completed^                    //Status of Document
        piece# 8:  Visit: 07/13/05;3050713.094721^ //Date/Time
        piece# 9...:          ;^^1^^^1^'         //?
      *)
    end else NoteInfo := '';
  end;
  if NoteInfo <>'' then begin
    s := Piece(NoteInfo, U, 2) + ' -- ';
    s := s + Piece(Piece(NoteInfo, U, 8), ';', 1);
    CurrentNoteMemo.Lines.Add(s);
    s := 'Location: ' + Piece(NoteInfo, U, 6) + ' -- ';
    s := s + 'Note Author: ' + Piece(Piece(NoteInfo, U, 5), ';', 2);
    CurrentNoteMemo.Lines.Add(s);
  end;
end;

procedure TfrmImages.SetupTab(i : integer);
//i is index in ImageInfoList (array of TImageInfo's)
var
  Rec  : TImageInfo; //this will be a copy of record, not pointer (I think)
  Bitmap : TBitmap;
  index : integer;
  Ext : AnsiString;

  (*Notice: A TabControl doesn't directly support specifying which
           images in an ImageList to show for a given tab.  To get
          around this, the help documentation recommends setting up
         a TabControlGetImageIndex event handler.
        I am doing this.  When the event is called, then RecInfo.TabImageIndex
       is returned.
  *)

begin
  if i < ImageInfoList.Count then begin
    Rec := TImageInfo(ImageInfoList[i]);
    if (Rec.TabImageIndex < 1) then begin
      if FileExists(Rec.CacheThumbFName) then begin
        Bitmap := TBitmap.Create;
        Bitmap.Width := 1024;    //something big enough to hold any thumbnail.
        Bitmap.Height := 768;
        Bitmap.LoadFromFile(Rec.CacheThumbFName);
        Bitmap.Width := ThumbsImageList.Width;  //shrinkage crops image
        Bitmap.Height := ThumbsImageList.Height;
        index := ThumbsImageList.Add(Bitmap,nil);
        TImageInfo(ImageInfoList[i]).TabImageIndex := index;
        Bitmap.Free;
      end else begin
        Ext := LowerCase(ExtractFileExt(Rec.CacheFName));
        Ext := MidStr(Ext,2,99);
        if   (Ext='jpg')
          or (Ext='jpeg')
          or (Ext='png')
          or (Ext='tif')
          or (Ext='tiff')
          or (Ext='gif')
          or (Ext='bmp') then begin
            TImageInfo(ImageInfoList[i]).TabImageIndex := 0; //camera image
        end else
        if   (Ext='pdf') then begin
            TImageInfo(ImageInfoList[i]).TabImageIndex := 1; //adobe icon
        end else
        if   (Ext='avi')
          or (Ext='qt')
          or (Ext='mpg')
          or (Ext='mpeg') then begin
            TImageInfo(ImageInfoList[i]).TabImageIndex := 2; //video icon
        end else
        if   (Ext='mp3')
          or (Ext='wma')
          or (Ext='au')
          or (Ext='wav') then begin
            TImageInfo(ImageInfoList[i]).TabImageIndex := 3; //sound icon
        end else
        begin
          TImageInfo(ImageInfoList[i]).TabImageIndex := 4; // misc icon
        end;
      end;
    end;
    TabControl.Tabs.Add(' ');  //add the tab.  Thumbnail should exist before this
  end;
end;


procedure TfrmImages.ClearTabPages();
begin
  TabControl.Tabs.Clear;
  ClearImageList();
end;


procedure TfrmImages.ClearImageList();
//Note: !! This should also clear any visible images/thumbnails etc.
var i    : integer;
begin
  for i := ImageInfoList.Count-1 downto 0 do begin
    if TImageInfo(ImageInfoList[i]).LongDesc <> nil then begin
      TImageInfo(ImageInfoList[i]).LongDesc.Free;
    end;
    TImageInfo(ImageInfoList[i]).Free;
    ImageInfoList.Delete(i);
  end;
end;


procedure TfrmImages.EnsureImageListLoaded();
begin
  if CurImageToLoad = 0 then begin
    GetImageList();
    if ImageInfoList.Count=0 then CurImageToLoad := -1;
  end;
end;

procedure TfrmImages.GetImageList();
var
  i,j : integer;
  s,s2 : AnsiString;
  Rec  : TImageInfo;
  ImageIEN : integer;
  TIUIEN : AnsiString;
  ServerFName : AnsiString;
  ServerPathName : AnsiString;
  ImageFPathName :     AnsiString;  //path on server of image  -- original data provided by server
  ThumbnailFPathName : AnsiString;  //path on server of thumbnail -- original data provided by server

begin
  inherited;
  ClearImageList;
  try
    TIUIEN := IntToStr(frmNotes.lstNotes.ItemID);
    StatusText('Retrieving images information...');
    CallV('MAG3 CPRS TIU NOTE', [TIUIEN]);
    for i:=0 to (RPCBrokerV.Results.Count-1) do begin
      s :=RPCBrokerV.Results[i];
      if i=0 then begin
        if piece(s,'^',1)='0' then break //i.e. abort due to error signal
        else continue;   //ignore rest of header (record #0)
      end;
      Rec := TImageInfo.Create; // ImageInfoList will own this.
      Rec.LongDesc := nil;
      Rec.TabIndex := -1;
      Rec.TabImageIndex := 0;
      s2 := piece(s,'^',2); if s2='' then s2 := '0'; //IEN
      Rec.IEN := StrToInt(s2);
      ImageFPathName := piece(s,'^',3);       //Image FullPath and name
      ThumbnailFPathName := piece(s,'^',4);   //Abstract FullPath and Name
      Rec.ShortDesc := piece(s,'^',5);            //SHORT DESCRIPTION field
      s2 := piece(s,'^',6); if s2='' then s2 := '0'; //PROCEDURE/ EXAM DATE/TIME field
      Rec.DateTime := s2;
      s2 := piece(s,'^',7); if s2='' then s2 := '0';  //OBJECT TYPE
      Rec.ImageType := StrToInt(s2);
      Rec.ProcName := piece(s,'^',8);                 //PROCEDURE field
      Rec.DisplayDate := piece(s,'^',9);              //Procedure Date in Display format
      s2 := piece(s,'^',10); if s2='' then s2 := '0'; //PARENT DATA FILE image pointer
      Rec.ParentDataFileIEN := StrToInt(s2);
      Rec.AbsType := piece(s,'^',11)[1];              //the ABSTYPE :  'M' magnetic 'W' worm  'O' offline
      Rec.Accessibility := piece(s,'^',12)[1];        //Image accessibility   'A' accessable  or  'O' offline
      s2 := piece(s,'^',13); if s2='' then s2 := '0'; //Dicom Series number
      Rec.DicomSeriesNum := StrToInt(s2);
      s2 := piece(s,'^',14); if s2='' then s2 := '0'; //Dicom Image Number
      Rec.DicomImageNum := StrToInt(s2);
      s2 := piece(s,'^',15); if s2='' then s2 := '0'; //Count of images in the group, or 1 if a single image
      Rec.GroupCount := StrToInt(s2);

      SplitLinuxFilePath(ImageFPathName,ServerPathName,ServerFName);
      Rec.ServerPathName := ServerPathName;
      Rec.ServerFName := ServerFName;
      Rec.CacheFName := CacheDir + '\' + ServerFName;
      SplitLinuxFilePath(ThumbnailFPathName,ServerPathName,ServerFName);
      Rec.ServerThumbPathName := ServerPathName;
      Rec.ServerThumbFName := ServerFName;
      Rec.CacheThumbFName := CacheDir + '\' + ServerFName;
      ImageInfoList.Add(Rec);  // ImageInfoList will own Rec.
    end;
    for i:= 0 to ImageInfoList.Count-1 do begin
      Rec := TImageInfo(ImageInfoList.Items[i]);
      ImageIEN := Rec.IEN;
      CallV('TMG GET IMAGE LONG DESCRIPTION', [ImageIEN]);
      for j:=0 to (RPCBrokerV.Results.Count-1) do begin
        if (j>0) then begin
          if Rec.LongDesc = nil then Rec.LongDesc := TStringList.Create;
          Rec.LongDesc.Add(RPCBrokerV.Results.Strings[j]);
        end else begin
          if RPCBrokerV.Results[j]='' then break;
        end;
      end;
    end;
  except
    //Error occurs after note is signed, and frmNotes.lstNotes.ItemID is "inaccessible"
    on E: Exception do exit;
  end;
  StatusText('');
end;


procedure TfrmImages.DownloadToCache(ImageIndex : integer);
//Loads image specified in ImageInfoList to Cache (unless already present)
var
  Rec : TImageInfo;
  ServerFName : AnsiString;
  ServerPathName : AnsiString;

begin
  Rec := TImageInfo(ImageInfoList[ImageIndex]);
  ServerFName := Rec.ServerFName;
  ServerPathName := Rec.ServerPathName;
  if not FileExists(Rec.CacheFName) then begin
    DownloadFile(ServerPathName,ServerFName,Rec.CacheFName);
  end;
  ServerFName := Rec.ServerThumbFName;
  ServerPathName := Rec.ServerThumbPathName;
  if not FileExists(Rec.CacheThumbFName) then begin
    DownloadFile(ServerPathName,ServerFName,Rec.CacheThumbFName);
  end;
  Application.ProcessMessages;
end;

procedure TfrmImages.SplitLinuxFilePath(FullPathName : AnsiString;
                                        var Path     : AnsiString;
                                        var FName    : AnsiString);
var  p : integer;
begin
  Path := '';  FName := '';
  repeat
    p := Pos('/',FullPathName);
    if p > 0 then begin
      Path := Path + MidStr(FullPathName,1,p);
      FullPathName := MidStr(FullPathName,p+1,1000);
    end else begin
      FName := FullPathName;
      FullPathName := '';
    end;
  until (FullPathName = '');
end;


function TfrmImages.UploadFile(LocalFNamePath,FPath,FName: AnsiString): boolean;
const
  RefreshInterval = 500;
  BlockSize = 512;

var
  ReadCount                     : Word;
  totalReadCount                : Integer;
  ParamIndex                    : LongWord;
  j                             : word;
  InFile                        : TFileStream;
  LocalOutFile                  : TFileStream;
  Buffer                        : array[0..1024] of byte;
  RefreshCountdown              : integer;
  OneLine                       : AnsiString;
  RPCResult                     : AnsiString;
  SavedCursor                   : TCursor;

begin
  result := false;  //default of failure
  if not FileExists(LocalFNamePath) then exit;
  try
    InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat);
    LocalOutFile := TFileStream.Create(CacheDir+'\'+FName,fmCreate or fmOpenWrite); //for local copy
    //Note: I may well cut this out.  Most of the delay occurs during
    // the RPC call, and I can't make a progress bar change during that...
    // (or I could, but I'm not going to change the RPC broker...)
    UploadProgressForm.setMax(InFile.Size);
    //UploadProgressForm.ResetStartTime;
    UploadProgressForm.ProgressMsg.Caption := 'Prepairing to upload...';
    UploadProgressForm.Show;
    totalReadCount := 0;
  except
    // catch failure here...  on eError...
    exit;
  end;

  StatusText('Uploading full image...');
  Application.ProcessMessages;

  RPCBrokerV.ClearParameters := true;
  RPCBrokerV.Param[0].PType := literal;
  RPCBrokerV.Param[0].Value := FPath;
  RPCBrokerV.Param[1].PType := literal;
  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[3].PType := list;

  ParamIndex := 0;
  RefreshCountdown := RefreshInterval;
  repeat
    ReadCount := InFile.Read(Buffer,BlockSize);
    LocalOutFile.Write(Buffer,ReadCount); //for local copy
    totalReadCount := totalReadCount + ReadCount;
    UploadProgressForm.updateProgress(totalReadCount);
    OneLine := '';
    if ReadCount > 0 then begin
      SetLength(OneLine,ReadCount);
      for j := 1 to ReadCount do OneLine[j] := char(Buffer[j-1]);
      RPCBrokerV.Param[3].Mult[IntToStr(ParamIndex)] := Encode(OneLine);
      Inc(ParamIndex);

      Dec(RefreshCountdown);
      if RefreshCountdown < 1 then begin
        Application.ProcessMessages;
        RefreshCountdown := RefreshInterval;
      end;

    end;
  until (ReadCount < BlockSize);

  RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE';

  SavedCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  UploadProgressForm.ProgressMsg.Caption := 'Uploading file to server...';
  Application.ProcessMessages;

  CallBroker;
  Screen.Cursor := SavedCursor;
  RPCResult := RPCBrokerV.Results[0];
  result := (Piece(RPCResult,'^',1)='1');
  UploadProgressForm.Hide;
  if result=false then begin
    Application.MessageBox('Error uploading file','Error');
  end;

  InFile.Free;
  LocalOutFile.Free;
  StatusText('');
end;


function TfrmImages.DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString): boolean;
var
  i,count                       : integer;
  j                             : word;
  OutFile                       : TFileStream;
  s                             : AnsiString;
  Buffer                        : array[0..1024] of byte;
  RefreshCountdown              : integer;

const
  RefreshInterval = 500;

begin
  if FileExists(LocalSaveFNamePath) then begin
    DeleteFile(LocalSaveFNamePath);
  end;
  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']);
  Application.ProcessMessages;
  RefreshCountdown := RefreshInterval;
  //Note:RPCBrokerV.Results[0]=1 if successful load, =0 if failure
  if (RPCBrokerV.Results.Count>0) and (RPCBrokerV.Results[0]='1') then begin
    OutFile := TFileStream.Create(LocalSaveFNamePath,fmCreate);
    for i:=1 to (RPCBrokerV.Results.Count-1) do begin
      s :=Decode(RPCBrokerV.Results[i]);
      count := Length(s);
      if count>1024 then begin
        Result := false; //failure of load.
        break;
      end;
      for j := 1 to count do Buffer[j-1] := ord(s[j]);
      OutFile.Write(Buffer,count);
      Dec(RefreshCountdown);
      if RefreshCountdown < 1 then begin
        Application.ProcessMessages;
        RefreshCountdown := RefreshInterval;
      end;
    end;
    OutFile.Free;
  end else begin
    result := false;
  end;
  StatusText('');
end;


function TfrmImages.Encode(Input: AnsiString) : AnsiString;
//This function is based on ENCODE^RGUTUU, which is match for
//DECODE^RGUTUU that is used to decode (ascii armouring) on the
//server side.  This is a base64 encoder.
const
  //FYI character set is 64 characters (starting as 'A')
  //  (65 characters if intro '=' is counted)
  CharSet  = '=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
  //Result : AnsiString;  // RGZ1  //'Result' is implicitly declared by Pascal

  i : integer;            //RGZ2
  j : integer;            //RGZ4
  PlainTrio : longword;   //RGZ3   //unsigned 32-bit
  EncodedByte : Byte;
  PlainByte : byte;       //RGZ5
  EncodedQuad : string[4];//RGZ6

begin
  //e.g. input (10 bytes):
  // 174 231 193   16 29 251   93 138 4    57
  // AE  E7  C1    10 1D FB    5D 8A  04   39
  Result := '';
  i := 1;
  while i<= Length(Input) do begin  //cycle in groups of 3
    PlainTrio := 0;
    EncodedQuad := '';
    //Get 3 bytes, to be converted into 4 characters eventually.
    //Fill with 0's if needed to make an even 3-byte group.
    For j:=0 to 2 do begin
      //e.g. '174'->PlainByte=174
      if (i+j) <= Length(Input) then PlainByte := ord(Input[i+j])
      else PlainByte := 0;
      PlainTrio := (PlainTrio shl 8) or PlainByte;
    end;
    //e.g. first 3 bytes--> PlainTrio= $AEE7C1 (10101110 11100111 11000001)
    //e.g. last  3 bytes--> PlainTrio= $390000 (00111001 00000000 00000000) (note padded 0's)

    //Take each 6 bits and convert into a character.
    //e.g. first 3 bytes--> (101011 101110 011111 000001)
    //                       43      46     31     1

    //e.g. last 3 bytes-->(001110 010000 000000 000000)  (after redivision)
    //                        14     16     0     0  <-- last 2 bytes are padded 0
    //                               ^ last 4 bits of '16' are padded 0's
    For j := 1 to 4 do begin
      //e.g. $AEE7C1 --> (43+2)=45 (46+2)=48 (31+2)=33 (1+2)=3
      //                         r        u         f        b

      //e.g. $39AF00 --> (14+2)=16 (16+2)=18 (0+2)=2 (0+2)=2
      //                         O        Q        A       A <-- 2 padded bytes
      EncodedByte := (PlainTrio and 63)+2;  //63=$3F=b0111111;  0->A 1->B etc
      EncodedQuad := CharSet[EncodedByte]+ EncodedQuad;  //string Concat, not math add
      PlainTrio := PlainTrio shr 6
    end;

    //Append result with latest quad
    Result := Result + EncodedQuad;
    Inc(i,3);
  end;

  // e.g. result: rufb .... .... OQAA <-- 2 padded bytes (and part of Q is padded also)
  i := 3-(Length(Input) mod 3);  //returns 1,2,or 3 (3 needs to be set to 0)
  if (i=3) then i:=0;   //e.g. input=10 -> i=2
  j := Length(Result);
  //i is the number of padded characters that need to be replaced with '='
  if i>=1 then Result[j] := '=';  //replace 1st paddeded char
  if i>=2 then Result[Length(Result)-1] := '=';//replace 2nd paddeded char
  // e.g. result: rufb .... .... OQ==

  //results passed out in Result
end;


function TfrmImages.Decode(Input: AnsiString) : AnsiString;
//This function is based on DECODE^RGUTUU, which is match for
//ENCODE^RGUTUU that is used to encode (ascii armouring) on the
//server side.  This is a Base64 decoder
const
  //FYI character set is 64 characters (starting as 'A')
  //  (65 characters if intro '=' is counted)
  CharSet  = '=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

var
  //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;
  PlainByte : byte;       //RGZ5
  DecodedTrio : string[3];//RGZ6

begin
  Result:='';
  i := 1;
  //e.g. input: rufb .... .... OQ==

  while i <= Length(Input) Do begin  //cycle in groups of 4
    PlainTrio :=0;
    DecodedTrio :='';
    //Get 4 characters, to be converted into 3 bytes.
    For j :=0 to 3 do begin
      //e.g. last 4 chars --> 0A==
      if (i+j) <= Length(Input) then begin
        EncodedChar := Input[i+j];
        PlainInt := Pos(EncodedChar,CharSet)-2; //A=0, B=1 etc.
        if (PlainInt>=0) then PlainByte := (PlainInt and $FF) else PlainByte := 0;
      end else PlainByte := 0;
      //e.g. with last 4 characters:
      //e.g. '0'->14=(b001110) 'Q'->16=(b010000) '='-> -1 -> 0=(b000000) '=' -> 0=(b000000)
      //e.g.-- So last PlainTrio = 001110 010000 000000 000000 = 00111001 00000000 00000000
      //Each encoded character contributes 6 bytes to final 3 bytes.
      //4 chars * 6 bits/char=24 bits -->  24 bits / 8 bits/byte = 3 bytes
      PlainTrio := (PlainTrio shl 6) or PlainByte;  //PlainTrio := PlainTrio*64 + PlainByte;
    end;
    //Now take 3 bytes, and add to cumulative output (in same order)
    For j :=0 to 2 do begin
      DecodedTrio := Chr(PlainTrio and $FF) + DecodedTrio;  //string concat (not math addition)
      PlainTrio := PlainTrio shr 8;  // PlainTrio := PlainTrio div 256
    end;
    //e.g. final DecodedTrio = 'chr($39) + chr(0) + chr(0)'
    Result := Result + DecodedTrio;
    Inc(i,4);
  end;

  //Now remove 1 byte from the output for each '=' in input string
  //(each '=' represents 1 padded 0 added to allow for even groups of 3)
  for j :=0 to 1 do begin
    if (Input[Length(Input)-j] = '=') then begin
      Result := MidStr(Result,1,Length(Result)-1);
    end;
  end;
end;

procedure TfrmImages.NewNoteSelected(EditIsActive : boolean);
//Will be called by  fNotes when a new note has been selected.
//var
begin
  ClearTabPages();
  CurImageToLoad := 0;  //a -1 would signal that no images avail to load.
  //this will start downloading images after 5 second delay (so that if
  //user is just browsing past note, this won't waste effort.
  //If user selects images tab, then load will occur without delay.
  timLoadImages.Enabled := true;
  timLoadImages.Interval := 60000;  //60 sec delay  -- also set in timLoadImagesTimer
  //Note: OnTimer calls timLoadImagesTimer()
  UploadImagesButton.Enabled := EditIsActive;
  UploadImagesMnuAction.Enabled := EditIsActive;
  WebBrowser.Navigate(NullImageName);
end;


procedure TfrmImages.EmptyCache();
//This will delete ALL files in the Cache directory
//Note: This will include the html_note file created by
// the notes tab.
var
  //CacheDir : AnsiString;
  FoundFile : boolean;
  FSearch : TSearchRec;
  Files : TStringList;
  i : integer;
  FName : AnsiString;

begin
  Files := TStringList.Create;
//  CacheDir := ExtractFilePath(ParamStr(0))+ 'Cache';
  FoundFile := (FindFirst(CacheDir+'\*.*',faAnyFile,FSearch)=0);
  while FoundFile do Begin
    FName := FSearch.Name;
    if (FName <> '.') and (FName <> '..') then begin
      FName := CacheDir + '\' + FName;
      Files.Add(FName);
    end;
    FoundFile := (FindNext(FSearch)=0);
  end;

  for i := 0 to Files.Count-1 do begin
    FName := Files.Strings[i];
    if DeleteFile(FName) = false then begin
      //kt raise Exception.Create('Unable to delete file: '+FSearch.Name+#13+'Will try again later...');
    end;
  end;
  Files.Free;
end;



procedure TfrmImages.UploadImagesButtonClick(Sender: TObject);
var
  Node: TORTreeNode;
  AddResult : TModalResult;
begin
  inherited;
  AddResult := UploadForm.ShowModal;
  if not IsAbortResult(AddResult) then begin
    NewNoteSelected(true);  //force a reload to show recently added image.
    timLoadImages.Interval := 100;
    Node := TORTreeNode(frmNotes.tvNotes.Selected);
    case Node.StateIndex of
      IMG_NO_IMAGES         :  Node.StateIndex := IMG_1_IMAGE;
      IMG_1_IMAGE           :  Node.StateIndex := IMG_2_IMAGES;
      IMG_2_IMAGES          :  Node.StateIndex := IMG_MANY_IMAGES;
      IMG_MANY_IMAGES       :  Node.StateIndex := IMG_MANY_IMAGES;
    end;
  end;
end;

procedure TfrmImages.FormHide(Sender: TObject);
begin
  inherited;
//  Application.MessageBox('Here I can hide images.','title');
end;

procedure TfrmImages.TabControlChange(Sender: TObject);
var
  FileName : AnsiString;
  Rec  : TImageInfo;
  Selected : integer;
begin
  inherited;
  //here tab has been changed.
  Selected := TabControl.TabIndex;
  if Selected > -1 then begin
    Rec := TImageInfo(ImageInfoList[Selected]);
    FileName := Rec.CacheFName;
    UpdateImageInfoMemo(Rec);
  end else begin
    FileName := NullImageName;
    UpdateImageInfoMemo(nil);
  end;
  WebBrowser.Navigate(FileName);
end;

procedure TfrmImages.TabControlGetImageIndex(Sender: TObject;
                                             TabIndex: Integer;
                                             var ImageIndex: Integer);
//specify which image to display, from ThumbsImageList
begin
  inherited;
  if (ImageInfoList <> nil) and (TabIndex < ImageInfoList.Count) then begin
    ImageIndex := TImageInfo(ImageInfoList[TabIndex]).TabImageIndex;
  end else ImageIndex := 0;
end;

procedure TfrmImages.TabControlResize(Sender: TObject);
begin
  inherited;
  if TabControl.Width < 80 then begin
    TabControl.Width := 80;
  end;
end;

initialization
  //put init code here

finalization
  //put finalization code here

end.

