delphi - 使用变量作为变体不起作用

Question

您好，我正在构建一个自定义标签，它将接受变体作为输入，而不是一直使用 StrToInt 和 floatToStrf。如果直接输入标签，下面的代码可以正常工作，即

Numlabel1.input=234.56;

但是当将值分配给变量时

 var
  v : double;

 ...

 v := 234.56;
 numLabel.input := v;

这不起作用

这是我的代码的一部分。谁能指出我正确的方向吗？

procedure TNumLabel.SetInput(Value : Variant);
var
  s:string;
begin
  FInput := Value;
  if VarIsType(FInput,256) = True then s:=FInput;  //string
  if VarIsType(FInput,17) = True then s:=IntToStr(FInput);  //integer
  if VarIsType(FInput,18) = True then s:=IntToStr(FInput);  //word
  if VarIsType(FInput,6) = True then  //double
    begin
      GetDecimals; //get the number of becimal places user has selected
      if FCurrency = True then s := FloatToStrF(FInput,ffCurrency,7,FDecimals) else
      s:= FloatToStrF(FInput,ffNumber,7,FDecimals);
    end;
  if FPrefix<>'' then Caption:=FPrefix; //header
  if s<>Null then Caption:=Caption+s+' ';
  if FSuffix<>'' then if FInput<>Null then Caption:=Caption+FSuffix;
end;

按照要求，完整代码在哪里

unit NumLabel;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, 
     Forms, Graphics, Stdctrls, Variants, Dialogs, StrUtils, ESBRtns;

type
  TNumLabel = class(TLabel)
    private
        FCurrency : Boolean;
        FInput : Variant;
        FDecimals : Integer;
        FPrefix : string;
        FSuffix : string;
        FLayout : TTextLayout;
        procedure AutoInitialize;
        procedure AutoDestroy;
        function GetCurrency : Boolean;
        procedure SetCurrency(Value : Boolean);
        function GetInput : Variant;
        procedure SetInput(Value : Variant);
        function GetPrefix : string;
        procedure SetPrefix(Value : string);
        function GetSuffix : string;
        procedure SetSuffix(Value : string);        
        function GetDecimals : Integer;
        function GetLayout : TTextLayout;
        procedure SetLayout(Value : TTextLayout);
        procedure SetDecimals(Value : Integer);
        procedure WMSize(var Message: TWMSize); message WM_SIZE;

    protected
      { Protected fields of TNumLabel }

      { Protected methods of TNumLabel }
        procedure Click; override;
        procedure Loaded; override;
        procedure Paint; override;

    public
      procedure ChkPrefix(Astr:string);
      { Public fields and properties of TNumLabel }
      { Public methods of TNumLabel }
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

    published
      { Published properties of TNumLabel }
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property Currency : Boolean read GetCurrency write SetCurrency;
        property Prefix : string read GetPrefix write SetPrefix;
        property Suffix : string read GetSuffix write SetSuffix;        
        property Input : Variant read GetInput write SetInput;
        property Decimals : Integer
             read GetDecimals write SetDecimals
             default 2;
        property Layout : TTextLayout read FLayout write FLayout;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TNumLabel]);
end;

procedure TNumLabel.AutoInitialize;
begin
  FDecimals := 2;
end;

procedure TNumLabel.AutoDestroy;
begin
end;

function TNumLabel.GetLayout : TTextLayout;
begin
  Result := GetLayout;
end;

procedure TNumLabel.SetLayout(Value : TTextLayout);
begin
  Layout := Value;
end;

function TNumLabel.GetDecimals : Integer;
begin
  Result := FDecimals;
end;

procedure TNumLabel.SetDecimals(Value : Integer);
begin
  FDecimals := Value;
end;

function TNumLabel.GetCurrency : Boolean;
begin
  Result := FCurrency;
end;

procedure TNumLabel.SetCurrency(Value : Boolean);
begin
  FCurrency := Value;
end;

function TNumLabel.GetPrefix : string;
begin
  ChkPrefix(FPrefix);
  Result := FPrefix;
end;

procedure TNumLabel.SetPrefix(Value : string);
begin
  FPrefix := Value;
  GetInput;
  GetSuffix;
  ChkPrefix(FPrefix);
  if FInput<>Null then Caption:=Caption+FInput+' ';
  if FSuffix<>'' then if FInput<>Null then Caption:=Caption+FSuffix;
  Invalidate;
end;

procedure TNumLabel.ChkPrefix(Astr:string);
begin
  if Astr<>'' then
  begin
    if Layout=tlTop then
      begin
        if Pos(#$D#$A,FPrefix) = 0 then FPrefix:=FPrefix +#$D#$A ;
      end
    else if ((RightStr(FPrefix,1)=' ') and (Layout=tlCenter)) then FPrefix:=FPrefix+' ';
  end;
end;

function TNumLabel.GetSuffix : string;
begin
  Result := FSuffix;
end;

procedure TNumLabel.SetSuffix(Value : string);
begin
  FSuffix :=Value;
  GetPrefix;
  GetInput;
  if FPrefix<>'' then Caption:=FPrefix;
  if FInput<>Null then Caption:=Caption+FInput+' ';
  if FSuffix<>'' then if FInput<>Null then Caption:=Caption+FSuffix;
  Invalidate;
end;

function TNumLabel.GetInput : Variant;
begin
  Result := FInput;
end;

procedure TNumLabel.SetInput(Value : Variant);
 var
   s:string;
begin
  FInput := Value;
  if VarIsType(FInput,256) = True then s:=FInput;
  if VarIsType(FInput,17) = True then s:=IntToStr(FInput);
  if VarIsType(FInput,18) = True then s:=IntToStr(FInput);
  if VarIsType(FInput,6) = True then
    begin
      GetDecimals;
      if FCurrency = True then s := FloatToStrF(FInput,ffCurrency,7,FDecimals) else
      s := FloatToStrF(FInput,ffNumber,7,FDecimals);
    end;
  if FPrefix<>'' then Caption:=FPrefix;
  if s<>Null then Caption:=Caption+s+' ';
  if FSuffix<>'' then if FInput<>Null then Caption:=Caption+FSuffix;
end;

procedure TNumLabel.Click;
begin
  inherited Click;
end;

constructor TNumLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoInitialize;
end;

destructor TNumLabel.Destroy;
begin
  AutoDestroy;
  inherited Destroy;
end;

procedure TNumLabel.Loaded;
begin
  inherited Loaded;
end;

procedure TNumLabel.Paint;
begin
  inherited Paint;
end;

procedure TNumLabel.WMSize(var Message: TWMSize);
var
  W, H: Integer;
begin
  inherited;
  W := Width;
  H := Height;
  if (W <> Width) or (H <> Height) then
  inherited SetBounds(Left, Top, W, H);
  Message.Result := 0;
end;
end.

Answer 1

据我了解，您想要与其他文本连接，否则也要格式化输出，部分根据数字的类型。

你的方向是正确的，只是稍微偏离了一点。

这是我在测试中使用的输入:

procedure TForm5.Button1Click(Sender: TObject);
var
  v: double;
begin
  numlab.Decimals := 3;
  v := 234.56;
  numlab.Input := v;
end;

在 TNumLabel.SetInput(Value: Variant);我做了一些更改以简化。有一些函数(在单元 System.Variants 中)检查类型组，例如 VarIsOrdinal()检查任何序数类型和 VarIsFloat()检查任何浮点类型。

您的代码中出现的错误是您检查了变体类型代码 6，它代表 varCurrency但针对 Double 进行了测试。始终使用文字常量，这样更容易阅读代码并使其正确。

最后，这是修改后的SetInPut()以便您继续:

procedure TNumLabel.SetInput(Value : Variant);
 var
   s:string;
begin
  FInput := Value;

  // check for string type
  if VarIsType(FInput, VarString) then s := FInput  else
  // check for any ordinal type
  if VarIsOrdinal(FInput) then s := IntToStr(FInput) else
  // check for any float type
  if VarIsFloat(FInput) then s := FloatToStrF(FInput, ffNumber, 7, FDecimals) else
  // none of those
  s := 'Unknown';

//  if VarIsType(FInput,256) = True then s:=FInput;
//  if VarIsType(FInput,17) = True then s:=IntToStr(FInput);
//  if VarIsType(FInput,18) = True then s:=IntToStr(FInput);
//  if VarIsType(FInput,6) = True then
//    begin
//      GetDecimals;
//      if FCurrency = True then s := FloatToStrF(FInput,ffCurrency,7,FDecimals) else
//      s := FloatToStrF(FInput,ffNumber,7,FDecimals);
//    end;

  if FPrefix<>'' then Caption:=FPrefix;
  if s <> '' then Caption:=Caption+s+' ';
  if FSuffix<>'' then if FInput<>Null then Caption:=Caption+FSuffix;
end;

顺便说一句，如果您想显示也按照 FDecimals 格式化为小数的整数设置后，可以喂FInput (具有整数值)到 FloatToStr() .