unit ULObjPrn;{v0.31}
{
  (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, Classes, Controls, Forms, Graphics, Printers,
  StdCtrls, AlRep, AlPrev, AlPrevFr, Language, UlanType, SubClasser
  {v0.36}, Math{/v0.36};
  { tcustomlabel }
type
  TULObjPrn = class(TObject)
  private
    FHeadObj: TObject;
    FDetailsObj: TObject;

    {ReportFormCreate variables}
    {FCurBandTop: integer;}
    FTotalWidth: integer;
    FTotalHeight: integer;
    {FBandHeight: integer;}
    {/ReportFormCreate variables}

    {FRepForm components}
    FRepForm: TForm;

    FSubClasser: TSubClasser;

    FReport: TAlReport;
    FPageHead: TAlBand;
      FCaptionLabel: TAlLabel;
      FVersionLabel: TAlLabel;
      FDateField: TAlSysField;
      FTimeField: TAlSysField;
      FPageField: TAlSysField;
    FHead: TAlBand;
    FImageBand: TAlBand;
      FImage: TAlImage;
    FDetailHead: TAlBand;
    FDetailBand: TAlBand;
    FDetailFoot: TAlBand;
    {/FRepForm components}

  protected
    {v0.36}{/v0.36
    procedure ReportFormCreate;}
      procedure ReportCreate;
      procedure PageHeadCreate;
      procedure HeadCreate;
      procedure ImageBandCreate;
      procedure DetailHeadCreate;
      procedure DetailCreate;
      procedure DetailFootCreate;
    procedure DataLoad;
      procedure DataHeadLoad;
      procedure DataDetailsLoad;

  public
    {v0.36}
    procedure ReportFormCreate;
    procedure ReportFormDestroy;
    {/v0.36}

    constructor Create(AHeadObj, ADetailsObj: TObject); reintroduce;
    destructor Destroy; override;
    procedure Print;

    {v0.36}
    property RepForm: TForm read FRepForm;
    {/v0.36}
  end;

implementation
uses
  ULRecTyp, ULObju, ULObjDes;

{TULObjPrn}
constructor TULObjPrn.Create(AHeadObj, ADetailsObj: TObject);
begin
  FHeadObj := AHeadObj;
  FDetailsObj := ADetailsObj;
end;

destructor TULObjPrn.Destroy;
begin
  inherited;
end;

procedure TULObjPrn.Print;
begin
  ReportFormCreate;
  {v0.36}{/v0.36
  FRepForm.ShowModal;
  if FHeadObj <> nil then
    WriteComponentResFile(TULObj(FHeadObj).ReportFileName, FRepForm); }

  DataLoad;
  with TFrmPreview.Create(Application) do
  begin
    {im := TAlImage(frm.FindComponent('ReportImage'));
    if im <> nil then begin
      mf := TDrawMetaFile.Create(im.Width, im.Height);
      CalcSpectrumDisp(mf.Canvas, im.Width, im.Height, imdisp);
      DrawSpectrum(mf.Canvas, imdisp);
      mf.Close;
      im.Picture.Assign(TMetaFile(mf));
      mf.Free;
    end;}
    FormStyle := fsNormal;

    FReport.MakePreviewPages(Previewer.Pages);
    FirstPage;
    {v0.36}
    Visible := false;

    ShowModal;
    Release;
    {/v0.36}
  end;
  FRepForm.Release;
  FRepForm := nil;
{  frm.Release;}
end;

procedure TULObjPrn.DataHeadLoad;
var
  i: integer;
  o: TULObj;
  f: TULObjField;
begin
  if FHeadObj = nil then
    exit;
  o := TULObj(FHeadObj);
  for i := 0 to o.FieldCount - 1 do begin
    f := o.Fields[i];
    if f.FldDesc.IsFlagSet(ffToPrint) then begin
      FReport.AddNamedValue(f.FldDesc.Name + '_Head', f.AsUsrString);
    end;
  end;
  FVersionLabel.Caption := 'Chromulan v' + uLanVersion;

{ rep.AddNamedValue('SampleDesc', ActiveAcqData.ULA.SampleDesc);
  dts := '';
  dt := ActiveAcqData.ULA.DateTime;
  if dt <> 0 then
    dts := DateTimeToStr(FileDateToDateTime(dt));
  rep.AddNamedValue('DateTime', dts);
  al := TAlLabel(frm.FindComponent('VersionLbl'));
  if al <> nil then
    al.Caption := }
end;

procedure TULObjPrn.DataDetailsLoad;
var
  o, c: TULObj;
  ci, fi: integer;
  f: TULObjField;
  fd: TULObjFldDesc;
begin
  if FDetailsObj = nil then
    exit;
{  if not TULObj(FDetailsObj).GetBrowseChild(o)}
  o := TULObj(FDetailsObj);
  for ci := 0 to o.ChildCount - 1 do begin
    c := TULObj(o.Childs[ci]);
    if not o.ObjDesc.IsBrowseChildRecID(c.RecID) then
      continue;
    for fi := 0 to c.FieldCount - 1 do begin
      f := c.Fields[fi];
      fd := f.FldDesc;
      if fd.IsFlagSet(ffToPrint) then begin
        FReport.AddNamedValue(fd.Name, f.AsUsrString);
      end;
    end;
  end;
{  rep.AddNamedValue('PeakCount', IntToStr(Spect.Peaks.ChildCount));
  rep.AddNamedValue('AreaSum', RealToString(areaSum, 10, 4));}
end;

procedure TULObjPrn.DataLoad;
begin
  DataHeadLoad;
  DataDetailsLoad;
  {end else begin
  MessageDlg (Format(GetTxt('could not load report %s'),[repname]),
               mtError,[mbOK],0);}
end;

  {/create methods }
procedure TULObjPrn.ReportCreate;
begin
  FReport := TAlReport.Create(FRepForm);
  with FReport do begin
    {Parent := FRepForm;}
    Name := 'Report';
    Orientation := poPortrait;
    PaperSize := alr_A4;
    LeftMarginMM := 0;
    RightMarginMM := 0;
    {Left := 96;{report.dfm}
    {Top := 24;}
  end;
end;

procedure TULObjPrn.PageHeadCreate;
begin
  FPageHead := TAlBand.Create(FRepForm);
  with FPageHead do begin
    Parent := FRepForm;
    Name := 'PageHeadBand';
    Left := 0;
    Top := 0;
    Width := FTotalWidth;{794;}
    Height := 21;
    Align := alTop;
    Color := clWhite;
    BandType := alr_PageHeader;
    Ruler := alr_cmHV;

    FVersionLabel := TAlLabel.Create(FRepForm);
    with FVersionLabel do begin
      Parent := FPageHead;{controlstyle}
      Name := 'VersionLabel';
      Left := 41;
      Top := 2;
      Width := 80;
      Height := 13;
      Caption := '';{'Chromulan v0.29'}
    end;

    FCaptionLabel := TAlLabel.Create(FRepForm);
    with FCaptionLabel do begin
      Parent := FPageHead;
      Name := 'CaptionLabel';
      Left := 147;
      Top := 1;
      Width := 68;
      Height := 13;
      Caption := 'Report';
    end;

    FTimeField := TAlSysField.Create(FRepForm);
    with FTimeField do begin
      Parent := FPageHead;
      Name := 'TimeField';
      Left := 438;
      Top := 2;
      Width := 58;
      Height := 13;
      Caption := '#hh:mm:ss#';
      Color := clWhite;
      DataType := alr_Time;
    end;

    FDateField := TAlSysField.Create(FRepForm);
    with FDateField do begin
      Parent := FPageHead;
      Name := 'DateField';
      Left := 372;
      Top := 1;
      Width := 50;
      Height := 13;
      Caption := '#tt.mm.jjjj#';
      Color := clWhite;
      DataType := alr_Date;
    end;

    FPageField := TAlSysField.Create(FRepForm);
    with FPageField do begin
      Parent := FPageHead;
      Name := 'PageField';
      Left := 272;
      Top := 0;
      Width := 39;
      Height := 13;
      Caption := '#Page#';
      Color := clWhite;
      DataType := alr_PageNum;
    end;
  end;
end;

procedure TULObjPrn.HeadCreate;
var
  i: integer;
  o: TULObj;
  f: TULObjField;
  albl: TAlLabel;
  afld: TAlField;

  hd, ll, lw, lh, fl, fw, fh, t: integer;
begin
  FHead := TAlBand.Create(FRepForm);
  with FHead do begin
    Parent := FRepForm;
    Name := 'HeadBand';
    Left := 0;
    Top := 21;
    Width := FTotalWidth;{794;}
    Height := 60;
    Align := alTop;
    Color := clWhite;
    BandType := alr_Title;
    Ruler := alr_cmHV;
    {
    object SampleName: TAlField
      Left := 72
      Top := 16
      Width := 63
      Height := 13
      Caption := 'SampleName'
    end
    object AlLabel3: TAlLabel
      Left := 8
      Top := 16
      Width := 38
      Height := 13
      Caption := 'Sample:'
    end
    object SampleDesc: TAlField
      Left := 73
      Top := 31
      Width := 60
      Height := 13
      Caption := 'SampleDesc'
    end
    object DateTimeLabel: TAlLabel
      Left := 8
      Top := 46
      Width := 48
      Height := 13
      Caption := 'Date,time:'
    end
    object DateTime: TAlField
      Left := 73
      Top := 48
      Width := 46
      Height := 13
      Caption := 'DateTime'
    end
    }
  end;

  if FHeadObj = nil then
    exit;
  o := TULObj(FHeadObj);

  t := 16;
  hd := 15;

  ll := 8;
  lw := 60;
  lh := 13;

  fl := 75;
  fw := 60;
  fh := 14;

  for i := 0 to o.FieldCount - 1 do begin
    f := o.Fields[i];
    if f.FldDesc.IsFlagSet(ffToPrint) then begin
      albl := TAlLabel.Create(FRepForm);
      with albl do begin
        Parent := FHead;
        Name := f.FldDesc.Name + 'HeadLabel';{ulobjdes}
        Left := ll;
        Top := t;
        Width := lw;
        Height := lh;
        Caption := f.FldDesc.Caption;
      end;
      afld := TAlField.Create(FRepForm);
      with afld do begin
        Parent := FHead;
        Name := f.FldDesc.Name + '_Head';
        Caption := f.FldDesc.Name + '_Head';
        Left := fl;
        Top := t;
        Width := fw;
        Height := fh;
      end;
      t := t + hd;
    end;
  end;
end;

procedure TULObjPrn.ImageBandCreate;
begin
  exit;

  FImageBand := TAlBand.Create(FRepForm);
  with FImageBand do begin
    Parent := FRepForm;
    Name := 'ImageBand';
    Left := 0;
    Top := 81;
    Width := FTotalWidth;{794;}
    Height := 376;
    Align := alTop;
    Color := clWhite;
    BandType := alr_Title;
    Ruler := alr_cmHV;
    FImage := TAlImage.Create(FRepForm);
    with FImage do begin
      Parent := FImageBand;
      Name := 'Image';
      Left := 24;
      Top := 8;
      Width := 776;
      Height := 361;
      Autosize := False;
    end;
  end;
end;

procedure TULObjPrn.DetailHeadCreate;
var
  i: integer;
  o: TULObj;
  f: TULObjField;
  albl: TAlLabel;

  cw: integer;
  l,t,w,h: integer;
begin
  FDetailHead := TAlBand.Create(FRepForm);
  with FDetailHead do begin
    Parent := FRepForm;
    Name := 'DetailHeadBand';
    Left := 0;
    Top := 457;
    Width := FTotalWidth;{794;}
    Height := 32;
    Align := alTop;
    Color := clWhite;
    BandType := alr_DetailHeader;
    Ruler := alr_cmHV;
  end;

  if FDetailsObj = nil then
    exit;
  if not TULObj(FDetailsObj).GetBrowseChild(o) then
    exit;

  l := 60;
  t := 15;
  h := 13;
  cw := 8;

  for i := 0 to o.FieldCount - 1 do begin
    f := o.Fields[i];
    if f.FldDesc.IsFlagSet(ffToPrint) then begin
      w := cw * length(f.FldDesc.Caption);
      albl := TALLabel.Create(FRepForm);
      with albl do begin
        Parent := FDetailHead;
        Name := f.FldDesc.Name + 'DetailLabel';
        Caption := f.FldDesc.Caption;
        Left := l;
        Top := t;
        Width := w;
        Height := h;
      end;
      l := l + w;
    end;
  end;
end;
{repfrm\ullrep.dfm repfrm\uldrep.dfm}
procedure TULObjPrn.DetailCreate;
var
  i: integer;
  o: TULObj;
  f: TULObjField;
  afld: TAlField;

  cw: integer;
  l,t,w,h: integer;
begin
  FDetailBand := TAlBand.Create(FRepForm);
  with FDetailBand do begin
    Parent := FRepForm;
    Name := 'DetailBand';
    Left := 0;
    Top := 489;
    Width := FTotalWidth;{794;}
    Height := 2* FRepForm.Canvas.TextHeight('jM');{17;}
    Align := alTop;
    Color := clWhite;
    BandType := alr_Detail;
    Ruler := alr_cmHV;
  end;

  if FDetailsObj = nil then
    exit;
  if not TULObj(FDetailsObj).GetBrowseChild(o) then
    exit;

  l := 60;
  t := 5;
  {v0.36}
  h := max(13, 3 * FRepForm.Canvas.TextHeight('jM') div 2);{mylib}
  {/v0.36}

  cw := 8;

  for i := 0 to o.FieldCount - 1 do begin
    f := o.Fields[i];
    if f.FldDesc.IsFlagSet(ffToPrint) then begin
      w := cw * length(f.FldDesc.Caption);
      afld := TAlField.Create(FRepForm);
      with afld do begin
        Parent := FDetailBand;
        Name := f.FldDesc.Name;
        Caption := f.FldDesc.Name;
        Left := l;
        Top := t;
        Width := w;
        Height := h;
      end;
      l := l + w;
    end;
  end;

end;

procedure TULObjPrn.DetailFootCreate;
var
  i: integer;
  o: TULObj;
  f: TULObjField;
  afld: TAlField;

  l,t,w,h, cw: integer;
begin
  FDetailFoot := TAlBand.Create(FRepForm);
  with FDetailFoot do begin
    Name := 'DetailFoot';
    Parent := FRepForm;
    Left := 0;
    Top := 506;
    Width := FTotalWidth;{794;}
    Height := 32;
    Align := alTop;
    Color := clWhite;
    BandType := alr_DetailFooter;
    Ruler := alr_cmHV;
  end;

  if FDetailsObj = nil then
    exit;
  if not TULObj(FDetailsObj).GetBrowseChild(o) then
    exit;

  l := 60;
  t := 5;
  h := 13;
  cw := 8;

  for i := 0 to o.FieldCount - 1 do begin
    f := o.Fields[i];
    if f.FldDesc.IsFlagSet(ffToPrint) then begin
      w := cw * length(f.FldDesc.Caption);
      if f.FldDesc.IsFlagSet(ffToPrintFoot) then begin
        afld := TAlField.Create(FRepForm);{ulrectyp}
        with afld do begin
          Parent := FDetailFoot;
          Name := f.FldDesc.Name + '_Foot';
          Caption := f.FldDesc.Name + '_Foot';
          Left := l;
          Top := t;
          Width := w;
          Height := h;
        end;
      end;
      l := l + w;
    end;
  end;
end;

procedure EnableControls(Owner: TWinControl; AClass: TClass; OnOff: boolean);
var i: integer;
begin
  for i := 0 to Owner.ControlCount - 1 do begin
    if Owner.Controls[i] is TWinControl then
      EnableControls(TWinControl(Owner.Controls[i]), AClass, OnOff);
    if Owner.Controls[i] is AClass then begin
      Owner.Controls[i].Enabled := OnOff;
    end;
  end;
end;

procedure TULObjPrn.ReportFormCreate;
begin
  if (FHeadObj <> nil) and (FileExists(TULObj(FHeadObj).ReportFileName)) then begin
    FRepForm := TForm.Create(Application);
    FRepForm := ReadComponentResFile(TULObj(FHeadObj).ReportFileName, FRepForm) as TForm;
    FSubClasser := TSubClasser(FRepForm.FindComponent('SubClasser'));
    FReport := TAlReport(FRepForm.FindComponent('Report'));
    FPageHead := TAlBand(FRepForm.FindComponent('PageHeadBand'));
      FCaptionLabel := TAlLabel(FRepForm.FindComponent('CaptionLabel'));
      FVersionLabel := TAlLabel(FRepForm.FindComponent('VersionLabel'));
      FDateField:= TAlSysField(FRepForm.FindComponent('DateField'));
      FTimeField:= TAlSysField(FRepForm.FindComponent('TimeField'));
      FPageField:= TAlSysField(FRepForm.FindComponent('PageField'));
    FHead:= TAlBand(FRepForm.FindComponent('HeadBand'));
    FImageBand:= TAlBand(FRepForm.FindComponent('ImageBand'));
      FImage:= TAlImage(FRepForm.FindComponent('Image'));
    FDetailHead:= TAlBand(FRepForm.FindComponent('DetailHeadBand'));
    FDetailBand:= TAlBand(FRepForm.FindComponent('DetailBand'));
    FDetailFoot:= TAlBand(FRepForm.FindComponent('DetailFootBand'));

  end else begin
    FRepForm := TForm.Create(Application);
    {FaForm   := ReadComponentResFile (aFileName,aForm) as tForm;}
    { FindReport (aForm);}
    FTotalWidth := 794;
    FTotalHeight := 1123;
    with FRepForm do begin
      Left := 193;
      Top := 120;
      Width := 608;
      Height := 375;
      HorzScrollBar.Range := FTotalWidth;{794;}
      VertScrollBar.Range := FTotalHeight;{1123;}
      AutoScroll := False;
      Caption := 'Report';
      Color := clBtnFace;
      {Font.Charset := DEFAULT_CHARSET;
      Font.Color := clWindowText;
      Font.Height := -11;
      Font.Name := 'MS Sans Serif';
      Font.Style := [];}
      OldCreateOrder := False;
      PixelsPerInch := 96;
      {TextHeight := 13;}
    end;
    ReportCreate;
    PageHeadCreate;
    HeadCreate;
    ImageBandCreate;
    DetailHeadCreate;
    DetailCreate;
    DetailFootCreate;
    {EnableControls(FRepForm, TAlLabel, true);}

    FSubClasser := TSubClasser.Create(FRepForm);
    FSubClasser.Name := 'SubClasser';
    FSubClasser.SubClass;
    FSubClasser.SubClassMode := smOn;
    {FSubClasser.EnableClass(TAlBand, false);}{subclasser}
    FSubClasser.NoShiftKeys := true;
  end;
  if LanguageIsOn then
    FLanguage.CheckForm(FRepForm);
end;
  {/create methods }

procedure TULObjPrn.ReportFormDestroy;
begin
  if FRepForm = nil then
    exit;
  if FHeadObj <> nil then
    WriteComponentResFile(TULObj(FHeadObj).ReportFileName, FRepForm);
  FRepForm.Release;
  FRepForm := nil;
end;

end.
