unit fmuModelInformation;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls,
  //
  untUtil,
  untType,
  xObj;

type
  TInformationGroup = (pgPrinter, pgText, pgGraphic);

  TInformationGroups = array [TInformationGroup] of TStrings;

  TfmModelInformation = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    btnClose: TButton;
    trvInformationGroups: TTreeView;
    memInformation: TMemo;
    procedure trvInformationGroupsChange(Sender: TObject; Node: TTreeNode);
    procedure btnCloseClick(Sender: TObject);
  private
    FInformationGroups: TInformationGroups;
    FDriver: TObjX;
    procedure UpdateInformation;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Init(ADriver: TObjX; AFont: TFont);
    property Driver: TObjX read FDriver;
  end;

procedure ExecuteInformationDialog(ADriver: TObjX; AShowMessage: Boolean;
                                        AFont: TFont);

implementation

{$R *.DFM}

procedure ExecuteInformationDialog(ADriver: TObjX; AShowMessage: Boolean;
                                        AFont: TFont);
var
  fm: TfmModelInformation;
begin
  fm := TfmModelInformation.Create(nil);
  try
    with fm do
    begin
      Init(ADriver, AFont);
      trvInformationGroups.FullExpand;
      trvInformationGroups.Selected := trvInformationGroups.Items[0];
      ShowModal;
    end;
  finally
    fm.Free;
  end;
end;

function GetNext(var AList: String): Integer;
var
  cnt: Integer;
begin
  cnt := Pos(';', AList);
  Result := StrToInt(Copy(AList, 1, cnt - 1));
  Delete(AList, 1, cnt);
end;

function GetRangeList(AList: String): String;

  procedure AddRange(AInit, AFinal: Integer);
  begin
    Result := Result + IntToStr(AInit);
    if AInit <> AFinal then Result := Result + '...' + IntToStr(AFinal);
  end;

var
  tii: Integer;
  iii: Integer;
  fii: Integer;
begin
  iii := GetNext(AList);
  fii := iii;
  Result := '';
  repeat
    tii := GetNext(AList);
    if tii > (fii + 1) then
    begin
      AddRange(iii, fii);
      Result := Result + ', ';
      iii := tii;
    end;
    fii := tii;
  until Length(AList) = 0;
  AddRange(iii, fii);
end;

function GetRotationList(AList: String): String;
begin
  Result := RotatationToStr[TRotation(GetNext(AList))];
  while Length(AList) > 0 do
    Result := Result + RotatationToStr[TRotation(GetNext(AList))] + ', ';
  Delete(Result, Length(Result) - 1, 2);
end;

constructor TfmModelInformation.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);
  for I := 0 to Ord(High(FInformationGroups)) do
    FInformationGroups[TInformationGroup(I)] := TStringList.Create;
end;

destructor TfmModelInformation.Destroy;
var
  I: Integer;
begin
  for I := 0 to Ord(High(FInformationGroups)) do
    FInformationGroups[TInformationGroup(I)].Free;
  inherited Destroy;
end;

procedure TfmModelInformation.UpdateInformation;

   function GetPortInfo(ALPT, ACOM: Boolean): String;
   begin
     Result := '';
     if ALPT then Result := Result + 'LPT';
     if ALPT and ACOM then Result := Result + ', ';
     if ACOM then Result := Result + 'COM ';
   end;

   function GetPrinterType(Receipt, Journal, Slip: Boolean): String;
   var
     ptp: Integer;
   begin
     ptp := 0;
     if Slip then ptp := 2;
     if Receipt and (ptp <> 0) then Inc(ptp);
     if Journal then Inc(ptp);
     Result := PrinterTypeToStr[TPrinterType(ptp)];
   end;

   function GetFontSizeList(AHeights, AWidths: String): String;
   begin
     Result := '';
     while Length(AHeights) > 0 do
       Result := Result + IntToStr(GetNext(AHeights)) + 'x' +
                 IntToStr(GetNext(AWidths)) + ', ';
     Delete(Result, Length(Result) - 1, 2);
   end;

var
  V: OleVariant;
  lns: TStrings;
  brl: String;
  str: String;
  cnt: Integer;
begin
  V := Driver.ControlInterface;
  trvInformationGroups.Items.Item[0].Text := ' ' +
    PrinterModelToStr[TPrinterModel(V.Model - 1)];
  //-----------------------   -------------------------
  lns := FInformationGroups[pgPrinter];
  try
    lns.BeginUpdate;
    lns.Add(GetPrinterType(V.CapStationReceipt, V.CapStationJournal,
            V.CapStationSlip) + ' ' + PrinterModelToStr[TPrinterModel(V.Model - 1)]);

    lns.Add('');
    lns.Add('');
    lns.Add('');
    lns.Add('  : ' + GetPortInfo(V.CapPortLPT, V.CapPortCOM));
    brl := V.CapBaudRateList;
    str := '';
    while Length(brl) <> 0 do
    begin
      str := str  + ', ';
      cnt := Pos(';', brl);
      str := str + BaudrateToStr[IntToEnumBaudRate(StrToInt(Copy(brl, 1, cnt - 1)))];
      Delete(Brl, 1, cnt);
    end;
    Delete(str, 1, 2);
    lns.Add('   : ' + str);
    lns.Add('');
    lns.Add('');
    lns.Add('');
    if V.CapStationReceipt then lns.Add('    ');
    if V.CapStationJournal then lns.Add('    ');
    if V.CapStationSlip then lns.Add('    ');
    lns.Add('');
    lns.Add(' ');
    lns.Add('');
    lns.Add('   ');
    if V.CapPicture then
    begin
      lns.Add('   ');
      lns.Add('    - ');
    end;
    if V.CapBeep then lns.Add('    ');
    if V.CapCutFull then lns.Add('    ');
    if V.CapCutPart then lns.Add('    ');
    if (V.CapFeed and V.CapFeedBiDirectional) then lns.Add('         ( )')
      else if (V.CapFeed or V.CapFeedBiDirectional) then lns.Add('    ( )');
    if V.CapDrawer then lns.Add('     ');

    if V.CapStationSlip then
    begin
      lns.Add('');
      lns.Add(' ');
      lns.Add('');
      if V.CapSlipClamp then lns.Add('   ');
      if V.CapSlipRelease then lns.Add('   ');
      if V.CapSlipFeedForward then lns.Add('    ');
      if V.CapSlipFeedBackward then lns.Add('    ');
    end;
  finally
    lns.EndUpdate;
  end;
  //-------------------------  ------------------------------
  lns := FInformationGroups[pgText];
  try
    lns.BeginUpdate;
    lns.Add('');
    lns.Add('');
    lns.Add('    : ' + IntToStr(V.CapCharCount));
    cnt := V.CapColorCount;
    try
      lns.Add(PrinterColorsToStr[cnt]);
    except
      lns.Add('   : ' + IntToStr(cnt));
    end;
    if V.CapTextUpSideDown then lns.Add('    ');
    //  lns.Add('   ')
    if V.CapLineSpacing then lns.Add('    (x 0.1 ): 0...250');
    str := V.CapCharRotationList;
    if (str <> '') and (str <> '0;') then lns.Add('   : ' + GetRotationList(str));
    lns.Add('  :   ,  ,   ');
    lns.Add('');
    lns.Add('');
    lns.Add('');
    lns.Add('  : ' + IntToStr(V.CapFontCount));
    lns.Add('   (x 0.1 ): ' + GetFontSizeList(V.CapFontHeightList, V.CapFontWidthList));
    lns.Add('  :');
    if V.CapFontBold then lns.Add('     ');
    if V.CapFontItalic then lns.Add('     ');
    if V.CapFontDblHeight then lns.Add('       ');
    if V.CapFontDblWidth then lns.Add('       ');
    if V.CapFontUnderLine then lns.Add('      ');
    if V.CapFontOverLine then lns.Add('     ');
    if V.CapFontNegative then lns.Add('     ');
    if V.CapZeroSlashed then lns.Add('      ');
    lns.Add('');
    lns.Add('');
    lns.Add('');
    lns.Add('   : ' + GetRangeList(V.CapCodePageList));
    lns.Add('   : ' + GetRangeList(V.CapCharSetList));
  finally
    lns.EndUpdate;
  end;
  //-------------------------  -----------------------------
  lns := FInformationGroups[pgGraphic];
  try
    lns.BeginUpdate;
    if V.CapPicture then
    begin
      lns.Add('');
      lns.Add('');
      lns.Add('    ( ): ' + IntToStr(V.CapPictureWidth));
      try
        lns.Add(PrinterColorsToStr[cnt]);
      except
        lns.Add('   : ' + IntToStr(cnt));
      end;
      lns.Add('  : 90, 180, 270');
      lns.Add('  :   ,  ,   ');
      lns.Add('');
      lns.Add('-');
      lns.Add('');
      lns.Add('   -: EAN-13, EAN-8, UPC A, Code39');
      lns.Add('  : 90, 180, 270');
      lns.Add('  :   ,  ,   ');
      lns.Add('     -');
    end;
  finally
    lns.EndUpdate;
  end;
end;

procedure TfmModelInformation.Init(ADriver: TObjX;  AFont: TFont);
begin
  FDriver := ADriver;
  Font := AFont;
  UpdateInformation;
end;

procedure TfmModelInformation.trvInformationGroupsChange(Sender: TObject; Node: TTreeNode);
var
  sli: TTreeNode;
begin
  sli := trvInformationGroups.Selected;
  if sli <> nil then
    memInformation.Lines.Assign(FInformationGroups[TInformationGroup(
                                sli.AbsoluteIndex)]);
end;

procedure TfmModelInformation.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.
