frxdmpexport.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

begin
  if (x < 0) or (y < 0) or (x >= FBufWidth) or (y >= FBufHeight) then Exit;
  FFrameBuf[FBufWidth * y+x]:= FFrameBuf[FBufWidth * y+x] or typ;
end;

procedure TfrxDotMatrixExport.SetString(x, y:Integer; const s:String);
var
  i, j:Integer;
  c:Char;
begin
  if (x < 0) or (y < 0) or (y >= FBufHeight) then Exit;
  for i:= 1 to Length(s) do
  begin
    if x+i-1 >= FBufWidth then break;
    c:= s[i];
    j:= FBufWidth * y+x+i-1;
    FCharBuf[j]:= c;
  end;
end;

procedure TfrxDotMatrixExport.SetStyle(x, y, Style:Integer);
begin
  if (x < 0) or (y < 0) or (x >= FBufWidth) or (y >= FBufHeight) then Exit;
  FStyleBuf[FBufWidth * y+x]:= Style;
end;

procedure TfrxDotMatrixExport.WriteStr(const str:String);
begin
  if Length(str) > 0 then
    FStream.Write(str[1], Length(str))
end;

procedure TfrxDotMatrixExport.WriteStrLn(const str:String);
begin
  WriteStr(str);
  WriteStr(#13#10);
end;

procedure TfrxDotMatrixExport.DrawFrame(x, y, dx, dy:Integer; Style:Integer);
var
  i, j:Integer;
begin
  if dx = 1 then
  begin
    SetFrame(x, y, 4);
    for i:= y+1 to y+dy-2 do
      SetFrame(x, i, 5);
    SetFrame(x, y+dy-1, 1);
  end
  else
  begin
    SetFrame(x, y, 2);
    for i:= x+1 to x+dx-2 do
      SetFrame(i, y, 10);
    SetFrame(x+dx-1, y, 8);
  end;

  for i:= x to x+dx-1 do
    for j:= y to y+dy-1 do
      SetStyle(i, j, Style);

  if y+dy > FMaxHeight then
    FMaxHeight:= y+dy;
end;

procedure TfrxDotMatrixExport.DrawMemo(x, y, dx, dy:Integer; Memo:TfrxDMPMemoView);
var
  i, sx, sy:Integer;
  Lines:TStringList;
  Text:String;
  Style:Integer;

  function StrToOem(const AnsiStr:String):String;
  begin
    SetLength(Result, Length(AnsiStr));
    if Length(Result) > 0 then
      CharToOemBuff(PChar(AnsiStr), PChar(Result), Length(Result));
  end;

  function MakeStr(C:Char; N:Integer):String;
  begin
    if N < 1 then
      Result:= ''
    else
    begin
      SetLength(Result, N);
      FillChar(Result[1], Length(Result), C);
    end;
  end;

  function AddChar(C:Char; const S:String; N:Integer):String;
  begin
    if Length(S) < N then
      Result:= MakeStr(C, N-Length(S))+S else
      Result:= S;
  end;

  function AddCharR(C:Char; const S:String; N:Integer):String;
  begin
    if Length(S) < N then
      Result:= S+MakeStr(C, N-Length(S)) else
      Result:= S;
  end;

  function LeftStr(const S:String; N:Integer):String;
  begin
    Result:= AddCharR(' ', S, N);
  end;

  function RightStr(const S:String; N:Integer):String;
  begin
    Result:= AddChar(' ', S, N);
  end;

  function CenterStr(const S:String; Len:Integer):String;
  begin
    if Length(S) < Len then
    begin
      Result:= MakeStr(' ', (Len div 2)-(Length(S) div 2))+S;
      Result:= Result+MakeStr(' ', Len-Length(Result));
    end
    else
      Result:= S;
  end;

  function AlignBuf(const buf:String):String;
  begin
    if (Memo.HAlign = haLeft) then
      Result:= LeftStr(buf, dx)
    else if (Memo.HAlign = haRight) then
      Result:= RightStr(buf, dx)
    else if (Memo.HAlign = haCenter) then
      Result:= CenterStr(buf, dx)
    else
      Result:= LeftStr(buf, dx);
  end;

begin
  Lines:= TStringList.Create;

  Text:= Memo.WrapText(True);
  if FOEMConvert then
    Text:= StrToOem(Text);
  Lines.Text:= Text;

  if dy > Lines.Count then
  begin
    if (Memo.VAlign = vaBottom) then
      sy:= y+dy-Lines.Count
    else if (Memo.VAlign = vaCenter) then
      sy:= y+(dy-Lines.Count) div 2
    else
      sy:= y
  end
  else
     sy:= y;

  for i:= 0 to Lines.Count-1 do
  begin
    if i > dy-1 then
      break;
    SetString(x, sy+i, AlignBuf(Lines[i]));
  end;
  Lines.Free;

  Style:= StyleToInt(Memo.FontStyle);
  for sx:= x to x+dx-1 do
    for sy:= y to y+dy-1 do
      SetStyle(sx, sy, Style);

  if y+dy > FMaxHeight then
    FMaxHeight:= y+dy;
end;

procedure TfrxDotMatrixExport.CreateBuf(Width, Height:Integer);
var
  i, j:Integer;
begin
  FBufWidth:= Width;
  FBufHeight:= Height;
  SetLength(FCharBuf, FBufWidth * FBufHeight);
  SetLength(FStyleBuf, FBufWidth * FBufHeight);
  SetLength(FFrameBuf, FBufWidth * FBufHeight);
  for i:= 0 to FBufHeight-1 do
    for j:= 0 to FBufWidth-1 do
    begin
      FCharBuf[i * FBufWidth+j]:= ' ';
      FStyleBuf[i * FBufWidth+j]:= FPageStyle;
      FFrameBuf[i * FBufWidth+j]:= 0;
    end;
end;

procedure TfrxDotMatrixExport.FreeBuf;
begin
  FFrameBuf:= nil;
  FStyleBuf:= nil;
  FCharBuf:= nil;
  FBufHeight:= 0;
  FBufWidth:= 0;
end;

procedure TfrxDotMatrixExport.FlushBuf;
var
  i, j, Style, CurrentStyle:Integer;
  buf:String;
  Frames:String;

  function Trim_Right(const s:String):String;
  var
    i:Integer;
  begin
    Result:= s;
    for i:= Length(Result) downto 1 do
      if Result[i]<>' ' then
        break;
    SetLength(Result, i);
  end;

begin
  if Length(CustomFrameSet) = 15 then
    Frames:= CustomFrameSet
  else if FGraphicFrames then
    Frames:= FrameSet[2]
  else
    Frames:= FrameSet[1];

  CurrentStyle:= FPageStyle;
  for i:= 0 to FMaxHeight-1 do
  begin
    buf:= StyleOn(CurrentStyle);
    for j:= 0 to FBufWidth-1 do
    begin
      Style:= FStyleBuf[i * FBufWidth+j];
      if Style<>CurrentStyle then
      begin
        buf:= buf+StyleChange(CurrentStyle, Style);
        CurrentStyle:= Style;
      end;
      if FFrameBuf[i * FBufWidth+j]<>0 then
        buf:= buf+Frames[FFrameBuf[i * FBufWidth+j]] else
        buf:= buf+FCharBuf[i * FBufWidth+j];
    end;
    buf:= Trim_Right(buf)+StyleOff(CurrentStyle);
    WriteStrLn(buf);
  end;
end;

function TfrxDotMatrixExport.ShowModal:TModalResult;
var
  Ini:TCustomIniFile;
begin
  Ini:= Report.GetIniFile;
  with TfrxDMPExportDialog.Create(nil) do
  begin
    if FUseIniSettings then
    begin
      FPageBreaks:= Ini.ReadBool('DMP', 'PageBreaks', True);
      FOEMConvert:= Ini.ReadBool('DMP', 'OEM', True);
      FGraphicFrames:= Ini.ReadBool('DMP', 'GraphFrame', False);
      FEscModel:= Ini.ReadInteger('DMP', 'PrinterType', 0);
    end;
    if FEscModel >= frxDMPrinters.Count then
      FEscModel:= 0;

    PageBreaksCB.Checked:= FPageBreaks;
    OemCB.Checked:= FOEMConvert;
    PseudoCB.Checked:= FGraphicFrames;
    SaveToFileCB.Checked:= FSaveToFile;
    EscCB.ItemIndex:= FEscModel;
    CopiesUD.Position:= Report.PrintOptions.Copies;

    Result:= ShowModal;
    if Result = mrOk then
    begin
      FSaveToFile:= SaveToFileCB.Checked;
      if FSaveToFile then
        if SaveDialog1.Execute then
          FFileName:= SaveDialog1.Filename else
          Result:= mrCancel;

      CurPage:= False;
      if PageNumbersRB.Checked then
        PageNumbers:= RangeE.Text
      else if CurPageRB.Checked then
        CurPage:= True
      else
        PageNumbers:= '';
      FCopies:= StrToInt(CopiesE.Text);
      FPageBreaks:= PageBreaksCB.Checked;
      FOEMConvert:= OemCB.Checked;
      FGraphicFrames:= PseudoCB.Checked;
      FEscModel:= EscCB.ItemIndex;

      Ini.WriteBool('DMP', 'OEM', FOEMConvert);
      Ini.WriteBool('DMP', 'GraphFrame', FGraphicFrames);
      Ini.WriteBool('DMP', 'PageBreaks', FPageBreaks);
      Ini.WriteInteger('DMP', 'PrinterType', FEscModel);
    end;
    Free;
  end;
  Ini.Free;
end;

function TfrxDotMatrixExport.Start:Boolean;
begin
  if Assigned(Stream) then
    FStream:= Stream
  else
  begin
    if not FSaveToFile then
      FFileName:= GetTempFName;

    if FFileName<>'' then
      FStream:= TFileStream.Create(FFileName, fmCreate)
    else
      FStream:= nil;
  end;

  if Assigned(FStream) then
  begin
    Reset;
    WriteStr(FPrinterInitString);
    WriteStr(Report.ReportOptions.InitString);
    Result:= True
  end
  else
    Result:= False;
end;

procedure TfrxDotMatrixExport.StartPage(Page:TfrxReportPage; Index:Integer);
begin
  FMaxHeight:= 0;
  FPageStyle:= StyleToInt(TfrxDMPPage(Page).FontStyle);
  CreateBuf(Round(Page.Width / fr1CharX)+1, Round(Page.Height / fr1CharY)+1);
  if Page.Orientation = poLandscape then
    Landscape else
    Portrait;
end;

procedure TfrxDotMatrixExport.ExportObject(Obj:TfrxComponent);
var
  Style:Integer;
  Memo:TfrxDMPMemoView;
begin
  if (Obj is TfrxView) and not TfrxView(Obj).Printable then Exit;
  if Obj is TfrxDMPMemoView then
  begin
    Memo:= TfrxDMPMemoView(Obj);
    Style:= StyleToInt(Memo.FontStyle);
    DrawMemo(Round(Memo.AbsLeft / fr1CharX), Round(Memo.AbsTop / fr1CharY),
      Round(Memo.Width / fr1CharX), Round(Memo.Height / fr1CharY), Memo);
    if (ftLeft in Memo.Frame.Typ) then
      DrawFrame(Round(Memo.AbsLeft / fr1CharX)-1,
        Round(Memo.AbsTop / fr1CharY)-1, 1, Round(Memo.Height / fr1CharY)+2, Style);
    if (ftRight in Memo.Frame.Typ) then
      DrawFrame(Round((Memo.AbsLeft+Memo.Width) / fr1CharX),
        Round(Memo.AbsTop / fr1CharY)-1, 1, Round(Memo.Height / fr1CharY)+2, Style);
    if (ftTop in Memo.Frame.Typ) then
      DrawFrame(Round(Memo.AbsLeft / fr1CharX)-1,
        Round(Memo.AbsTop / fr1CharY)-1, Round(Memo.Width / fr1CharX)+2, 1, Style);
    if (ftBottom in Memo.Frame.Typ) then
      DrawFrame(Round(Memo.AbsLeft / fr1CharX)-1,
        Round((Memo.AbsTop+Memo.Height) / fr1CharY),
        Round(Memo.Width / fr1CharX)+2, 1, Style);
  end
  else if Obj is TfrxDMPLineView then
  begin
    Style:= StyleToInt(TfrxDMPLineView(Obj).FontStyle);
    if Obj.Width = 0 then
      DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
        1, Round(Obj.Height / fr1CharY)+1, Style)
    else if Obj.Height = 0 then
      DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
        Round(Obj.Width / fr1CharX)+1, 1, Style);
  end
  else if Obj is TfrxDMPCommand then
  begin
    SetString(Round(Obj.AbsLeft / fr1CharX), Round(Obj.AbsTop / fr1CharY),
      TfrxDMPCommand(Obj).ToChr);
  end;
end;

procedure TfrxDotMatrixExport.FinishPage(Page:TfrxReportPage; Index:Integer);
begin
  FlushBuf;
  FreeBuf;
  if FPageBreaks then
    FormFeed;
end;

procedure TfrxDotMatrixExport.Finish;
var
  i:Integer;
  fname:String;
  f, ffrom:TFileStream;
begin
  if FStream<>Stream then
  begin
    FStream.Free;
    if not frxPrinters.HasPhysicalPrinters then Exit;

    if not FSaveToFile then
    begin
      fname:= GetTempFName;
      f:= TFileStream.Create(fname, fmCreate);
      ffrom:= TFileStream.Create(FileName, fmOpenRead);
      f.Write(FPrinterInitString[1], Length(FPrinterInitString));
      f.CopyFrom(ffrom, 0);
      f.Free;
      ffrom.Free;
      f:= TFileStream.Create(FileName, fmCreate);
      ffrom:= TFileStream.Create(fname, fmOpenRead);
      f.CopyFrom(ffrom, 0);
      f.Free;
      ffrom.Free;
      DeleteFile(fname);
      for i:= 1 to FCopies do
        SpoolFile(FileName);
      DeleteFile(FileName);
    end;
  end;
end;

{ TfrxTXTExportDialog }

procedure TfrxDMPExportDialog.FormCreate(Sender:TObject);
var
  i:Integer;
begin
  frxResources.LocalizeForm(Self);
  PrinterCB.Items:= frxPrinters.Printers;
  PrinterCB.ItemIndex:= frxPrinters.PrinterIndex;
  OldIndex:= frxPrinters.PrinterIndex;
  for i:= 0 to frxDMPrinters.Count-1 do
    EscCB.Items.Add(frxDMPrinters[i].Commands[cmdName]);
end;

procedure TfrxDMPExportDialog.FormHide(Sender:TObject);
begin
  if ModalResult<>mrOk then
    frxPrinters.PrinterIndex:= OldIndex;
end;

procedure TfrxDMPExportDialog.PrinterCBClick(Sender:TObject);
begin
  frxPrinters.PrinterIndex:= PrinterCB.ItemIndex;
end;

procedure TfrxDMPExportDialog.PrinterCBDrawItem(Control:TWinControl;
  Index:Integer; ARect:TRect; State:TOwnerDrawState);
var
  r:TRect;
begin
  r:= ARect;
  r.Right:= r.Left+18;
  r.Bottom:= r.Top+16;
  OffsetRect(r, 2, 0);
  with PrinterCB.Canvas do
  begin
    FillRect(ARect);
    BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16), clOlive);
    TextOut(ARect.Left+24, ARect.Top+1, PrinterCB.Items[Index]);
  end;
end;

procedure TfrxDMPExportDialog.RangeEEnter(Sender:TObject);
begin
  PageNumbersRB.Checked:= True;
end;

initialization
  frxDMPrinters:= TfrxDMPrinters.Create;
  frxDMPrinters.ReadDefaultPrinters;
  frxDMPrinters.ReadExtPrinters;

finalization
  frxDMPrinters.Free;

end.