source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/SearchAnimationU.pas@ 800

unit SearchAnimationU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, ImgList;

type
  TfrmTMGServerSearch = class(TForm)
    AnimationImageList: TImageList;
    AnimationImage: TImage;
    lblSearching: TLabel;
    ProgressBar: TProgressBar;
    btnCancel: TBitBtn;
    AnimationTimer: TTimer;
    CheckServerTimer: TTimer;
    lblMessages: TLabel;
    procedure AnimationTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure CheckServerTimerTimer(Sender: TObject);
  private
    { Private declarations }
    ImageIndex : integer;
    Picture : TPicture;
    FJobNumber : string;
    procedure UpdatePicture;
    function JobActive(JobNumber : String; OUT PercentDone : Integer;
                       OUT Comments : string): Boolean;
  public
    { Public declarations }
    FoundRecsCount : string; //Out parameter only.
    function ActivateForm(JobNumber : string) : integer;
  end;

var
  frmTMGServerSearch: TfrmTMGServerSearch;

implementation

{$R *.dfm}

  uses ORNet, ORFn, Trpcb, ORCtrls;

  const
    MAX_NUM_IMAGE_INDEX = 15;


  procedure TfrmTMGServerSearch.FormCreate(Sender: TObject);
  begin
    ImageIndex := 0;
    Picture := TPicture.Create;
  end;

  procedure TfrmTMGServerSearch.FormDestroy(Sender: TObject);
  begin
    Picture.Free;
  end;

  procedure TfrmTMGServerSearch.FormShow(Sender: TObject);
  begin
    AnimationTimer.Enabled := true;
    CheckServerTimer.Enabled := true;
  end;

  procedure TfrmTMGServerSearch.FormHide(Sender: TObject);
  begin
    AnimationTimer.Enabled := false;
    CheckServerTimer.Enabled := false;
  end;

  function TfrmTMGServerSearch.ActivateForm(JobNumber : string) : integer;
  begin
    FJobNumber := JobNumber;
    Result := ShowModal;
  end;

  procedure TfrmTMGServerSearch.UpdatePicture;
  begin
    Inc(ImageIndex);
    if ImageIndex > MAX_NUM_IMAGE_INDEX then ImageIndex := 0;
    AnimationImageList.GetBitmap(ImageIndex,Picture.Bitmap);
    AnimationImage.Picture.Assign(Picture);
  end;

  procedure TfrmTMGServerSearch.AnimationTimerTimer(Sender: TObject);
  begin
    AnimationTimer.Enabled := false;
    UpdatePicture;
    AnimationTimer.Enabled := true;
  end;

  procedure TfrmTMGServerSearch.CheckServerTimerTimer(Sender: TObject);
  var PctDone : Integer;
      Comments : string;
  begin
    CheckServerTimer.Enabled := false;
    if JobActive(FJobNumber, PctDone, Comments) = false then begin
      ModalResult := mrOK;
    end;
    ProgressBar.Position := PctDone;
    lblMessages.Caption := Comments;
    CheckServerTimer.Enabled := true;
  end;


  procedure TfrmTMGServerSearch.btnCancelClick(Sender: TObject);
  begin
    //Do anything needed here before closing form.
    //(Hide function is executed next)
    Self.ModalResult := mrCancel;
  end;


  function TfrmTMGServerSearch.JobActive(JobNumber : String;
                                         OUT PercentDone : Integer;
                                         OUT Comments : string): Boolean;
  //Check the job status
  var  cmd, RPCResult  : string;
  begin
    RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
    RPCBrokerV.param[0].ptype := list;
    RPCBrokerV.Param[0].Value := '.X';
    cmd := 'STATUS';
    cmd := cmd + '^' + JobNumber;
    RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
    RPCBrokerV.Call;
    if RPCBrokerV.Results.Count > 0 then begin
      RPCResult := RPCBrokerV.Results[0];
      //Check piece 1 for -1 that indicates an error...
      if Piece(RPCResult,'^',1) = '-1' then begin
        result := false;
        exit;
      end;
      PercentDone := StrToIntDef(piece(RPCResult,'^',2),0);
      Comments := piece(RPCResult,'^',3);
      FoundRecsCount := piece(RPCResult,'^',4);
      Result := (Comments <> '#DONE#');
    end else begin
      result := true;
    end;
  end;




end.