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

Using variables as variants not workin

您好,我正在构建一个自定义标签,它将接受变体作为输入,而不是一直使用 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.

您的作业

Numlabel1.input := 234.56;

有点武断:它告诉编译器这是一个浮点值,但不完全是哪个。编译器可以 select varSingle、varDouble 或 varCurrency 作为变体类型。对于值 234.56,编译器 selects varCurrency (6),但对于其他值(例如 234.56789),编译器 selects varDouble (5).

如果使用 Double 或 Extended 类型的中间变量,则编译器 selects varDouble(5) 作为变体类型。

因此您要么必须为 varType varDouble 添加一些代码,即

if VarIsType(FInput, 5) = True then { do something }

(如果 VarIsType(FInput, 4) = True 那么可能也适用于 varType varSingle),或者您遵循 Remy 的建议并使用变体的自动类型转换。即

var
  V : Variant;
  S : string;

V := 123.45;
S := V;

正是为此创建了变体,所以请使用它。

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

你走在正确的轨道上,只是稍微偏离了一点。

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

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()

您在代码中遇到的错误是您检查了代表 varCurrency 的变体类型代码 6,但针对 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()