unit OvrManu;{ Chromatograms overlay manager. }
{
  (C) 2000 - 2002 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
{$I define.pas}
uses
  Windows, SysUtils, Classes, Graphics, StdCtrls, ExtCtrls, Forms, Controls,
  FileCtrl {for MinimizeName},
  UtlType, WinUtl, ViewBuilderu,
  Spectrum;


const
  ovrInvalidOwner = 1;
           {registermessage postmessage}
  {v0.58}
  DefBoxSize = 15;
  DefFontSize = 8;
  MaxFileNameLen = 20;
  {/v0.58}
type

  TDispPeakMode = (dpmAuto, dpmOff, dpmOn);

  EOvrMan = class(Exception);

  TOvrMan = class;
  TOvrFile = class;

  TOvrLine = class(TComponent)
  private
    FULADRc: TULADRc;
    function GetVisible: boolean;
    procedure SetVisible(OnOff: boolean);
    function GetColor: TColor;
    {procedure SetColor(AColor: TColor);}
    function GetActive: boolean;
    function GetOvrMan: TOvrMan;
    procedure SetULADRc(AULADRc: TULADRc);
    function GetOvrFile: TOvrFile;
    {procedure ColorClick(Sender: TObject);}
    procedure ColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    procedure Activate(Sender: TObject);
    procedure VisibleClick(Sender: TObject);
  public
//    constructor Create(Owner: TComponent; AULADRc: TULADRc); reintroduce;
    property Visible: boolean read GetVisible write SetVisible;
    property Color: TColor read GetColor {write SetColor};
    property Active: boolean read GetActive;
    property ULADRc: TULADRc read FULADRc write SetULADRc;
    property OvrMan: TOvrMan read GetOvrMan;
    property OvrFile: TOvrFile read GetOvrFile;
  end;

  TOvrFile = class(TComponent)
  private
    FAcqData: TAcqData;
    FDispPeakMode: TDispPeakMode;
    function GetLine(Index:integer): TOvrLine;
    function GetLineCount: integer;
    function GetOvrMan: TOvrMan;
    procedure SetAcqData(AAcqData: TAcqData);
    function GetActive: boolean;
  public
    procedure CloseFile(Sender: TObject);
    procedure Activate(Sender: TObject);
    function Index: integer;
      {in spectrumform.datalist}

    property DispPeakMode: TDispPeakMode read FDispPeakMode write FDispPeakMode;
    property Active: boolean read GetActive;


    property AcqData: TAcqData read FAcqData write SetAcqData;
    property Lines[Index:integer]:TOvrLine read GetLine;
    property LineCount: integer read GetLineCount;
    property OvrMan: TOvrMan read GetOvrMan;
  end;

  TOvrMan = class(TComponent)
  private
    FViewUpdating: integer;
    FUpdateMessageID: integer;
      { registered window message for updating ovrman 'CHROMuLAN_OvrManUpdate' }
    FPanel: TPanel;
    FPanelHandler: TControlHandler;
      { if non nil, then the overlay control panel is visible in TSpectrumForm }
    function GetFile(Index: integer): TOvrFile;
    function GetFileCount: integer;
    function GetViewUpdating: boolean;
    function GetForm: TForm;
  public
    procedure UpdatePanel(Sender: TObject);
    procedure ShowPanel(Sender: TObject);
    procedure HidePanel(Sender: TObject);
    constructor Create(ASpecForm: TForm); reintroduce;
    procedure SetResult(AResult:integer; const msg: string);
    procedure Update;
      { immediate rebulding of childs and panel control childs according to
        SpecForm current state }
    procedure PostUpdate;
      { should be called if update needed from panel conrol child's event handler
        (calling Update will raise an error); will post message to SpecForm,
        that will call OvrMan.Update (when the time comes...) }
    property Files[Index: integer]: TOvrFile read GetFile;
    property FileCount: integer read GetFileCount;
    property UpdateMessageID: integer read FUpdateMessageID;
    property ViewUpdating: boolean read GetViewUpdating;
    property Form: TForm read GetForm;
  end;

implementation
uses
  SpecForm;

{TOvrLine.}
function TOvrLine.GetVisible: boolean;
begin
  Result := not FULADRc.UDVR.Hidden;
end;

procedure TOvrLine.SetVisible(OnOff: boolean);
begin
  FULADRc.UDVR.Hidden := not OnOff;
end;

procedure TOvrLine.VisibleClick(Sender: TObject);
begin
  if OvrMan.ViewUpdating then
    exit;
  with Sender as TCheckBox do begin
    FULADRc.UDVR.Hidden := not Checked;
    TSpectrumForm(OvrMan.Owner).Invalidate;
  end;
end;

function TOvrLine.GetColor: TColor;
begin
  Result := FULADRc.ULAD.Color;
end;

{procedure TOvrLine.ColorClick(Sender: TObject);}
procedure TOvrLine.ColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin
  if OvrMan.ViewUpdating then
    exit;
  if FULADRc.ULAD.FindField('Color').DoColorSelect then begin
    if Sender is TShape then begin
      TShape(Sender).Brush.Color := Color;
    end;
    OvrMan.PostUpdate;
  end;
end;

{procedure TOvrLine.SetColor(AColor: TColor);
begin
  FULADRc.ULAD.Color := AColor;
end;}

function TOvrLine.GetActive: boolean;
begin
  Result := OvrFile.AcqData.UsrActiveULADRc = FULADRc;
end;

procedure TOvrLine.Activate(Sender: TObject);
begin
  OvrFile.AcqData.UsrActiveULADRc := FULADRc;
  OvrMan.PostUpdate;
end;

function TOvrLine.GetOvrMan: TOvrMan;
begin
  Result := OvrFile.OvrMan;
end;

function TOvrLine.GetOvrFile: TOvrFile;
begin
  Result := TOvrFile(Owner);
end;

procedure TOvrLine.SetULADRc(AULADRc: TULADRc);
begin
  FULADRc := AULADRc;
end;
{/TOvrLine.}

{TOvrFile.}
procedure TOvrFile.SetAcqData(AAcqData: TAcqData);
var
  l: TOvrLine;
  i: integer;
begin
  DestroyComponents;
  FAcqData := AAcqData;
  for i := 0 to FAcqData.DataCount - 1 do begin
    l := TOvrLine.Create(Self);
    l.ULADRc := FAcqData.ULAD[i];
  end;
end;

function TOvrFile.GetActive: boolean;
begin
   with OvrMan.Owner as TSpectrumForm do begin
     Result :=  FAcqData = ActiveAcqData;
   end;
end;

function TOvrFile.Index: integer;
begin
  with OvrMan.Owner as TSpectrumForm do begin
    Result := DataList.IndexOf(FAcqData);
  end;
end;

procedure TOvrFile.CloseFile(Sender: TObject);
begin
  with OvrMan.Owner as TSpectrumForm do begin
    DataListDataClose(Index);
  end;
end;

procedure TOvrFile.Activate(Sender: TObject);
begin
   with OvrMan.Owner as TSpectrumForm do begin
     ActiveAcqData := FAcqData;
   end;
   OvrMan.PostUpdate;
end;

function TOvrFile.GetLine(Index:integer): TOvrLine;
begin
  Result := TOvrLine(Components[Index]);
end;

function TOvrFile.GetLineCount: integer;
begin
  Result := ComponentCount;
end;

function TOvrFile.GetOvrMan: TOvrMan;
begin
  Result := TOvrMan(Owner);
end;
{TOvrFil.}

{TOvrMan.}
function TOvrMan.GetFile(Index: integer): TOvrFile;
begin
  Result := TOvrFile(Components[Index]);
end;

function TOvrMan.GetFileCount: integer;
begin
  Result := ComponentCount;
end;

constructor TOvrMan.Create(ASpecForm: TForm);
begin
  inherited Create(ASpecForm);
  FUpdateMessageID:= RegisterWindowMessage('CHROMuLAN_OvrManUpdate');
  Update;
end;

function TOvrMan.GetForm: TForm;
begin
  Result := TForm(Owner);
end;

procedure TOvrMan.SetResult(AResult:integer; const msg: string);
begin
  if AResult <> 0 then
    raise EOvrMan.Create(IntToStr(AResult) + ' ' + msg);
end;

procedure TOvrMan.Update;
var
  i: integer;
  f: TOvrFile;
begin
  inc(FViewUpdating);
  try
    DestroyComponents;
    if not (Owner is TSpectrumForm) then
      SetResult(ovrInvalidOwner, '');
    with Owner as TSpectrumForm do begin
      if DataList <> nil then begin
        for i := 0 to DataList.Count - 1 do begin
          f := TOvrFile.Create(Self);
          f.AcqData := TAcqData(DataList.Items[i]);
        end;
      end;
      {specform}
    end;
    if FPanel <> nil then begin
      UpdatePanel(nil);
    end;
  finally
    dec(FViewUpdating);
  end;
end;

function TOvrMan.GetViewUpdating: boolean;
begin
  Result := FViewUpdating > 0;
end;

procedure TOvrMan.ShowPanel(Sender: TObject);
begin
  inc(FViewUpdating);
  try
    if FPanel <> nil then begin
      FPanel.Visible := true;
      exit;
    end;
    FPanel := TPanel.Create(Owner);
    {subclasser}
    FPanelHandler := TControlHandler.Create(FPanel);
    UpdatePanel(Sender);
  finally
    dec(FViewUpdating);
  end;
end;

procedure TOvrMan.UpdatePanel(Sender: TObject);
var
  f, d: integer;
  vb: TViewBuilder;
  ol: TOvrLine;
  ofi: TOvrFile;

  fn: string;

begin
  FPanel.DestroyComponents;
  FPanelHandler := TControlHandler.Create(FPanel);
  FPanel.Font.Name := 'Arial';
  FPanel.Font.Size := DefFontSize;

  vb := TViewBuilder.Create(FPanel);
  try
    vb.ActiveLevel := 1;
    vb.RowAdd;
    with vb.ChildAdd(TLabel, 'Overlay manager') do begin
      Height := DefBoxSize;
    end;
    {with TButton(vb.ChildAdd(TButton, 'Hide')) do begin
      OnClick := HidePanel;
    end;}
    for f := 0 to FileCount - 1 do begin
      vb.BevelAdd;
      ofi := Files[f];
      vb.ActiveLevel := 2;
      vb.RowAdd;
      fn := MinimizeName(ofi.AcqData.ULF.FileName, Form.Canvas, MaxFileNameLen);
      with vb.ChildAdd(TLabel, fn) do begin
        Height := DefBoxSize;
      end;

      if FileCount > 1 then begin
        with TButton(vb.ChildAdd(TButton, 'Close')) do begin
          Height := DefBoxSize;
          OnClick := ofi.CloseFile;
        end;

        if ofi.Active then begin
          with vb.ChildAdd(TLabel, 'Active') do begin
            Height := DefBoxSize;
          end;
        end else begin
          with TButton(vb.ChildAdd(TButton, 'Activate')) do begin
            Height := DefBoxSize;
            OnClick := ofi.Activate;
          end;
        end;
      end;
         {lbl.Width := form.Canvas}

      vb.ActiveLevel := 3;
      for d := 0 to ofi.LineCount - 1 do begin
         ol := ofi.Lines[d];
         vb.RowAdd;
         with vb.ChildAdd(TLabel, ol.ULADRc.ULAD.DataName) do begin
           Height := DefBoxSize;
         end;
         if ol.Active then begin
            with vb.ChildAdd(TLabel, 'Active') do begin
              Height := DefBoxSize;
            end;
         end else begin
           with TButton(vb.ChildAdd(TButton,'Activate')) do begin
             {Font}
             Height := DefBoxSize;
             OnClick := ol.Activate;
           end;
         end;
         with TCheckBox(vb.ChildAdd(TCheckBox, 'Visible')) do begin
           Height := DefBoxSize;
           OnClick := ol.VisibleClick;
           Checked := ol.Visible;
         end;
         with TShape(vb.ChildAdd(TShape, '')) do begin
           Height := DefBoxSize;
           Width := DefBoxSize;
           Brush.Color := ol.Color;
           OnMouseUp := ol.ColorMouseUp;
           {
           Font.Color := ol.Color;
           Caption := '';
           Caption := 'Color';}
           {OnClick := ol.ColorClick;}
           {Refresh;}
         end;
      end;
    end;
    vb.Stop;
  finally
    vb.Free;
  end;
end;

procedure TOvrMan.HidePanel(Sender: TObject);
{var p: TPanel;}
begin
  if FPanel <> nil then begin
    FPanel.Visible := false;
  end;
end;

procedure TOvrMan.PostUpdate;
begin
  with TSpectrumForm(Owner) do begin
    PostMessage(Handle, UpdateMessageID, 0, 0);
  end;
end;
{/TOvrMan.}
end.
