poscontrol.~pas

小票样式打印模板设计,和管家婆的pos收银系统小票样式设计差不多

unit PosControl;

interface

uses
  SysUtils,windows,Graphics,Dialogs,Classes,Controls,stdCtrls,DB,GridsEh,DBGrideh,ytxStringGridEh,strUtils,
  Printers,PosPrintFunction,ExtCtrls;

const
  FileVersion=$AB71;
type
  TDriveMode=(DMNone,DMWindows);
  TDataType=(DtNone,DtTitleFields,DtBodyFields,DtSysFields);
  TBodyType=(btGrid,btDataSet);

  TReportVar=Class;
  TReportVars=Class;
  {表报主体}
  TPosReport = class(TComponent)
  private
    { Private declarations }
        {Private}
    FDriveMode:TDriveMode;        //驱动模式
    FComName:String;              //端口名称
    FComByte:Integer;             //波特率
    FOpenBoxCode:String;          //开钱箱指令
    FAutoOpenBox:Boolean;         //打印后自动开钱箱
    FFootSpaceRow:integer;        //走纸行数
    FPageWidth:Integer;           //页宽
    FPageHeight:integer;          //页高
    FTitleRowCount:integer;       //页头行数,用于换页加表头
    FQuantityDiciaLength: integer;  //数量小数点长度
    FMoneyDiciaLength:integer;    //金额小数点长度

    FSysVars:TReportVars;         //系统变量
    FTitleVars:TReportVars;       //表头字段

    FPageNo:integer;                //页码
    FPageCount:integer;             //页数
    FDetailRowCount:integer;        //行数
    FFont:TFont;
    FFontSize:integer;
    FBodyStartRow:integer;          //表体开始行数
    FBodyEndRow:integer;            //表体结束行数
    FStepRow:integer;               //表体占用行数

    FBodyType:TBodyType;           //表体类型

    FGrid:TYTXStringGridEh;
    FDataSet:TDataSet;
    FOpenFlag:Boolean;   //模板打开标示
    FFilePathName:String; //械板文件位置

    FReportLines:TStringList;

    procedure CreateSysValues;
    procedure InitSysValues;
    Procedure SetTitleVars(TitleVars:TReportVars);
    Function GetTitleVars:TReportVars;
    Function GetVarValue(VarType:char;VarName:String):String;
    function FilterVar(S: String;out OutS: String): Boolean;
    function FilterFields(S: String;Row:integer; out OutS: String): Boolean;
    Procedure SetFont(Value:TFont);
    Function GetFont:TFont;
    function GetPrintData: TStringList;

  protected
    { Protected declarations }
  public
    { Public declarations }
     Constructor Create(AOwner:TComponent);Override;
     Destructor Destroy;override;
     Procedure ShowVarList(VarType:TDataType;Out ListFields:TListBox);
     Procedure SetBodyFields(AValue:TYTXStringGridEh);overload;
     Procedure SetBodyFields(AValue:TDataSet);Overload;
     Procedure SaveToFile(FileName:String);
     Procedure LoadFromFile(FileName:String);
     function PrintReport(OutMemo:TMemo):Boolean;overload;
     function PrintReport(OutMemo:TImage):boolean;overload;
     Function UpcaseCurrency(Value:extended):string;
     Function PrintNoDrive(Source:TStringList):Boolean;   //硬字库打印
     Function PrintWithDrive(Source:TStringList):boolean;overload; //windows驱动打印
     Function PrintWithDrive(Source:TStringList;AImage:TImage):Boolean;overload;
     procedure InitReportFile;
     Function Print:boolean;
     procedure ShowDesign;
     procedure PrintPreview;
    { Procedure ShowDesign;
     Procedure Print;
     Procedure PrintPreview; }
  published
    { Published declarations }
    Property ReportVars:TReportVars Read GetTitleVars Write SetTitleVars;
    Property AutoOpenBox:boolean Read FAutoOpenBox Write FAutoOpenBox;
    Property OpenBoxCode:String Read FOpenBoxCode Write FOpenBoxCode;
    Property DriveMode:TDriveMode Read FDriveMode Write FDriveMode;
    Property ComName:String Read FComName Write FComName;
    Property ComByte:Integer Read FComByte Write FComByte;
    Property FootSpaceRow:Integer Read FFootSpaceRow Write FFootSpaceRow;
    Property PageWidth:integer Read FPageWidth Write FPageWidth;
    Property PageHeight:integer Read FPageHeight Write FPageHeight;
    Property TitleRowCount:Integer Read FTitleRowCount Write FTitleRowCount;
    Property QuantityDicial:integer Read FQuantityDiciaLength Write FQuantityDiciaLength;
    Property MoneyDicial:integer Read FMoneyDiciaLength Write FMoneyDiciaLength;
    Property ReportLines:TStringList Read FReportLines Write FReportLines;
    Property BodyType:TBodyType Read FBodyType Write FBodyType;
    Property Grid:TytxStringGridEh Read FGrid;
    Property DataSet:TDataSet Read FDataSet;
    Property Font:TFont Read GetFont Write SetFont;

  end;

    {报表变量}
  TReportVar=Class(TCollectionItem)
  Private
    {Private}
    FVarName:String;
    FVarCaption:String;
    FVarValue:Variant;
    Procedure SetVarName(Value:String);
    Function GetVarName:String;
    Procedure SetVarCaption(Value:String);
    Function GetVarCaption:String;
    Procedure SetVarValue(Value:Variant);
    Function GetVarValue:Variant;
  Protected
    {Protected}
    procedure Assign(Source:TPersistent);override;
    function GetDisplayName: string; override;
    Function Index:integer;
  Public
    {Public}
    Constructor Create(ReportVars:TCollection);
  Published
    {Published}
    Property Name:String Read GetVarName Write SetVarName;
    Property Caption:String Read GetVarCaption Write SetVarCaption;
    Property Value:Variant Read GetVarValue Write SetVarValue;
  end;
    TReportVarClass=class of TReportVar;

  {报表变量集合}
  TReportVars=Class(TCollection)
  Private
    {Private}
    FPosReport:TPosReport;
    Function GetCount:integer;
    Function GetReportVar(Index:integer):TReportVar;
    Procedure SetReportVar(Index:integer;Value:TReportVar);
  protected
    {Protected}
    function GetOwner: TPersistent; override;
  Public
    {Public}
    Constructor Create(Report:TPosReport;ReportVarClass:TReportVarClass);
    Function Add:TReportVar;
    Procedure AddVar(ACaption,AName:String;Value:Variant);
    Procedure Clear;
    Function GetValueByName(VarName:String):Variant;
    Function GetValueByCaption(VarCaption:String):Variant;
    Function GetNameByCaption(Caption:String):String;
    Procedure SetValueByName(varName:String;Value:Variant);
    Procedure SetValueByCaption(varCaption:String;Value:Variant);
    Property Items[Index:integer]:TReportVar Read GetReportVar Write SetReportVar;default;
    Property PosReport:TPosReport Read FPosReport;
  Published
    {Published}
    Property ItemCount:integer Read GetCount;
  end;

procedure Register;
Function CurrencyToStr(Value:Extended):string;
function GetMoneySwitch(AMoney: string): string;

function com_init(com:Integer; baud:Dword):Boolean;stdcall;external 'api_com.dll';
function com_rest:Boolean;stdcall;external 'api_com.dll';
function com_send(buf:PChar; len:Integer):Boolean;stdcall;external 'api_com.dll';
function StringAlign(mStr: string; mLength:Integer;
      mAlignment: TAlignment; mBackChar: Char= #32):string;
implementation
uses frmPreviewDlg,FrmPrintManUnit;

procedure Register;
begin
  RegisterComponents('ytx工具',[TPosReport]);
end;

const
  NumberArray: array[0..9] of string =
    ('零', '壹','貳','叁','肆','伍','陆','柒','捌','玖');
  XSArray:array[0..2] of string =
    ('角','分','厘');
Function CurrencyToStr(Value:Extended):string;
var
  sMoney:string;
  sMoneyLen:integer;
  DiciaLen:integer;
  I,J:integer;
begin
  J:=0;
  sMoney:=GetMoneySwitch(FloatToStr(Value));
  sMoneyLen:=length(sMoney);
  DiciaLen:=0;
  Result:='';
  For I:=1 to sMoneyLen do
  begin
    if midStr(sMoney,I,1)<>'.' then
    begin
      Result:=Result + MidStr(sMoney,I,1);
      DiciaLen:=I;
    end else
    begin
      DiciaLen:=I;
      Break;
    end;
  end;
  if DiciaLen=sMoneyLen then
    Result:=Result+'元整'
  else
    Result:=Result + '元';
  
  For I:=DiciaLen+1 to sMoneyLen do
  begin
     if J<2 then
     begin
        Result:=Result + midStr(sMoney,I,1) + XSArray[J];
        Inc(J);
     end else
     begin
        Result:=Result + midStr(sMoney,I,1);
        Inc(J);
     end;
  end;
end;

// 数字转成大写
function GetMoneySwitch(AMoney: string): string;

  // 去除所有分隔符
  procedure ClearComma(var AValue: string);
  begin
    while Pos(',', AValue) > 0 do
      Delete(AValue, Pos(',', AValue), 1);
  end;

  // 测试如果为零将不返回值
  function FiltrateValue(const AValue, AStr: string): string;
  var
    IntValue: Integer;
  begin
    IntValue:= StrToIntDef(AValue, 0);
    if IntValue > 0 then Result:= AStr; 
  end;

  // 直接将数字翻译成大写
  function Direct(const AValue: string): string;
  var
    ResultStr: string;
    iCount: Integer;
  begin
    for iCount:= 1 to Length(AValue) do
      ResultStr:= ResultStr + NumberArray[StrToInt(AValue[iCount])];
    Result:= ResultStr;
  end;

  // 将四位长度的数字翻译与大写
  function FourBit(const AValue: string): string;
  var
    i, x, j: Integer;
    IntValue: Integer;
    ResultStr: string;
  begin

    IntValue:= StrToIntDef(AValue, 0);
    x:= IntValue;

    i := x div 1000;
    j := x mod 1000;
    if i <> 0 then ResultStr:= NumberArray[i] + '仟'
    else begin
      if Length(AValue) > 3 then ResultStr:= '零';
    end;

    i := j div 100;
    j := j mod 100;
    if i <> 0 then  ResultStr:= ResultStr + NumberArray[i] + '佰'
    else begin
      if (ResultStr <> '') and (Length(AValue) > 2) and
        (Copy(ResultStr, Length(ResultStr)-1, 2) <> '零') then
        ResultStr:= ResultStr + '零';
    end;

    i := j div 10;
    j := j mod 10;
    if i <> 0 then ResultStr := ResultStr + NumberArray[i] + '拾'
    else begin
      if (ResultStr <> '') and (Length(AValue) > 1) and
        (Copy(ResultStr, Length(ResultStr)-1, 2) <> '零') then
        ResultStr:= ResultStr + '零';
    end;

    ResultStr := ResultStr + NumberArray[j];

    while Copy(ResultStr, Length(ResultStr)-1, 2) = '零' do
      Delete(ResultStr, Length(ResultStr)-1, 2);

    Result := ResultStr;
  end; 

var
  IntegerValue: string;   // 整数部分的值
  KilomegaValue: string;  // 存储大于千兆的数字
  AccountValue: string;   // 在千兆以内的整数部分
  DecimalValue: string;   // 存在小数点后的值

  ResultKilomega: string; // 大于千兆并翻译后的大写字符
  ResultAccount: string;  // 在千兆以内的整数部分并翻译后的大写字符
  ResultDecimal: string;  // 小数点后的值并翻译后的大写字符

  FourBitStr: string;     // 最大四位值的字符
begin

  // 清除分隔符
  ClearComma(AMoney);

  // 验证字符串是否合法
  try
    AMoney:= FloatToStr(StrToFloat(AMoney));
  except
    raise Exception.Create('无效的数值字符串');
  end;

  // 取到小数据点后的值
  // 取出整数部分的值
  if Pos('.', AMoney) > 0 then
  begin
    DecimalValue:= Copy(AMoney, Pos('.', AMoney) + 1, Length(AMoney));
    IntegerValue:= Copy(AMoney, 0, Pos('.', AMoney)-1);
    ResultDecimal:= '.' + Direct(DecimalValue);
  end
  else IntegerValue:= AMoney;

  // 取到大于千兆的数字
  // 取到在千兆以内的整数部分
  if Length(IntegerValue) > 16 then
  begin
    KilomegaValue:= Copy(IntegerValue, 0, Length(IntegerValue) - 12);
    AccountValue:= Copy(IntegerValue,
      Length(IntegerValue) - 11, Length(IntegerValue));
    ResultKilomega:= Direct(KilomegaValue) + '兆';
  end
  else AccountValue:= IntegerValue;

  { 翻译在千兆以内的整数部分 }

  // 翻译在兆与仟兆之间的部份
  if Length(AccountValue) > 12 then
  begin
    FourBitStr:= Copy(AccountValue, 0, Length(AccountValue) - 12);
    ResultAccount:= ResultAccount +
      FourBit(FourBitStr) + FiltrateValue(FourBitStr, '兆');
    Delete(AccountValue, 1, Length(AccountValue) - 12);
  end;
  // 翻译在亿与仟亿之间的部份
  if Length(AccountValue) >= 8 then
  begin
    FourBitStr:= Copy(AccountValue, 0, Length(AccountValue) - 8);
    ResultAccount:= ResultAccount +
      FourBit(FourBitStr) + FiltrateValue(FourBitStr, '亿');
    Delete(AccountValue, 1, Length(AccountValue) - 8);
  end;
  // 翻译在万与仟万之间的部份
  if Length(AccountValue) >= 5 then
  begin
    FourBitStr:= Copy(AccountValue, 0, Length(AccountValue) - 4);
    ResultAccount:= ResultAccount +
      FourBit(FourBitStr) + FiltrateValue(FourBitStr, '万');
    Delete(AccountValue, 1, Length(AccountValue) - 4);
  end;
  // 翻译万以下的部份
  if Length(AccountValue) > 0 then
  begin
    ResultAccount:= ResultAccount +
      FourBit(Copy(AccountValue, 0, Length(AccountValue)));
  end;

  // 组合字符串
  Result:= ResultKilomega + ResultAccount + ResultDecimal;
  
end;


{ TPosReport }

constructor TPosReport.Create(AOwner: TComponent);
begin
  inherited;
  FAutoOpenBox:=false;
  FBodyEndRow:=0;
  FBodyStartRow:=0;
  FBodyType:=BtGrid;
  FComByte:=9600;
  FDataSet:=nil;
  FDetailRowCount:=0;
  FDriveMode:=dmNone;
  FFilePathName:='';
  FFootSpaceRow:=3;
  FGrid:=nil;
  FMoneyDiciaLength:=2;
  FOpenBoxCode:='Chr(27)+''p''+Chr(0)+Chr(60)+Chr(255)';
  FOpenFlag:=False;
  FPageCount:=0;
  FPageWidth:=53;
  FPageHeight:=20;
  FQuantityDiciaLength:=0;
  FStepRow:=0;
  FTitleRowCount:=0;
  FFont:=TFont.Create;
  FFontSize:=9;  
  FTitleVars:=TReportVars.Create(self,TReportVar);
  FSysVars:=TReportVars.Create(self,TReportVar);
  FReportLines:=TStringList.Create;
  CreateSysValues;   //添加系统变
  InitSysValues;
end;

procedure TPosReport.CreateSysValues;
begin
  FSysVars.AddVar('长日期','[@.长日期]','');
  FSysVars.AddVar('日期','[@.日期]','');
  FSysVars.AddVar('时间','[@.时间]','');
  FSysVars.AddVar('页码','[@.页码]','');
  FSysVars.AddVar('页数','[@.页数]','');