unit InfoFrm;
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TShowInfoForm = class(TForm)
    ShowInfoLabel: TLabel;
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    {v0.65}
    FCallerID: integer;
    {/v0.65}
    procedure SetMsg(const AMsg: string);
    function GetMsg: string;
  public
    { Public declarations }
    property Msg: string read GetMsg write SetMsg;
  end;

var
  FShowInfoForm: TShowInfoForm = nil;

type
   TInfoForm = class(TShowInfoForm);

procedure InfoFormShow(AMsg:string);
procedure InfoFormHide;

{v0.65}
function MsgFormShow(AMsg: string; ACallerID: integer): TShowInfoForm;
procedure MsgFormHide(ACallerID: integer);
{/v0.65}
implementation
{$R *.DFM}

procedure TShowInfoForm.SetMsg(const AMsg: string);
begin
  ShowInfoLabel.Caption := AMsg;
end;

function TShowInfoForm.GetMsg: string;
begin
  Result := ShowInfoLabel.Caption;
end;
{v0.62}
function ShowInfoForm: TShowInfoForm;
begin
  if FShowInfoForm = nil then
    FShowInfoForm := TShowInfoForm.Create(Application);
  Result := FShowInfoForm;
end;
{/v0.62}
procedure InfoFormShow(AMsg:string);
begin
  ShowInfoForm.ShowInfoLabel.Caption := AMsg;
  ShowInfoForm.Show;
  Application.ProcessMessages;
end;

procedure InfoFormHide;
begin
  ShowInfoForm.Hide;
end;

{v0.65}
var
  FMsgForms: TList;

function MsgFormFind(var AForm: TInfoForm; ACallerID: integer): boolean;
var
  i: integer;
begin
  Result := false;
  AForm := nil;
  for i := 0 to FMsgForms.Count - 1 do begin
    if TInfoForm(FMsgForms[i]).FCallerID = ACallerID then begin
      AForm := TInfoForm(FMsgForms[i]);
      Result := true;
      exit;
    end;
  end;
end;

function MsgFormShow(AMsg: string; ACallerID: integer): TShowInfoForm;
var
  f: TInfoForm;
begin
  if not MsgFormFind(f, ACallerID) then begin
    f := TInfoForm.Create(Application);
    f.FCallerID := ACallerID;
  end;
  f.Msg := AMsg;
  f.Show;
  Result := f;
end;

procedure MsgFormHide(ACallerID: integer);
var
  f: TInfoForm;
begin
  if MsgFormFind(f, ACallerID) then
    f.Free;
end;

procedure TShowInfoForm.FormDestroy(Sender: TObject);
var i: integer;
begin
  i := FMsgForms.IndexOf(Self);
  if i >= 0 then
    FMsgForms.Delete(i);
end;

initialization
  FMsgForms := TList.Create;
finalization
  FMsgForms.Free;
{/v0.65}

end.
