⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rm_chinesemoneymemo.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
字号:

{*****************************************}
{                                         }
{             Report Machine v2.0         }
{            Chinese Money Object         }
{*****************************************}
{                                         }
{            作者:David (xac@163.com)    }
{            修改: 廖伯志
{                 1.你的MonyView--小数位变化时,显示有误,我的已修正}
{*****************************************}
unit RM_ChineseMoneyMemo;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Menus, RM_Class
{$IFDEF Delphi6}, Variants{$ENDIF};

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

  { TRMMoneyView }
  TRMMoneyView = class(TRMMemoView)
  private
    FWorkCellWidth: integer;
    FWorkCellOffset: integer;
    FDigitalSymbols: tstringlist;
    FDecimalSymbols: tstringlist;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    procedure DrawGrid(Canvas: TCanvas);
    procedure DrawText(Canvas: TCanvas; Text: string);
    procedure DrawTitle(Canvas: TCanvas);
  public
    CurrencySymbol: string;
    IsTitle: Boolean;
    GridLineWidth: integer;
    DigitalNumber: integer;
    DecimalNumber: integer;
    DecimalSeparatorColor: TColor;
    KilobitSeparatorColor: TColor;
    GridLineColor: TColor;
    constructor create; override;
    destructor Destroy; override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  end;


implementation

uses RM_Utils, RM_Const, RM_Const1;

{TFRMoneyMemoView}

procedure TRMMoneyView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  with Stream do
  begin
    Read(DecimalSeparatorColor, 4);
    Read(KilobitSeparatorColor, 4);
    Read(GridLineColor, 4);
  end;
  ISTitle := RMReadBoolean(stream);
  GridLineWidth := RMReadInteger(Stream);
  DigitalNumber := RMReadInteger(Stream);
  DecimalNumber := RMReadInteger(Stream);
  CurrencySymbol := RMReadString(stream);
end;

procedure TRMMoneyView.SaveToStream(Stream: TStream);
begin
  HVersion := 0; LVersion := 0;
  inherited SaveToStream(Stream);
  with Stream do
  begin
    Write(DecimalSeparatorColor, 4);
    Write(KilobitSeparatorColor, 4);
    Write(GridLineColor, 4);
  end;
  RMWriteBoolean(stream, IsTitle);
  RMWriteInteger(Stream, GridLineWidth);
  RMWriteInteger(Stream, DigitalNumber);
  RMWriteInteger(Stream, DecimalNumber);
  RMWriteString(stream, CurrencySymbol);
end;

procedure TRMMoneyView.DrawTitle(Canvas: TCanvas);
var
  I, len: Integer;
  XOffset, YOffset: Integer;
 // TheRect: TRect;
begin
  Canvas.Font.Assign(Font);
  if DigitalNumber > 19 then Exit;
  if decimalNumber > 5 then Exit;
  len := DigitalNumber - DecimalNumber;

  FWorkCellWidth := (dx - GridLineWidth * (DigitalNumber - 1)) div DigitalNumber;
  FWorkCellOffset := dx - GridLineWidth * (DigitalNumber - 1) - FWorkCellWidth * DigitalNumber;

  XOffset := (FWorkCellWidth - Canvas.TextWidth(FDigitalSymbols.Strings[0])) div 2;
  YOffset := (DY - Canvas.TextHeight(FDigitalSymbols.Strings[0])) div 2 + 1;

  for i := 0 to len - 1 do
    canvas.TextOut(x + XOffset + FWorkCellOffset + (FWorkCellWidth + GridLineWidth) * I, Y + YOffset, FDigitalSymbols.Strings[Len - 1 - i]);
  for i := Len to DigitalNumber - 1 do
   // Canvas.TextRect(TheRect,X+XOffset+(FWorkCellOffset+FWorkCellWidth+GridLineWidth)*I,Y+YOffset, FDecimalSymbols.Strings[i-len]);
    canvas.TextOut(x + XOffset + FWorkCellOffset + (FWorkCellWidth + GridLineWidth) * I, Y + YOffset, FDecimalSymbols.Strings[i - len]);
end;

procedure TRMMoneyView.DrawGrid(Canvas: TCanvas);
var
  I: Integer;
  OldPenColor: TColor;
  OldPenWidth: Integer;
  OldPenPos: TPoint;
begin
  OldPenColor := Canvas.Pen.Color;
  OldPenWidth := Canvas.Pen.Width;
  OldPenPos := Canvas.PenPos;
  Canvas.Pen.Width := GridLineWidth;
  for I := 1 to DigitalNumber - 1 do
  begin
    if ((DigitalNumber - DecimalNumber - I) = 0) then
      Canvas.Pen.Color := DecimalSeparatorColor
    else
      if ((DigitalNumber - DecimalNumber - I) mod 3 = 0) then
        Canvas.Pen.Color := KilobitSeparatorColor
      else
        Canvas.Pen.Color := GridLineColor;

    FWorkCellWidth := (dx - GridLineWidth * (DigitalNumber - 1)) div DigitalNumber;
    FWorkCellOffset := Dx - GridLineWidth * (DigitalNumber - 1) - FWorkCellWidth * DigitalNumber;

    Canvas.MoveTo(x + (FWorkCellWidth + GridLineWidth) * I - GridLineWidth + FWorkCellOffset, y + 0);
    Canvas.LineTo(x + (FWorkCellWidth + GridLineWidth) * I - GridLineWidth + FWorkCellOffset, y + DY);
  end;
  Canvas.Pen.Color := OldPenColor;
  Canvas.Pen.Width := OldPenWidth;
  Canvas.PenPos := OldPenPos;
end;

procedure TRMMoneyView.DrawText(Canvas: TCanvas; Text: string);
var

  e, I, J, Len, LenStart: Integer;
  XOffset, YOffset: Integer;
  TheRect: TRect;
  r: real;
  FDotLength: integer;
 // FCurrencySymbolAligned:boolean;
begin
 // FCurrencySymbol:='$';//货币符号

//  format('%6.1f',
  FDotLength := 1;
//  FCurrencySymbolAligned:=false;
  Canvas.Font.Assign(Font);
  //*************************************************2002.1.17 LBZ

  val(text, r, e);
  if DecimalNumber = 0 then text := floattostr(int(r));

  text := trim(text);
  j := Pos('.', Text);
  if j > 0 then text := copy(text, 1, j + DecimalNumber);
  //*************************************************
  Len := Length(Text);
  j := Pos('.', Text);
  if j = 0 then
    for i := 1 to DecimalNumber do
      if i = 1 then
        Text := Text + '.0'
      else
        Text := Text + '0'
    else
      for i := 1 to DecimalNumber - (Len - J) do
        Text := Text + '0';

      Len := Length(Text);
      FWorkCellWidth := (dx - GridLineWidth * (DigitalNumber - 1)) div DigitalNumber;
      FWorkCellOffset := dx - GridLineWidth * (DigitalNumber - 1) - FWorkCellWidth * DigitalNumber;
      if (CurrencySymbol <> '') then
      begin
        if (DigitalNumber - (Len - FDotLength) < 1) then
        begin
          Text := StringOfChar('*', DigitalNumber - DecimalNumber - 1) + StringOfChar('.', FDotLength) + StringOfChar('*', DecimalNumber);
        end;
      end
      else begin
        if (DigitalNumber - (Len - FDotLength) < 0) then
        begin
          Text := StringOfChar('*', DigitalNumber - DecimalNumber) + StringOfChar('.', FDotLength) + StringOfChar('*', DecimalNumber);
        end;
      end;

      XOffset := (FWorkCellWidth - Canvas.TextWidth(CurrencySymbol)) div 2;
      YOffset := (DY - Canvas.TextHeight(CurrencySymbol)) div 2 + 1;
      Len := length(Text);
      if DecimalNumber = 0 then inc(len);
      delete(Text, Len - DecimalNumber, 1);
      LenStart := DigitalNumber - Len;
   //画出货币符号
      if CurrencySymbol <> '' then
      begin
        TheRect := Rect(X + XOffset - GridLineWidth + FWorkCellOffset + (FWorkCellWidth + GridLineWidth) * LenStart, Y + YOffset, FWorkCellWidth + X + FWorkCellOffset + (FWorkCellWidth + GridLineWidth) * LenStart, Y + DY - YOffset);
        Canvas.TextRect(TheRect, X + xoffset + FWorkCellOffset + (FWorkCellWidth + GridLineWidth) * LenStart, Y + YOffset, CurrencySymbol);
      end;
      XOffset := (FWorkCellWidth - Canvas.TextWidth('0')) div 2;
      YOffset := (DY - Canvas.TextHeight('0')) div 2 + 1;
      for I := 1 to Len - 1 do
        canvas.TextOut(x + XOffset + FWorkCellOffset + (FWorkCellWidth + GridLineWidth) * (I + LenStart), Y + YOffset, TEXT[i]);
end;



constructor TRMMoneyView.create;
begin
  inherited Create;
  BaseName := 'MoneyMemo';
 // BrushColor:=clwhite; //画刷的颜色
  CurrencySymbol := '¥';
  IsTitle := false;
  Typ := gtMoneyMemo;
  DigitalNumber := 12; //数字的位数
  DecimalNumber := 2; //小数的位数
  GridLineWidth := 1; //分割线的宽度
  DecimalSeparatorColor := clRed; //小数点分割线的颜色
  KilobitSeparatorColor := clBlack; //千位分割线的颜色
  GridLineColor := clSilver; //分割线的颜色
  //DrawTitle Init
  FDecimalSymbols := Tstringlist.create;
  FDigitalSymbols := Tstringlist.create;
  FDigitalSymbols.Add('元');
  FDigitalSymbols.Add('十');
  FDigitalSymbols.Add('百');
  FDigitalSymbols.Add('千');
  FDigitalSymbols.Add('万');
  FDigitalSymbols.Add('十');
  FDigitalSymbols.Add('百');
  FDigitalSymbols.Add('千');
  FDigitalSymbols.Add('亿');
  FDigitalSymbols.Add('十');
  FDigitalSymbols.Add('百');
  FDigitalSymbols.Add('千');
  FDigitalSymbols.Add('万');
  FDigitalSymbols.Add('兆');
  FDigitalSymbols.Add('十');
  FDecimalSymbols.Add('角');
  FDecimalSymbols.Add('分');
  FDecimalSymbols.Add('厘');
  FDecimalSymbols.Add('毫');
  FDecimalSymbols.Add('微');
end;

destructor TRMMoneyView.Destroy;
begin
  FDigitalSymbols.free;
  FDecimalSymbols.free;
  inherited Destroy;
end;

procedure TRMMoneyView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty(' 标题', [rmdtBoolean], nil);
  AddProperty(' 货币符号', [rmdtString], nil);
  AddProperty(' 数字位数', [rmdtInteger], nil);
  AddProperty(' 小数点位数', [rmdtInteger], nil);
  AddProperty(' 分割线宽度', [rmdtInteger], nil);
  AddProperty(' 分割线颜色', [rmdtColor], nil);
  AddProperty(' 千位分割线颜色', [rmdtColor], nil);
  AddProperty(' 小数点分割线颜色', [rmdtColor], nil);
end;

procedure TRMMoneyView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = ' 小数点位数' then
    DecimalNumber := Value
  else if Index = ' 数字位数' then
    DigitalNumber := Value
  else if Index = ' 分割线宽度' then
    GridLineWidth := Value
  else if Index = ' 小数点分割线颜色' then
    DecimalSeparatorColor := Value
  else if Index = ' 千位分割线颜色' then
    KilobitSeparatorColor := Value
  else if Index = ' 标题' then
    IsTitle := Value
  else if Index = ' 货币符号' then
    CurrencySymbol := Value
  else if Index = ' 分割线颜色' then
    GridLineColor := Value;
end;

function TRMMoneyView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = ' 小数点位数' then
    Result := DecimalNumber
  else if Index = ' 数字位数' then
    Result := DigitalNumber
  else if Index = ' 分割线宽度' then
    Result := GridLineWidth
  else if Index = ' 小数点分割线颜色' then
    Result := DecimalSeparatorColor
  else if Index = ' 千位分割线颜色' then
    Result := KilobitSeparatorColor
  else if Index = ' 标题' then
    Result := IsTitle
  else if Index = ' 货币符号' then
    Result := CurrencySymbol
  else if Index = ' 分割线颜色' then
    Result := GridLineColor;
end;

procedure TRMMoneyView.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  Streaming := False;
  Memo1.Assign(Memo);
  CalcGaps;
  if (not Exporting) {and (DrawMode <> drCalcHeight)} then
  begin
    ShowBackground;
    ShowFrame;
  end;
  drawGrid(aCanvas);
  if Istitle then
    DrawTitle(aCanvas)
  else if trim(Memo1.Text) <> '' then
    DrawText(aCanvas, trim(Memo1.Text));
  drawGrid(aCanvas);
  RestoreCoord;
end;

initialization

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -