uflxmessages.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 384 行

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

interface
uses {$IFDEF FLX_VCL} Windows, {$ENDIF}
     {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants, varutils, {$IFEND}{$ENDIF} //Delphi 6 or above
     {$IFNDEF ConditionalExpressions}ActiveX,{$ENDIF} //Delphi 5
     Classes, SysUtils;

const
  FLX_VAR_LOCALE_USER_DEFAULT = $400;

resourcestring
  FieldStr='##';
  DataSetStr='__';
  VarStr='#.';

  StrOpen='<';
  StrClose='>';


  ExtrasDelim='...';
  MarkedRowStr='...delete row...';  //Remember to change ExtrasDelim if changing this
  HPageBreakStr='...page break...'; //Remember to change ExtrasDelim if changing this
  FullDataSetStr='*';
  MainTxt='MAIN'; //This is not strictly necessary... just for checking the template
  RecordCountPrefix='RC_';

  DefaultDateTimeFormat='mm/dd/yyyy hh:mm';

  FlexCelVersion='2.6.10';
{$IFDEF SPANISH}
  {$INCLUDE FlxSpanish.inc}
{$ELSE}
{$IFDEF FRENCH}
  {$INCLUDE FlxFrench.inc}
{$ELSE}
{$IFDEF ITALIAN}
  {$INCLUDE FlxItalian.inc}
{$ELSE}
{$IFDEF ROMANIAN}
  {$INCLUDE FlxRomanian.inc}
{$ELSE}
{$IFDEF PORTUGUESEBR}
  {$INCLUDE FlxPortugueseBR.inc}
{$ELSE}
{$IFDEF CHINESE}
  {$INCLUDE FlxChinese.inc}
{$ELSE}
{$IFDEF RUSSIAN}
  {$INCLUDE FlxRussian.inc}
{$ELSE}
{$IFDEF GERMAN}
  {$INCLUDE FlxGerman.inc}
{$ELSE}
{$IFDEF POLISH}
  {$INCLUDE FlxPolish.inc}
{$ELSE}
{$IFDEF FINNISH}
  {$INCLUDE XlsFinnish.inc}
{$ELSE}
  {$INCLUDE FlxEnglish.inc}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}

  xls_Emf='EMF';
  xls_Wmf='WMF';
  xls_Jpeg='JPEG';
  xls_Png='PNG';

  FlexCelTempPrefix = 'flx';

type
  TClientAnchor= packed record
    Flag,
    Col1, Dx1, Row1, Dy1,
    Col2, Dx2, Row2, Dy2: word;
  end;
  PClientAnchor = ^TClientAnchor;

  WidestringArray=array of widestring;

const
  DefColWidthAdapt: integer=Round(256*8/7);  //font used here is 8 pixels wide, not 7

  //Printer Options
  fpo_LeftToRight = $01;  //Print over, then down
  fpo_Orientation = $02;  //0= landscape, 1=portrait
  fpo_NoPls       = $04;  //if 1, then PaperSize, Scale, Res, VRes, Copies, and Landscape data have not been obtained from the printer, so they are not valid.
  fpo_NoColor     = $08;  //1= Black and white
  fpo_Draft       = $10;  //1= Draft quality
  fpo_Notes       = $20;  //1= Print Notes
  fpo_NoOrient    = $40;  //1=orientation not set
  fpo_UsePage     = $80;  //1=use custom starting page number.

var
  ColMult:extended=256/7; //36.6;
  RowMult:extended=15;


type
  TColorPaletteRange=1..56;

  TXlsCellRange=record
    Left, Top, Right, Bottom: integer;
  end;

  TXlsMargins=packed record  //C++ builder gets this struct wrong if we use a normal record.
    Left, Top, Right, Bottom: extended;
    Header, Footer: extended;
  end;

  TXlsSheetVisible=
    (sv_Visible, sv_Hidden, sv_VeryHidden);

  TRTFRun= record
    FirstChar: word;
    FontIndex: word;
  end;

  TRTFRunList= array of TRTFRun;

  TRichString= record
    Value: widestring;
    RTFRuns: TRTFRunList;
  end;

  THyperLinkType=
    (hl_URL, hl_LocalFile, hl_UNC, hl_CurrentWorkbook);

  THyperLink= record
    LinkType: THyperLinkType;
    Description: widestring;
    TargetFrame: widestring;
    TextMark: widestring;
    Text: widestring;
    Hint: widestring;
  end;


type
  TOnGetFileNameEvent  = procedure (Sender: TObject; const  FileFormat: integer; var Filename: TFileName) of object;
  TOnGetOutStreamEvent = procedure (Sender: TObject; const  FileFormat: integer; var OutStream: TStream) of object;

  TXlsImgTypes = (xli_Emf, xli_Wmf, xli_Jpeg, xli_Png, xli_Bmp, xli_Unknown);

  VariantArray=Array [0..maxint div sizeof(Variant)-1]of variant;
  ArrayOfVariant=Array of Variant;

  TXlsCellValue= record
    Value: variant;
    XF: integer;
    IsFormula: boolean;
  end;

  TFlxAnchorType=(at_MoveAndResize, at_MoveAndDontResize, at_DontMoveAndDontResize);

  TImageProperties=record
    Col1, dx1, Row1, dy1, Col2, dx2, Row2, dy2:integer;
    FileName: widestring;  //Not really needed to set.
  end;


  function SearchPathStr(const AFileName: String): String;
  {$IFDEF  VER130}
  function IncludeTrailingPathDelimiter(const S: string): string;
  function VarIsClear(const v: variant): boolean;
  {$ENDIF}

  function StringReplaceSkipQuotes(const S, OldPattern, NewPattern: widestring): widestring;
  function FlxTryStrToDateTime(const S: widestring; out Value: TDateTime; var dFormat: widestring; var HasDate, HasTime: boolean; const DateFormat: widestring=''; const TimeFormat: widestring=''): Boolean;

  function OffsetRange(const CellRange: TXlsCellRange; const DeltaRow, DeltaCol: integer): TXlsCellRange;

  //Returns "A" for column 1, "B"  for 2 and so on
  function EncodeColumn(const C: integer): string;

implementation

function EncodeColumn(const C: integer): string;
var
  Delta: integer;
begin
  Delta:=Ord('Z')-Ord('A')+1;
  if C<=Delta then Result:=chr(Ord('A')+C-1) else
    Result:=EncodeColumn(((C-1) div Delta))+ chr(Ord('A')+(C-1) mod Delta);
end;

{$IFDEF FLX_VCL}
function SearchPathStr(const AFileName: String): String;
var
  FilePart: PChar;
begin
  SetLength(Result, MAX_PATH + 1);

  if SearchPath(nil, PChar(AFileName), '.xls',
                MAX_PATH, PChar(Result), FilePart) <> 0 then
  begin
    SetLength(Result, Length(PChar(Result)));
  end
  else
    Raise Exception.CreateFmt(ErrCantFindFile,[AFileName]);
end; // SearchRecStr
{$ELSE}
function SearchPathStr(const AFileName: String): String;
begin
  //We dont search for templates in linux
  if not FileExists(AFileName) then Raise Exception.CreateFmt(ErrCantFindFile,[AFileName]);
  Result:=AFileName;
end; // SearchRecStr
{$ENDIF}

{$IFDEF  VER130}
function IncludeTrailingPathDelimiter(const S: string): string;
begin
  Result:=IncludeTrailingBackslash(s);
end;

function VarIsClear(const v: variant): boolean;
begin
  Result:=VarIsNull(v);
end;
{$ENDIF}

//Defined as there is not posex on d5
function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
var
  i,k: integer;
  Equal: boolean;
begin
  i:= Offset;
  Result:=-1;

  while i<=Length(s)-Length(SubStr)+1 do
  begin
    if s[i]=Substr[1] then
    begin
      Equal:=true;
      for k:=2 to Length(Substr) do if s[i+k-1]<>Substr[k] then
      begin
        Equal:=false;
        break;
      end;
      if Equal then
      begin
        Result:=i;
        exit;
      end;
    end;
    inc(i);
  end;
end;
function StringReplaceSkipQuotes(const S, OldPattern, NewPattern: widestring): widestring;
var
  SearchStr, Patt: widestring;
  i,k,z: Integer;
  InQuote: boolean;
begin
  SearchStr := UpperCase(S);
  Patt := UpperCase(OldPattern);

  SetLength(Result, Length(SearchStr)*2);
  InQuote:=false;

  i:=1;k:=1;
  while i<= Length(SearchStr) do
  begin
    if SearchStr[i]='"' then InQuote:= not InQuote;
    if not InQuote and (PosEx(Patt,SearchStr,i)=i) then
    begin
       if k+Length(NewPattern)-1>Length(Result) then SetLength(Result, k+Length(NewPattern)+100);
     for z:=1 to Length(NewPattern) do Result[z+k-1]:=NewPattern[z];
      inc(k, Length(NewPattern));
      inc(i, Length(Patt));
    end else
    begin
      if k>Length(Result) then SetLength(Result, k+100);
      Result[k]:=s[i];
      inc(i);
      inc(k);
    end;
  end;

  SetLength(Result, k-1);
end;


function DateIsOk(s: string; const v: TDateTime): boolean;
  //We have an issue with a string like '1.2.3'
  //If we are using german date separator (".") it will be converted to
  //Feb 1, 2003, which is ok. But, if we use another format, windows will think it
  //is a time, and will convert it to 1:02:03 am. That's why we added this 'patch' function.
var
  p: integer;
  i, err, k: integer;
begin
  Result:= true;
  if (Trunc(v)<>0) then exit;
  s:=s+'.';
  for i:=1 to 3 do
  begin
    p:= pos('.',s);
    if p<=0 then
    begin
      if i=3 then Result:=false;
      exit;
    end;
    val(copy(s,1,p-1), k, err);
    if (err<>0) or (k<0) then exit;
    s:=copy(s,p+1,Length(s));
  end;
  if trim(s)<'' then exit;
  Result:=false;
end;

function FlxTryStrToDateTime(const s:widestring; out Value: TDateTime; var dFormat: Widestring; var HasDate, HasTime: boolean; const DateFormat: widestring=''; const TimeFormat: widestring=''): Boolean;
var
  LResult: HResult;
  aDateFormat, aTimeFormat: widestring;
  {$IFNDEF ConditionalExpressions} //Delphi 5
    v1: olevariant;
  {$ENDIF}
begin
  if DateFormat='' then aDateFormat:=ShortDateFormat else aDateFormat:=DateFormat;
  if TimeFormat='' then aTimeFormat:=ShortTimeFormat else aTimeFormat:=TimeFormat;
  aTimeFormat:=StringReplaceSkipQuotes(aTimeFormat,'AMPM','AM/PM'); //Format AMPM is not recognized by Excel. This is harcoded on sysutils
  {$IFNDEF ConditionalExpressions} //Delphi 5. Doesn't work on kylix
    LResult:=VariantChangeType(v1, s, 0, varDate);
    Value:=v1;
  {$ELSE}
    //////////////////////READ THIS!////////////////////////////////////////////////////////////////////////////////////////
    // If you get an error here with Delphi 6, make sure to install ALL latest Delphi 6 update packs, including RTL3 update
    ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    // available from www.borland.com
    LResult := VarDateFromStr(S, FLX_VAR_LOCALE_USER_DEFAULT, 0, Value);
  {$ENDIF}

  Result:=(LResult = 0) and DateIsOk(s,Value);  //VAR_OK doesnt work on D5;

  //We have a problem with the german date separator "." and a.m. or p.m.
  //so we cant just test for a "." inside a formula to know it includes a date.
  HasDate:=(pos('.', s)>0) or (pos('/',s)>0) or (pos('-',s)>0)   //hate to hard-code this values, but I see not other viable way
          or (pos(DateSeparator, s)>0);
  HasDate:= HasDate and (Trunc(Value)>0);
  HasTime:=(pos(':',s)>0) or (pos(TimeSeparator, s)>0);    //Again... hard-coding :-( At least is isolated here

  if not HasDate and not HasTime then Result:=false;  //Things like "1A" are converted to times, even when it doesn't make sense.
  dFormat:='';
  if HasDate then dFormat:=dFormat+aDateFormat;
  if HasTime then
  begin
    if dFormat<>'' then dFormat:=dFormat+' ';
    dFormat:=dFormat+aTimeFormat;
  end;

end;

function OffsetRange(const CellRange: TXlsCellRange; const DeltaRow, DeltaCol: integer): TXlsCellRange;
begin
  Result:=CellRange;
  inc(Result.Top, DeltaRow);
  inc(Result.Left, DeltaCol);
  inc(Result.Bottom, DeltaRow);
  inc(Result.Right, DeltaCol);
end;

end.