rm_asbarview.pas

这是一个功能强大

{*******************************************}
{                                           }
{          Report Machine v2.0              }
{         Barcode Add-in object             }
{                                           }
{*******************************************}

unit RM_AsBarView;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ExtCtrls, Buttons, RM_Common, RM_Class, RM_Ctrls,
  RM_AsBarCode
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

type
  TRMAsBarCodeObject = class(TComponent) // fake component
  end;

  TRMAsBarCodeAngleType = (rmatNone, rmat90, rmat180, rmat270);

  { TRMBarCodeInfo }
  TRMAsBarCodeInfo = class(TPersistent)
  private
    FBarCode: TAsBarcode;
    FShowText: Boolean;
    FAngle: TRMAsBarCodeAngleType;
    FFont: TFont;

    function GetText: string;
    procedure SetText(Value: string);
    function GetModul: Integer;
    procedure SetModul(Value: Integer);
    function GetRatio: Double;
    procedure SetRatio(Value: Double);
    function GetBarType: TBarcodeType;
    procedure SetBarType(Value: TBarcodeType);
    function GetChecksum: Boolean;
    procedure SetChecksum(Value: Boolean);
    function GetCheckSumMethod: TCheckSumMethod;
    procedure SetCheckSumMethod(Value: TCheckSumMethod);
    procedure SetAngle(Value: TRMAsBarCodeAngleType);
    function GetColor: TColor;
    procedure SetColor(Value: TColor);
    function GetColorBar: TColor;
    procedure SetColorBar(Value: TColor);
    function GetBarcodeHeight: Integer;
    function GetBarcodeWidth: Integer;
    procedure SetBarcodeHeight(const Value: Integer);
    procedure SetBarcodeWidth(const Value: Integer);
    procedure SetTextFont(Value: TFont);
  protected
  public
    constructor Create;
    destructor Destroy; override;

    property BarCode: TAsBarcode read FBarCode write FBarCode;
    property Text: string read GetText write SetText;
    property BarcodeHeight: Integer read GetBarcodeHeight write SetBarcodeHeight;
    property BarcodeWidth: Integer read GetBarcodeWidth write SetBarcodeWidth;
  published
    property ShowText: Boolean read FShowText write FShowText;
    property BarType: TBarcodeType read GetBarType write SetBarType;
    property Checksum: boolean read GetCheckSum write SetCheckSum;
    property CheckSumMethod: TCheckSumMethod read GetCheckSumMethod write SetCheckSumMethod;
    property Angle: TRMAsBarCodeAngleType read FAngle write SetAngle;
    property Color: TColor read GetColor write SetColor;
    property ColorBar: TColor read GetColorBar write SetColorBar;
    property TextFont: TFont read FFont write SetTextFont;
    property Zoom: integer read GetModul write SetModul;
    property Ratio: Double read GetRatio write SetRatio;
  end;

  { TRMAsBarCodeView }
  TRMAsBarCodeView = class(TRMReportView)
  private
    FBarInfo: TRMAsBarCodeInfo;

    function GetDirectDraw: Boolean;
    procedure SetDirectDraw(Value: Boolean);
    function GetAutoSize: Boolean;
    procedure SetAutoSize(Value: Boolean);
  protected
    function GetViewCommon: string; override;
    procedure PlaceOnEndPage(aStream: TStream); override;
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure DefinePopupMenu(aPopup: TRMCustomMenuItem); override;
    procedure ShowEditor; override;

    property DirectDraw: Boolean read GetDirectDraw write SetDirectDraw;
    property AutoSize: Boolean read GetAutoSize write SetAutoSize;
  published
    property BarInfo: TRMAsBarCodeInfo read FBarInfo write FBarInfo;
    property LeftFrame;
    property TopFrame;
    property RightFrame;
    property BottomFrame;
    property FillColor;
    property DataField;
    property PrintFrame;
    property Printable;
    property GapLeft;
    property GapTop;
    property OnPreviewClick;
    property OnPreviewClickUrl;
  end;

implementation

uses RM_Const, RM_Const1, RM_Utils;

const
  flBarcodeDirectDraw = $2;
  flBarCodeAutoSize = $4;
  cbDefaultText = '12345678';

function CreateRotatedFont(Font: TFont; Angle: Integer): HFont;
var
  F: TLogFont;
begin
  GetObject(Font.Handle, SizeOf(TLogFont), @F);
  F.lfEscapement := Angle * 10;
  F.lfOrientation := Angle * 10;
  Result := CreateFontIndirect(F);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMBarCodeInfo }

constructor TRMAsBarCodeInfo.Create;
begin
  inherited Create;

  FBarCode := TAsBarcode.Create(nil);
  FShowText := True;
  FBarCode.Height := 50;
  FBarCode.CheckSum := True;
  FBarCode.Modul := 1;
  FBarCode.Ratio := 2;
  FBarCode.Angle := 0;

  FFont := TFont.Create;
  FFont.Color := clBlack;
  FFont.Name := 'Arial';
  FFont.Size := 9;
  FFont.Style := [];
end;

destructor TRMAsBarCodeInfo.Destroy;
begin
  FreeAndNil(FBarCode);
  FFont.Free;
  inherited Destroy;
end;

function TRMAsBarCodeInfo.GetText: string;
begin
  Result := FBarCode.Text;
end;

procedure TRMAsBarCodeInfo.SetText(Value: string);
begin
  FBarCode.Text := Value;
end;

function TRMAsBarCodeInfo.GetModul: Integer;
begin
  Result := FBarCode.Modul{FModul};
end;

procedure TRMAsBarCodeInfo.SetModul(Value: Integer);
begin
  FBarCode.Modul{FModul} := Value;
end;

function TRMAsBarCodeInfo.GetRatio: Double;
begin
  Result := FBarCode.Ratio{ FRatio};
end;

procedure TRMAsBarCodeInfo.SetRatio(Value: Double);
begin
  FBarCode.Ratio{FRatio} := Value;
end;

function TRMAsBarCodeInfo.GetBarType: TBarcodeType;
begin
  Result := FBarCode.Typ;
end;

procedure TRMAsBarCodeInfo.SetBarType(Value: TBarcodeType);
begin
  FBarCode.Typ := Value;
end;

function TRMAsBarCodeInfo.GetChecksum: Boolean;
begin
  Result := FBarCode.Checksum;
end;

procedure TRMAsBarCodeInfo.SetChecksum(Value: Boolean);
begin
  FBarCode.Checksum := Value;
end;

function TRMAsBarCodeInfo.GetCheckSumMethod: TCheckSumMethod;
begin
  Result := FBarCode.CheckSumMethod;
end;

procedure TRMAsBarCodeInfo.SetCheckSumMethod(Value: TCheckSumMethod);
begin
  FBarCode.CheckSumMethod := Value;
end;

procedure TRMAsBarCodeInfo.SetAngle(Value: TRMAsBarCodeAngleType);
begin
  FAngle := Value;
  case Value of
    rmatNone: FBarCode.Angle := 0;
    rmat90: FBarCode.Angle := 90;
    rmat180: FBarCode.Angle := 180;
    rmat270: FBarCode.Angle := 270;
  end;
end;

function TRMAsBarCodeInfo.GetColor: TColor;
begin
  Result := FBarCode.Color;
end;

procedure TRMAsBarCodeInfo.SetColor(Value: TColor);
begin
  FBarCode.Color := Value;
end;

function TRMAsBarCodeInfo.GetColorBar: TColor;
begin
  Result := FBarCode.ColorBar;
end;

procedure TRMAsBarCodeInfo.SetColorBar(Value: TColor);
begin
  FBarCode.ColorBar := Value;
end;

function TRMAsBarCodeInfo.GetBarcodeHeight: Integer;
begin
  Result := FBarcode.Height;
end;

procedure TRMAsBarCodeInfo.SetBarcodeHeight(const Value: Integer);
begin
  FBarcode.Height := Value;
end;

function TRMAsBarCodeInfo.GetBarcodeWidth: Integer;
begin
  Result := FBarcode.Width;
end;

procedure TRMAsBarCodeInfo.SetBarcodeWidth(const Value: Integer);
begin
  FBarcode.Width := Value;
end;

procedure TRMAsBarCodeInfo.SetTextFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMAsBarCodeView}

constructor TRMAsBarCodeView.Create;
begin
  inherited Create;
  BaseName := 'Bar';
  Memo.Add(cbDefaultText);

  FBarInfo := TRMAsBarCodeInfo.Create;
end;

destructor TRMAsBarCodeView.Destroy;
begin
  FreeAndNil(FBarInfo);
  inherited Destroy;
end;

procedure TRMAsBarCodeView.LoadFromStream(aStream: TStream);
var
  lVersion: Word;
begin
  inherited LoadFromStream(aStream);

  lVersion := RMReadWord(aStream);
  FBarInfo.ShowText := RMReadBoolean(aStream);
  FBarInfo.Zoom := RMReadInt32(aStream);
  FBarInfo.Ratio := RMReadFloat(aStream);
  FBarInfo.BarType := TBarcodeType(RMReadByte(aStream));
  FBarInfo.Checksum := RMReadBoolean(aStream);
  FBarInfo.CheckSumMethod := TCheckSumMethod(RMReadByte(aStream));
  FBarInfo.Angle := TRMAsBarCodeAngleType(RMReadByte(aStream));
  FBarInfo.ColorBar := RMReadInt32(aStream);
  if lVersion >= 1 then
    RMReadFont(aStream, FBarInfo.TextFont);
end;

procedure TRMAsBarCodeView.SaveToStream(aStream: TStream);
begin