frxdmpexport.pas

这个是功能强大的报表软件

end;

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

procedure TfrxDotMatrixExport.WriteStrLn(const str: AnsiString);
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(AnsiStr: AnsiString): AnsiString;
  var
    i: Integer;
  begin
    SetLength(Result, Length(AnsiStr));
    if Length(Result) > 0 then
    begin
      for i := 1 to Length(AnsiStr) do
        if AnsiStr[i] = #160 then
          AnsiStr[i] := #32;
      CharToOemBuffA(PAnsiChar(AnsiStr), PAnsiChar(Result), Length(Result));
    end;
  end;

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

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

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

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

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

  function CenterStr(const S: AnsiString; Len: Integer): AnsiString;
  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: AnsiString): AnsiString;
  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;

  if not Memo.WordWrap and Memo.TruncOutboundText then
    Text := Memo.GetoutBoundText
  else
    Text := Memo.WrapText(True);
  if FOEMConvert then
    Text := String(StrToOem(AnsiString(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(AnsiString(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: AnsiString;
  Frames: AnsiString;

  function Trim_Right(const s: AnsiString): AnsiString;
  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 := AnsiString(StyleOn(CurrentStyle));
    for j := 0 to FBufWidth - 1 do
    begin
      Style := FStyleBuf[i * FBufWidth + j];
      if Style <> CurrentStyle then
      begin
        buf := buf + AnsiString(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) + AnsiString(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;
    RangeE.Text := PageNumbers;

    Result := ShowModal;
    if Result = mrOk then
    begin
      FSaveToFile := SaveToFileCB.Checked;
      if FSaveToFile then
        if SaveDialog1.Execute then
          FileName := 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 not ShowDialog then
    FCopies := Report.PrintOptions.Copies;

  if Assigned(Stream) then
    FStream := Stream
  else
  begin
    if not FSaveToFile then
      FileName := GetTempFName;

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

  if Assigned(FStream) then
  begin
    Reset;
    WriteStr(FPrinterInitString);
    WriteStr(AnsiString(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
    begin
      if TfrxDMPLineView(Obj).Align = baWidth then
        DrawFrame(Trunc(Obj.AbsLeft / fr1CharX) - 1, Trunc(Obj.AbsTop / fr1CharY),
          Round(Obj.Width / fr1CharX) + 3, 1, Style)
      else if TfrxDMPLineView(Obj).Align = baLeft then
        DrawFrame(Trunc(Obj.AbsLeft / fr1CharX) - 1, Trunc(Obj.AbsTop / fr1CharY),
          Round(Obj.Width / fr1CharX) + 1, 1, Style)
      else if TfrxDMPLineView(Obj).Align = baRight then
        DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
          Round(Obj.Width / fr1CharX) + 2, 1, Style)
      else
        DrawFrame(Trunc(Obj.AbsLeft / fr1CharX), Trunc(Obj.AbsTop / fr1CharY),
          Round(Obj.Width / fr1CharX) + 1, 1, Style);
    end;
  end
  else if Obj is TfrxDMPCommand then
  begin
    SetString(Round(Obj.AbsLeft / fr1CharX), Round(Obj.AbsTop / fr1CharY),
      AnsiString(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
  Caption := frxGet(500);
  PrinterL.Caption := frxGet(501);
  PagesL.Caption := frxGet(502);
  CopiesL.Caption := frxGet(503);
  CopiesNL.Caption := frxGet(504);
  DescrL.Caption := frxGet(9);
  OptionsL.Caption := frxGet(505);
  EscL.Caption := frxGet(506);
  OK.Caption := frxGet(1);
  Cancel.Caption := frxGet(2);
  SaveToFileCB.Caption := frxGet(507);
  AllRB.Caption := frxGet(3);
  CurPageRB.Caption := frxGet(4);
  PageNumbersRB.Caption := frxGet(5);
  PageBreaksCB.Caption := frxGet(6);
  OemCB.Caption := frxGet(508);
  PseudoCB.Caption := frxGet(509);
  SaveDialog1.Filter := frxGet(510);

  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]);

  SetWindowLong(CopiesE.Handle, GWL_STYLE, GetWindowLong(CopiesE.Handle, GWL_STYLE) or ES_NUMBER);

  if UseRightToLeftAlignment then
    FlipChildren(True);
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;


procedure TfrxDMPExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

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

finalization
  frxDMPrinters.Free;

end.


//