poscontrol.~pas

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

  PosX:integer;
  I:integer;
begin
  if Printer.Printers.Count<=0 then
  begin
    MessageDlg('系统没有安装打印机,不能打印!', mtInformation,[mbOk],0);
    exit;
  end else
  begin
    try
      Printer.PrinterIndex:=Printer.PrinterIndex;
    except
      MessageDlg('系统没有安装打印机或默认打印不可用!', mtInformation,[mbOk],0);
      exit;
    end;
  end;
  Printer.Title:='众智金软';
  
  try
    Printer.Canvas.Font.Size:=FFont.Size;
  except
    Printer.Canvas.Font.Size:=10;
  end;
  txtHeight:=Printer.Canvas.TextHeight('众');
  txtWidth:=Printer.Canvas.TextWidth('众');
  RowHeight:=txtHeight+ 2;  //行高
  try
    Printer.BeginDoc;
    with Printer.Canvas do
    begin
      For I:=0 to Source.Count-1 do
      begin
        PosY:=(I+1) * RowHeight;
        TextOut(txtWidth,(PosY-((RowHeight-txtWidth) div 2)-txtWidth),Source.Strings[I]);
      end;
      Printer.canvas.Font.Size:=6;
      textOut(txtWidth,PosY+textHeight('众')+3,'众知金软13668510783');
      Result:=true;
    end;
    Printer.EndDoc;
   except
    Printer.Abort;
    Result:=False;
   end;
end;

function TPosReport.PrintWithDrive(Source: TStringList;
  AImage: TImage): Boolean;
var
  txtWidth:integer;
  txtHeight:integer;
  Row:integer;
  RowHeight:Integer;
  PosY:integer;
  PosX:integer;
  I:integer;
  OldPageHeight:integer;
  tmpPage:TBitMap;
begin
  if Printer.Printers.Count<=0 then
  begin
    MessageDlg('系统没有安装打印机,不能打印!', mtInformation,[mbOk],0);
    exit;
  end else
  begin
    try
      Printer.PrinterIndex:=Printer.PrinterIndex;
    except
      MessageDlg('系统没有安装打印机或默认打印不可用!', mtInformation,[mbOk],0);
      exit;
    end;
  end;
  tmpPage:=TBitMap.Create;
  try
    tmpPage.Canvas.Font.Size:=FFont.Size;
  except
    tmpPage.Canvas.Font.Size:=10;
  end;
  txtHeight:=tmpPage.Canvas.TextHeight('众');
  txtWidth:=tmpPage.Canvas.TextWidth('众');
  RowHeight:=txtHeight + 2;  //行高
  FPageHeight:=RowHeight * Source.Count + 10;

  tmpPage.Width:=MMToPixel(FPageWidth);
  tmpPage.Height:=FPageHeight;

  OldPageHeight:=FPageHeight;
  Printer.Title:='众智金软';
  Printer.Orientation:=poPortrait;
  tmpPage.Canvas.Refresh;
  try
    with tmpPage.Canvas do
    begin
      For I:=0 to Source.Count-1 do
      begin
        PosY:=(I+1) * RowHeight;
        TextOut(txtWidth,(PosY-((RowHeight-txtWidth) div 2)-txtWidth),Source.Strings[I]);
      end;
      Printer.canvas.Font.Size:=6;
      textOut(txtWidth,PosY+textHeight('众')+3,'众知金软13668510783');
    end;
    FPageHeight:=PosY+10;
    Result:=true;
    AImage.AutoSize:=true;
    AImage.Stretch:=true;
    Aimage.Picture.Bitmap.Assign(tmpPage); 
   except
    Result:=false;
   end;
   tmpPage.Free;
end;

function TPosReport.PrintReport(OutMemo: TImage): boolean;
begin
  PrintWithDrive(GetPrintData,OutMemo);
end;

function TPosReport.Print: boolean;
begin
  try
    if FDriveMode=dmNone then
      Result:=PrintNoDrive(GetPrintData)
    else
      Result:=PrintWithDrive(GetPrintData);
  except
    on E:Exception do
    begin
      showmessage(e.Message);
      Result:=false;
    end;
  end;
end;


procedure TPosReport.PrintPreview;
begin
  FrmPreview:=TFrmPreview.Create(self.Owner);
  FrmPreview.PageControl:=self;
  if FDriveMode=dmNone then
  begin
    FrmPreview.imgPage.Visible:=false;
    PrintReport(FrmPreview.mePage);
  end else
  begin
    FrmPreview.mePage.Visible:=false;
    PrintReport(FrmPreview.imgPage);
  end;
  FrmPreview.ShowModal;
  FrmPreview.Free;
  FrmPreview:=nil;
end;


procedure TPosReport.ShowDesign;
begin
  initReportFile; //打开模板
  FrmDesign:=TFrmDesign.Create(self.Owner);
  frmDesign.PageControl:=self;

  with FrmDesign do
  begin
    cbDataType.Items.Clear;
    cbDataType.Items.Add('表头字段');
    cbDataType.Items.Add('表体字段');
    cbDataType.Items.Add('系统变量');
    cbDataType.ItemIndex:=0;
    ShowVarList(dtTitleFields,lstFields);

    case FDriveMode of
        dmNone:cbDriveType.ItemIndex:=0;
        dmWindows:cbDriveType.ItemIndex:=1;
    end;

    etFontSize.Value:=FFont.Size;
    cbCom.Text:=FComName;
    etComByte.Text:=intToStr(FComByte);
    etOpenBoxStr.Text:=FOpenBoxCode;
    ckAutoOpenBox.Checked:=FAutoOpenBox;
    etSpaceRows.Text:=intToStr(FFootSpaceRow);
    mePage.Lines.Clear;
    if Assigned(FReportLines) then
      mePage.Lines.Assign(TStrings(ReportLines));
    etPageWidth.Value:=FPageWidth;
    etTitleRows.Value:=FTitleRowCount;
    etQuantityDiciaLength.Value:=FQuantityDiciaLength;
    etMoneyDiciaLength.Value:=FMoneyDiciaLength;
   // MePage.Width:=MMToPixel(FPageWidth);
  end;

  FrmDesign.ShowModal;
  FrmDesign.Free;
  FrmDesign:=nil;
end;

procedure TPosReport.InitReportFile;
var
  FileName:String;
  FFont:TFont;
  VarType:TDataType;
begin
  FileName:=ExtractFilePath(ParamStr(0));
  if FileName[Length(FileName)]<>'\' then
    FileName:=FileName+'\';
  FileName:=FileName+'PosReport.PRT';
  LoadFromFile(FileName); //打开文件
end;

{ TReportVar }

procedure TReportVar.Assign(Source: TPersistent);
begin
  if Source is TReportVar then
  begin
     Caption:=TReportVar(Source).Caption;
     Name:=TReportVar(Source).Name;
     Value:=TReportVar(Source).Value;
  end else
    inherited Assign(Source);
end;

constructor TReportVar.Create(ReportVars: TCollection);
var
  Report:TPosReport;
begin
  Report:=nil;
  if Assigned(ReportVars) and (ReportVars is TReportVars) then
    Report:=TReportVars(ReportVars).PosReport;
  try
    inherited Create(ReportVars);
    FVarCaption:='变量1';
    FVarName:='Var1';
    FVarValue:='';
  finally
    if Assigned(Report) then
      //
  end;
end;

function TReportVar.GetDisplayName: string;
begin
  Result:=FVarName;
  if FVarName='' then
    Result:=inherited GetDisplayName;
end;

function TReportVar.GetVarCaption: String;
begin
  Result:=FVarCaption;
end;

function TReportVar.GetVarName: String;
begin
  Result:=FVarName;
end;

function TReportVar.GetVarValue: Variant;
begin
  Result:=FVarValue;
end;

function TReportVar.Index: integer;
begin
  Result:=inherited Index;
end;

procedure TReportVar.SetVarCaption(Value: String);
begin
  if FVarCaption<>Value then
    FVarCaption:=Value;
end;

procedure TReportVar.SetVarName(Value: String);
begin
  if FVarName<>Value then
    FVarName:=Value;
end;

procedure TReportVar.SetVarValue(Value: Variant);
begin
  if FVarValue<>Value then
    FVarValue:=Value;
end;

{ TReportVars }

function TReportVars.Add: TReportVar;
begin
  Result:=TReportVar(Inherited Add);
end;

procedure TReportVars.AddVar(ACaption, AName: String; Value: Variant);
var
  tmpVar:TReportVar;
begin
  tmpVar:=Add.Create(Self);
  if Assigned(tmpVar) then
  begin
    tmpVar.Caption:=ACaption;
    tmpVar.Name:=AName;
    tmpVar.Value:=Value;
  end;
end;

procedure TReportVars.Clear;
var
  I:integer;
begin
  For I:=ItemCount-1 downto 0 do
    Delete(I);
end;

constructor TReportVars.Create(Report:TPosReport;ReportVarClass: TReportVarClass);
begin
  inherited Create(ReportVarClass);
  FPosReport:=Report;
end;

function TReportVars.GetCount: integer;
begin
  Result:=inherited Count;
end;

function TReportVars.GetNameByCaption(Caption: String): String;
var
  I:integer;
begin
  for I:=0 to ItemCount-1 do
  begin
    if striComp(Pchar(Items[I].Caption),PChar(Caption))=0 then
    begin
      Result:=Items[I].Name;
      Break;
    end;
  end;
end;

function TReportVars.GetOwner: TPersistent;
begin
  Result:=FPosReport;
end;

function TReportVars.GetReportVar(Index: integer): TReportVar;
begin
  Result:=TReportVar(Inherited Items[Index]);
end;

function TReportVars.GetValueByCaption(VarCaption: String): Variant;
var
  I:integer;
begin
  for I:=0 to ItemCount-1 do
  begin
    if Items[I].FVarCaption=VarCaption then
    begin
      Result:=Items[I].Value;
      Break;
    end;
  end;
end;

function TReportVars.GetValueByName(VarName: String): Variant;
var
  I:integer;
begin
  for I:=0 to ItemCount-1 do
  begin
    if Items[I].FVarName=VarName then
    begin
      Result:=Items[I].Value;
      Break;
    end;
  end;
end;

procedure TReportVars.SetReportVar(Index: integer; Value: TReportVar);
begin
  Items[Index].Assign(Value); 
end;

procedure TReportVars.SetValueByCaption(varCaption: String;
  Value: Variant);
var
  I:integer;
begin
  for I:=0 to itemCount-1 do
  begin
    if Items[I].FVarCaption=VarCaption then
    begin
      if Items[I].value<>Value then
        Items[I].Value:=Value;
      Break;
    end;
  end;
end;

procedure TReportVars.SetValueByName(varName: String; Value: Variant);
var
  I:integer;
begin
  for I:=0 to ItemCount-1 do
  begin
    if Items[I].FVarName=varName then
    begin
      if Items[I].value<> Value then
        Items[I].Value:=Value;
      Break;
    end;
  end;
end;
//固定字符宽度
function StringAlign(mStr: string; mLength:Integer;
      mAlignment: TAlignment; mBackChar: Char= #32):string;
  var   
      L:   Integer;   
      T:   string;   
  begin   
      Result   :=   mStr;   
      L   :=   Length(mStr);   
      if   L   >=   mLength   then   Exit;   
      T   :=   DupeString(mBackChar,   mLength   -   L);   
      case   mAlignment   of   
          taLeftJustify:   Result   :=   Result   +   T;   
          taRightJustify:   Result   :=   T   +   Result;   
          taCenter:   begin   
              L   :=   Length(T)   div   2;   
              Result   :=   Copy(T,   1,   L)   +   Result   +   Copy(T,   L   +   1,   MaxInt);   
          end;   
      end;   
end;
end.