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

📄 unitasutils.pas

📁 仿速达界面控件
💻 PAS
字号:
unit UnitASUtils;

interface
uses
  Windows, Controls, Graphics, Classes, SysUtils;

function TextWidth(Canvas: TCanvas; AText: WideString; Flags: Integer = 0):
  integer;
overload;
function TextHeight(Canvas: TCanvas; AText: WideString): integer; overload;

procedure FillRect(Canvas: TCanvas; Rect: TRect; Color: TColor); overload;

procedure FillRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer;
  Color: TColor); overload;

function DrawText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag:
  cardinal): integer; overload;

function DrawText(ACanvas: TCanvas; AText: WideString; X, Y: integer): integer;
overload;

function CurrencyFrameCellWidth(ACanvas: TCanvas): Integer;

function ChineseCurrencyText(AText: WideString; ACurrencySymbol: WideChar):
  Widestring;

procedure DrawCurrencyFrame(ACanvas: TCanvas; ARect: TRect; Value:
  Currency; CurrencySymbol: WideChar; DrawZeroValue: Boolean = False);

function IsWinNT: Boolean;

implementation

function IsWinNT: Boolean;
var
  VI: TOSVersionInfo;
begin
  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);
  Result := VI.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;

function TextWidth(Canvas: TCanvas; AText: WideString; Flags: Integer = 0):
  integer;
begin
  Result := Canvas.TextWidth(AText);
end;

function TextHeight(Canvas: TCanvas; AText: WideString): integer;
begin
  Result := Canvas.TextHeight(AText);
end;

procedure FillRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(Rect);
end;

procedure FillRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer;
  Color: TColor); overload;
begin
  FillRect(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

function DrawText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag:
  cardinal): integer;
begin
  Result := Windows.DrawTextW(ACanvas.Handle, PWideChar(AText),
    Length(AText), Bounds, Flag);
end;

function DrawText(ACanvas: TCanvas; AText: WideString; X, Y: integer): integer;
var
  R: TRect;
begin
  R := Rect(X, Y, X + TextWidth(ACanvas, AText), Y + TextHeight(ACanvas,
    AText));
  Result := DrawText(ACanvas, AText, R, 0);
end;

function CurrencyFrameCellWidth(ACanvas: TCanvas): Integer;
var
  I: Integer;
  Tmp: Integer;
begin
  Result := 0;
  for I := 30 to 39 do
  begin
    Tmp := ACanvas.TextWidth(Char(I)) + 2;
    if Result < Tmp then
      Result := Tmp;
  end;
end;

function ChineseCurrencyText(AText: WideString; ACurrencySymbol: WideChar):
  Widestring;
var
  TmpStr: WideString;
  P: PWideChar;
  CurrValue: Currency;
begin
  Result := '';
  if not TryStrToCurr(AText, CurrValue) then
    CurrValue := 0;
  TmpStr := FormatFloat('0.00', Abs(CurrValue));
  P := PWideChar(TmpStr);
  while P^ <> WideChar(#0) do
  begin
    if P^ <> WideChar('.') then
      Result := Result + P^;
    Inc(P);
  end;
  Result := ACurrencySymbol + Result;
end;

procedure DrawCurrencyFrame(ACanvas: TCanvas; ARect: TRect; Value:
  Currency; CurrencySymbol: WideChar; DrawZeroValue: Boolean = False);
const
  //CurrencySymbol = '¥';
  DecimalNumber = 2;
  DigitalNumber = 10;
  DecimalSeparatorColor = clRed;
  KilobitSeparatorColor = clBlack;
  GridLineColor = clMoneyGreen;
  GridLineWidth = 1;
var
  I: Integer;
  RectWidth, RectHeight: Integer;
  CX, CY: Integer;
  LineNum: Integer;
  IsNegative: Boolean; //是否是负数
  AText: WideString;
  CellWidth: Integer;
  CharRect: TRect;
  PCurrentChar: PWideChar;
  OldFontColor: TColor;
  DrawEnd: Boolean;
begin
  OldFontColor := ACanvas.Font.Color;
  //ShowMessage(IntToStr(ACanvas.Font.Size));
  //CellWidth := ACanvas.TextWidth('0') + 2;
  CellWidth := CurrencyFrameCellWidth(ACanvas);
  IsNegative := (Value < 0);
  AText := CurrencySymbol + FormatFloat('0.00', Value);
  RectWidth := ARect.Right - ARect.Left;
  RectHeight := ARect.Bottom - ARect.Top;
  CX := ARect.Right - CellWidth;
  CY := 0;
  LineNum := -2;
  PCurrentChar := @(AText[length(AText)]);
  DrawEnd := False;
  while CX > 0 do
  begin
    Inc(LineNum);
    if (Value <> 0)or(DrawZeroValue) then
    begin
      CharRect := Rect(CX + GridLineWidth, CY, CX + CellWidth, CY + RectHeight);
      if IsNegative then //负数是红色的;正数是黑色的
        ACanvas.Font.Color := clRed
      else
        ACanvas.Font.Color := clBlack;

      if not DrawEnd then
      begin
        DrawTextW(ACanvas.Handle, PCurrentChar, 1, CharRect, DT_SINGLELINE or
          DT_CENTER or DT_VCENTER);
        if PCurrentChar^ = CurrencySymbol then //划到了货币符号以后就不画字符了
          DrawEnd := true;
      end;
    end;
    if LineNum = 0 then
      ACanvas.Pen.Color := DecimalSeparatorColor
    else
      if (LineNum mod 3) = 0 then
        ACanvas.Pen.Color := KilobitSeparatorColor
      else
        ACanvas.Pen.Color := GridLineColor;
    ACanvas.MoveTo(CX, CY);
    ACanvas.LineTo(CX, CY + RectHeight);
    Dec(CX, CellWidth);
    Dec(PCurrentChar);
    if (PCurrentChar^ = Widechar('.'))
      or (PCurrentChar^ = Widechar('-')) then //跳过小数点、负号不画
      Dec(PCurrentChar);
  end;
  ACanvas.Font.Color := OldFontColor;
end;

end.

⌨️ 快捷键说明

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