Using variables as variants not workin

Question

Hi I am building a custom label that will accept variants as input rather than using StrToInt and floatToStrf all the time. The code below works fine if the label input is direct ie

Numlabel1.input=234.56;

but when the value is assigned to a variable

 var
  v : double;

 ...

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

It does not work

Here is part of my code. Can anyone point me in the right direction please?

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;

As requested where is the whole code

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.

user_11817780 · Answer

Your assigment

Numlabel1.input := 234.56;

is somewhat arbitrary: It tells the compiler, that this is a floating point value, but not exactly which one. The compiler could select varSingle, varDouble or varCurrency as variant type. For the value 234.56 the compiler selects varCurrency (6), but for other values (for example 234.56789) the compiler selects varDouble (5).

If you use an intermediate variable of type Double or Extended, then the compiler selects varDouble (5) as variant type.

Therefore you either have to add some code for varType varDouble, i.e.

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

(and probably also for varType varSingle if VarIsType(FInput, 4) = True then), or you follow the advice of Remy and use the automatic type conversion of variants. i.e.

var
  V : Variant;
  S : string;

V := 123.45;
S := V;

Variants were created exactly for this, so use it.

user_2292722 · Answer

As I understand it, you want to concatenate with other text, and otherwise too, format the output, partly according to the type of the number.

You were on the right track, just slightly off.

This is the input I used in my testing:

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

In TNumLabel.SetInput(Value: Variant); I made a few changes to simplify. There are functions (in unit System.Variants) that check the group of type, like VarIsOrdinal() that checks for any ordinal type and VarIsFloat() that checks for any floating point type.

The error you had in your code was that you checked for variant type code 6 which stands for varCurrency but tested it against a Double. Always use literal constants, it is much more easy to read the code, and to get it right.

Finally, here's the modified SetInPut() for you to continue on:

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;

By the way, if you want to show integers also formatted with decimals according to the FDecimals setting, you can feed FInput (with an integer value) to FloatToStr().

Using variables as variants not workin

2 Answers