uflxnumberformat.pas

TMS Component Pack Pro v4.2

unit UFlxNumberFormat;
{$IFDEF LINUX}{$INCLUDE ../FLXCOMPILER.INC}{$ELSE}{$INCLUDE ..\FLXCOMPILER.INC}{$ENDIF}

interface
uses SysUtils,
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
     UFlxMessages, Math;

  function XlsFormatValue(const V: variant; const Format: Widestring; var Color: Integer): Widestring;
  function HasXlsDateTime(const Format: Widestring; var HasDate, HasTime: boolean): boolean;
/////////////////////////////////////////////////////////////////////////////////
implementation

function FindFrom(const wc: WideChar; const w: WideString; const p: integer): integer;
begin
  Result:=pos(wc, copy(w, p, Length(w)))
end;

function Section(const Index: byte; const Format: Widestring; var SectionExists: boolean):Widestring;
//split the 4 sections of a format string
var
  i: integer;
  aPos, TotalPos: integer;
begin
  aPos:=1; TotalPos:=1;
  for i:=0 to Index-1 do
    if aPos>0 then
    begin
      aPos:=FindFrom(';',Format, TotalPos);
      inc(TotalPos, aPos);
    end;

  SectionExists:=aPos>0;
  if not SectionExists then TotalPos:=1;
  Result:=copy(Format,TotalPos, FindFrom(';',Format+';', TotalPos)-1);
end;

//we include this so we don't need to use graphics
const
  clBlack = $000000;
  clGreen = $008000;
  clRed = $0000FF;
  clYellow = $00FFFF;
  clBlue = $FF0000;
  clFuchsia = $FF00FF;
  clAqua = $FFFF00;
  clWhite = $FFFFFF;


procedure CheckColor(const Format: Widestring; var Color: integer; var p: integer);
var
  s: string;
  IgnoreIt: boolean;
begin
  p:=1;
  if (Length(Format)>0) and (Format[1]='[') and (pos(']', Format)>0) then
  begin
    IgnoreIt:=false;
    s:=copy(Format,2,pos(']', Format)-2);
    if s = 'Black'  then Color:=clBlack else
    if s = 'Cyan'   then Color:=clAqua else
    if s = 'Blue'   then Color:=clBlue else
    if s = 'Green'  then Color:=clGreen else
    if s = 'Magenta'then Color:=clFuchsia else
    if s = 'Red'    then Color:=clRed else
    if s = 'White'  then Color:=clWhite else
    if s = 'Yellow' then Color:=clYellow
    else IgnoreIt:=true;

    if not IgnoreIt then p:= Pos(']', Format)+1;
  end;
end;

procedure CheckOptional(const V: Variant; const Format: widestring; var p: integer; var TextOut: widestring);
var
  p2, p3: integer;
begin
  if p>Length(Format) then exit;
  if Format[p]='[' then
  begin
    p2:=FindFrom(']', Format, p);
    if (p<Length(Format))and(Format[p+1]='$') then //currency
    begin
      p3:=FindFrom('-', Format+'-', p);
      TextOut:=TextOut + copy(Format, p+2, min(p2,p3)-3);
    end;
    Inc(p, p2);
  end;
end;

procedure CheckLiteral(const V: Variant; const Format: widestring; var p: integer; var TextOut: widestring);
begin
  if p>Length(Format) then exit;
  if (ord(Format[p])<255) and (char(Format[p]) in[' ','$','(',')','!','^','&','''','