frxdmpclass.pas

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

{******************************************}
{                                          }
{             FastReport v4.0              }
{        DotMatrix printers stuff          }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxDMPClass;

interface

{$I frx.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  frxClass
{$IFDEF Delphi6}
, Variants
{$ENDIF}
{$IFDEF FR_COM}
, FastReport_TLB
{$ENDIF}
;

type
  TfrxDMPFontStyle = (fsxBold, fsxItalic, fsxUnderline, fsxSuperScript,
    fsxSubScript, fsxCondensed, fsxWide, fsx12cpi, fsx15cpi);
  TfrxDMPFontStyles = set of TfrxDMPFontStyle;

{$IFDEF FR_COM}
  TfrxDMPMemoView = class(TfrxCustomMemoView, IfrxDMPMemoView)
{$ELSE}
  TfrxDMPMemoView = class(TfrxCustomMemoView)
{$ENDIF}
  private
    FFontStyle: TfrxDMPFontStyles;
    FTruncOutboundText: Boolean;
    procedure SetFontStyle(const Value: TfrxDMPFontStyles);
{$IFDEF FR_COM}
    function Get_FontStyle(out Value: frxFontStyle): HResult; stdcall;
    function Set_FontStyle(Value: frxFontStyle): HResult; stdcall;
{$ENDIF}
    function IsFontStyleStored: Boolean;
  protected
    procedure DrawFrame; override;
    procedure SetLeft(Value: Extended); override;
    procedure SetTop(Value: Extended); override;
    procedure SetWidth(Value: Extended); override;
    procedure SetHeight(Value: Extended); override;
    procedure SetParentFont(const Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    procedure ResetFontOptions;
    procedure SetBoundsDirect(ALeft, ATop, AWidth, AHeight: Extended);
    function CalcHeight: Extended; override;
    function CalcWidth: Extended; override;
    function Diff(AComponent: TfrxComponent): String; override;
    function GetoutBoundText: String;
  published
    property AutoWidth;
    property AllowExpressions;
    property DataField;
    property DataSet;
    property DataSetName;
    property DisplayFormat;
    property ExpressionDelimiters;
    property FlowTo;
    property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle
      stored IsFontStyleStored;
    property Frame;
    property HAlign;
    property HideZeros;
    property Memo;
    property ParentFont;
    property RTLReading;
    property SuppressRepeated;
    property WordWrap;
    property TruncOutboundText: Boolean read FTruncOutboundText write FTruncOutboundText;
    property VAlign;
  end;

{$IFDEF FR_COM}
  TfrxDMPLineView = class(TfrxCustomLineView, IfrxDMPLineView)
{$ELSE}
  TfrxDMPLineView = class(TfrxCustomLineView)
{$ENDIF}
  private
    FFontStyle: TfrxDMPFontStyles;
    procedure SetFontStyle(const Value: TfrxDMPFontStyles);
    function IsFontStyleStored: Boolean;
{$IFDEF FR_COM}
    function Get_FontStyle(out Value: frxFontStyle): HResult; stdcall;
    function Set_FontStyle(Value: frxFontStyle): HResult; stdcall;
{$ENDIF}
  protected
    procedure SetLeft(Value: Extended); override;
    procedure SetTop(Value: Extended); override;
    procedure SetWidth(Value: Extended); override;
    procedure SetParentFont(const Value: Boolean); override;
  public
    class function GetDescription: String; override;
    function Diff(AComponent: TfrxComponent): String; override;
  published
    property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle
      stored IsFontStyleStored;
    property ParentFont;
  end;

{$IFDEF FR_COM}
  TfrxDMPCommand = class(TfrxView, IfrxDMPCommand)
{$ELSE}
  TfrxDMPCommand = class(TfrxView)
{$ENDIF}
  private
    FCommand: String;
{$IFDEF FR_COM}
    function Get_Command(out Value: WideString): HResult; stdcall;
    function Set_Command(const Value: WideString): HResult; stdcall;
{$ENDIF}
  protected
    procedure SetLeft(Value: Extended); override;
    procedure SetTop(Value: Extended); override;
  public
    class function GetDescription: String; override;
    function Diff(AComponent: TfrxComponent): String; override;
    function ToChr: String;
  published
    property Command: String read FCommand write FCommand;
  end;

{$IFDEF FR_COM}
  TfrxDMPPage = class(TfrxReportPage, IfrxDMPPage)
{$ELSE}
  TfrxDMPPage = class(TfrxReportPage)
{$ENDIF}
  private
    FFontStyle: TfrxDMPFontStyles;
    procedure SetFontStyle(const Value: TfrxDMPFontStyles);
{$IFDEF FR_COM}
    function Get_FontStyle(out Value: frxFontStyle): HResult; stdcall;
    function Set_FontStyle(Value: frxFontStyle): HResult; stdcall;
{$ENDIF}
  protected
    procedure SetPaperHeight(const Value: Extended); override;
    procedure SetPaperWidth(const Value: Extended); override;
    procedure SetPaperSize(const Value: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetDefaults; override;
    procedure ResetFontOptions;
  published
    property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle;
  end;


implementation

uses frxRes, frxDsgnIntf, frxXML;


function DiffFontStyle(f: TfrxDMPFontStyles): String;
var
  fs: Integer;
begin
  fs := 0;
  if fsxBold in f then fs := 1;
  if fsxItalic in f then fs := fs or 2;
  if fsxUnderline in f then fs := fs or 4;
  if fsxSuperScript in f then fs := fs or 8;
  if fsxSubScript in f then fs := fs or 16;
  if fsxCondensed in f then fs := fs or 32;
  if fsxWide in f then fs := fs or 64;
  if fsx12cpi in f then fs := fs or 128;
  if fsx15cpi in f then fs := fs or 256;
  Result := ' FontStyle="' + String(IntToStr(fs)) + '"';
end;


{ TfrxDMPMemoView }

constructor TfrxDMPMemoView.Create(AOwner: TComponent);
begin
  inherited;
  ResetFontOptions;
end;

class function TfrxDMPMemoView.GetDescription: String;
begin
  Result := frxResources.Get('obDMPText');
end;

procedure TfrxDMPMemoView.ResetFontOptions;
begin
  Font.OnChange := nil;
  Font.Name := 'Courier New';
  Font.Size := 12;
  Font.Style := [];
  if fsxBold in FFontStyle then
    Font.Style := Font.Style + [fsBold];
  if fsxItalic in FFontStyle then
    Font.Style := Font.Style + [fsItalic];
  if fsxUnderline in FFontStyle then
    Font.Style := Font.Style + [fsUnderline];
  CharSpacing := 0;
  LineSpacing := 1;
  GapX := 0;
  GapY := 0;
end;

procedure TfrxDMPMemoView.SetHeight(Value: Extended);
begin
  Value := Round(Value / fr1CharY) * fr1CharY;
  inherited;
end;

procedure TfrxDMPMemoView.SetLeft(Value: Extended);
begin
  if Align = baRight then
    Value := Trunc(Value / fr1CharX) * fr1CharX else
    Value := Round(Value / fr1CharX) * fr1CharX;
  inherited;
end;

procedure TfrxDMPMemoView.SetTop(Value: Extended);
begin
  Value := Round(Value / fr1CharY) * fr1CharY;
  inherited;
end;

procedure TfrxDMPMemoView.SetWidth(Value: Extended);
begin
  Value := Round(Value / fr1CharX) * fr1CharX;
  inherited;
end;

procedure TfrxDMPMemoView.SetFontStyle(const Value: TfrxDMPFontStyles);
begin
  FFontStyle := Value;
  ParentFont := False;
  ResetFontOptions;
end;

procedure TfrxDMPMemoView.SetParentFont(const Value: Boolean);
begin
  inherited;
  if Value then
    if Page is TfrxDMPPage then
      FFontStyle := TfrxDMPPage(Page).FontStyle;
end;

function TfrxDMPMemoView.IsFontStyleStored: Boolean;
begin
  Result := not ParentFont;
end;

procedure TfrxDMPMemoView.DrawFrame;
begin
  FX := Round((AbsLeft - fr1CharX / 2) * FScaleX + FOffsetX);
  FY := Round((AbsTop - fr1CharY / 2) * FScaleY + FOffsetY);
  FX1 := Round((AbsLeft + Width + fr1CharX / 2) * FScaleX + FOffsetX);
  FY1 := Round((AbsTop + Height + fr1CharY / 2) * FScaleY + FOffsetY);
  inherited;
end;

function TfrxDMPMemoView.CalcHeight: Extended;
begin
  Result := inherited CalcHeight;
  Result := Round(Result / fr1CharY) * fr1CharY;
end;

function TfrxDMPMemoView.CalcWidth: Extended;
begin
  Result := inherited CalcWidth;
  Result := Round(Result / fr1CharX) * fr1CharX;
end;

function TfrxDMPMemoView.Diff(AComponent: TfrxComponent): String;
var
  m: TfrxDMPMemoView;
begin
  Result := inherited Diff(AComponent);
  m := TfrxDMPMemoView(AComponent);
  if FFontStyle <> m.FontStyle then
    Result := Result + DiffFontStyle(FFontStyle);
end;

procedure TfrxDMPMemoView.SetBoundsDirect(ALeft, ATop, AWidth, AHeight: Extended);
begin
  inherited SetLeft(ALeft);
  inherited SetTop(ATop);
  inherited SetWidth(AWidth);
  inherited SetHeight(AHeight);
end;

{$IFDEF FR_COM}
function TfrxDMPMemoView.Get_FontStyle(out Value: frxFontStyle): HResult;