⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tmsxlsmessages.pas

📁 TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  xlr_ChartClrClient             = $105C;
  xlr_ChartSerfmt                = $105D;
  xlr_Chart3DDataFormat          = $105F;
  xlr_ChartFbi                   = $1060;
  xlr_ChartBoppop                = $1061;
  xlr_ChartAxcext                = $1062;
  xlr_ChartDat                   = $1063;
  xlr_ChartPlotgrowth            = $1064;
  xlr_ChartSiindex               = $1065;
  xlr_ChartGelframe              = $1066;
  xlr_ChartBoppcustom            = $1067;

//------------------------------------Tokens-------------------------//
    //Globals
    tk_Arrayformula     = $1;
    tk_Table     = $2;
    tk_BinaryOps = [$3..$11];
    tk_UnaryOps  = [$12..$15];

    //Constants
    tk_MissArg   = $16;
    tk_Str       = $17;
    tk_Attr      = $19;
    tk_Err       = $1C;
    tk_Bool      = $1D;
    tk_Int       = $1E;
    tk_Num       = $1F;

    tk_MemFunc   = $29; 

    //Func
    tk_Func      = [$21, $41, $61];
    tk_FuncVar   = [$22, $42, $62];

    //Operand
    tk_Array     = [$20, $40, $60];
    tk_Name      = [$23, $43, $63];
    tk_Ref       = [$24, $44, $64];
    tk_Area      = [$25, $45, $65];
    tk_RefErr    = [$2A, $4A, $6A];
    tk_AreaErr   = [$2B, $4B, $6B];
    tk_RefN      = [$2C, $4C, $6C];  //Reference relative to the current row. Can be < 0
    tk_AreaN     = [$2D, $4D, $6D];  //Area relative to the current row
    tk_NameX     = [$39, $59, $79];
    tk_Ref3D     = [$3A, $5A, $7A];
    tk_Area3D    = [$3B, $5B, $7B];
    tk_Ref3DErr  = [$3C, $5C, $7C];
    tk_Area3DErr = [$3D, $5D, $7D];

    tk_RefToRefErr         = $2A - $24;
    tk_AreaToAreaErr       = $2B - $25;
    tk_Ref3DToRef3DErr     = $3C - $3A;
    tk_Area3DToArea3DErr   = $3D - $3B;

    tk_Operand=
        tk_Array+
        tk_Name+
        tk_Ref+
        tk_Area+
        tk_RefErr+
        tk_AreaErr+
        tk_RefN+
        tk_AreaN+
        tk_NameX+
        tk_Ref3D+
        tk_Area3D+
        tk_Ref3DErr+
        tk_Area3DErr;

//-------------------------------------Object Types--------------------------//
		ftEnd	       = $0000;
		ftMacro	     = $0004;
		ftButton     = $0005;
		ftGmo	       = $0006;
		ftCf	       = $0007;
		ftPioGrbit	 = $0008;
    ftPictFmla	 = $0009;
		ftCbls	     = $000A;
		ftRbo	       = $000B;
		ftSbs	       = $000C;
		ftNts	       = $000D;
		ftSbsFmla	   = $000E;
		ftGboData	   = $000F;
    ftEdoData	   = $0010;
		ftRboData	   = $0011;
		ftCblsData	 = $0012;
		ftLbsData	   = $0013;
		ftCblsFmla	 = $0014;
		ftCmo	       = $0015;

//-------------------------------------Cmo Object Types-----------------------//

		xlcmo_Group   	      = $00;
		xlcmo_Line  		      = $01;
		xlcmo_Rectangle  	    = $02;
		xlcmo_Oval  		      = $03;
		xlcmo_Arc  		        = $04;
		xlcmo_Chart  	        = $05;
		xlcmo_TextBox  	      = $06;
		xlcmo_Button  	      = $07;
		xlcmo_Picture  	      = $08;
		xlcmo_Polygon  	      = $09;
		xlcmo_CheckBox  	    = $0B;
		xlcmo_Option  	      = $0C;
		xlcmo_Edit  		      = $0D;
		xlcmo_Label         	= $0E;
		xlcmo_Dialog  	      = $0F;
		xlcmo_Spinner  	      = $10;
		xlcmo_Scroll  	      = $11;
		xlcmo_List  		      = $12;
		xlcmo_Group1         	= $13;
		xlcmo_Combo         	= $14;
		xlcmo_Comment  	      = $19;
		xlcmo_MSDrawingx    	= $1E;

// Escher records
    MsofbtDggContainer             = $F000;
    MsofbtDgg                      = $F006;
    MsofbtCLSID                    = $F016;
    MsofbtOPT                      = $F00B;
    MsofbtColorMRU                 = $F11A;
    MsofbtSplitMenuColors          = $F11E;
    MsofbtBstoreContainer          = $F001;
    MsofbtBSE                      = $F007;
    MsofbtDgContainer              = $F002;
    MsofbtDg                       = $F008;
    MsofbtRegroupItem              = $F118;
    MsofbtColorScheme              = $F120;
    MsofbtSpgrContainer            = $F003;
    MsofbtSpContainer              = $F004;
    MsofbtSpgr                     = $F009;
    MsofbtSp                       = $F00A;
    MsofbtTextbox                  = $F00C;
    MsofbtClientTextbox            = $F00D;
    MsofbtAnchor                   = $F00E;
    MsofbtChildAnchor              = $F00F;
    MsofbtClientAnchor             = $F010;
    MsofbtClientData               = $F011;
    MsofbtOleObject                = $F11F;
    MsofbtDeletedPspl              = $F11D;
    MsofbtSolverContainer          = $F005;
    MsofbtConnectorRule            = $F012;
    MsofbtAlignRule                = $F013;
    MsofbtArcRule                  = $F014;
    MsofbtClientRule               = $F015;
    MsofbtCalloutRule              = $F017;
    MsofbtSelection                = $F119;

    //Image types
     msobiUNKNOWN = 0;
     msobiWMF  = $216;      // Metafile header then compressed WMF
     msobiEMF  = $3D4;      // Metafile header then compressed EMF
     msobiPICT = $542;      // Metafile header then compressed PICT
     msobiPNG  = $6E0;      // One byte tag then PNG data
     msobiJFIF = $46A;      // One byte tag then JFIF data
     msobiJPEG = msobiJFIF;
     msobiDIB  = $7A8;      // One byte tag then DIB data
     msobiClient=$800;      // Clients should set this bit

     msoblipERROR   = 0;        // An error occured during loading
     msoblipUNKNOWN = 1;        // An unknown blip type
     msoblipEMF     = 2;        // Windows Enhanced Metafile
     msoblipWMF     = 3;        // Windows Metafile
     msoblipPICT    = 4;        // Macintosh PICT
     msoblipJPEG    = 5;        // JFIF
     msoblipPNG     = 6;        // PNG
     msoblipDIB     = 7;        // Windows DIB


     XlsImgConv: array[TXlsImgTypes] of byte = (msoblipEMF, msoblipWMF, msoblipJPEG, msoblipPNG, msoblipDIB, msoblipUNKNOWN);
     XlsBlipHeaderConv: array[TXlsImgTypes] of Word=($F01A, $F01B, $F01D, $F01E, $F01F, $F01A-1);
     XlsBlipSignConv: array[TXlsImgTypes] of Word=(msobiEMF, msobiWMF, msobiJPEG, msobiPNG, msobiDIB, msobiUNKNOWN);

  procedure IncMax(var X: word ; N, Max: Longint );
  procedure IncMaxMin(var X: word ; N, Max,  Min: Longint );

  procedure IncByte( const Pdata: PArrayOfByte; const tPos: integer; const Offset: integer; const Max: integer);
  procedure IncWord( const Pdata: PArrayOfByte; const tPos: integer; const Offset: integer; const Max: integer); 
  function GetWord(const Pdata: PArrayOfByte; const tPos: integer): word;
  procedure SetWord(const Pdata: PArrayOfByte; const tPos: integer; const number: Word); 
  procedure IncLongWord( const Pdata: PArrayOfByte; const tPos: integer; const Offset: int64);
  function GetLongWord(const Pdata: PArrayOfByte; const tPos: integer): LongWord;
  procedure SetLongWord(const Pdata: PArrayOfByte; const tPos: integer; const number: LongWord); 

  //These functions do not take Continue records. use them with care, only where we are sure we don't have continues
  function GetStrLen(const Length16Bit: boolean ;const Pdata: PArrayOfByte; const tPos: integer; const UseExtStrLen: boolean; const ExtStrLen: LongWord): int64;
  procedure GetSimpleString(const Length16Bit: boolean ;const Pdata: PArrayOfByte; const tPos: integer;const UseExtStrLen: boolean; const ExtStrLen: LongWord; var St: UTF16String; var StSize: integer);

  function IsWide(const W: UTF16String): boolean;
  function WideStringToStringNoCodePage(const W: UTF16String): AnsiString;
  function StringToWideStringNoCodePage(const s: AnsiString): UTF16String;
  procedure CompressBestUnicode(const w: UTF16String; const PData: PArrayOfByte; const PDataPos: integer);

type
  pWord=^Word;
  pLongWord=^LongWord;


implementation

procedure IncWord( const Pdata: PArrayOfByte; const tPos: integer; const Offset: integer; const Max: integer);
var
  w: int64;
begin
  w:=Pdata^[tPos] or (PData^[tPos+1] shl 8);
  inc(w, Offset);
  if (w<0) or (w>Max) then Raise Exception.CreateFmt(ErrTooManyEntries,[w, Max]);

  Pdata^[tPos]:= byte(w);
  Pdata^[tPos+1]:= hi(word(w));
end;

procedure IncByte( const Pdata: PArrayOfByte; const tPos: integer; const Offset: integer; const Max: integer);
var
  w: int64;
begin
  w:=Pdata^[tPos];
  inc(w, Offset);
  if (w<0) or (w>Max) then Raise Exception.CreateFmt(ErrTooManyEntries,[w, Max]);
  Pdata^[tPos]:= byte(w);
end;


procedure IncMax(var X: word ; N, Max: Longint );
begin
  if (N+X>Max) or (N+X<0) then Raise Exception.CreateFmt(ErrTooManyEntries,[N+X, Max]);
  Inc(X,N);
end;

procedure IncLongWord( const Pdata: PArrayOfByte; const tPos: integer; const Offset: int64);
var
  Pc: ^LongWord;
begin
  Pc:= @PData[tPos];
  Inc(Pc^,Offset);
end;

procedure IncMaxMin(var X: word ; N, Max, Min: Longint );
begin
  if (N+X>Max) then X:=Max else if N+X<Min then X:=Min else Inc(X,N);
end;


function GetWord(const Pdata: PArrayOfByte; const tPos: integer): word;
begin
  Result:=pWord(PAddress(Pdata)+tPos)^;
end;

function GetLongWord(const Pdata: PArrayOfByte; const tPos: integer): LongWord;
begin
  result:=PLongWord(PAddress(Pdata)+tPos)^;
end;

procedure SetLongWord(const Pdata: PArrayOfByte; const tPos: integer; const number: LongWord);
begin
  System.Move(Number, Pdata^[tPos], sizeof(LongWord))
end;

procedure SetWord(const Pdata: PArrayOfByte; const tPos: integer; const number: Word);
begin
  System.Move(Number, Pdata^[tPos], sizeof(Word))
end;

function GetStrLen(const Length16Bit: boolean ;const Pdata: PArrayOfByte; const tPos: integer;const UseExtStrLen: boolean; const ExtStrLen: LongWord): int64;
var
  l, rt: LongWord;
  bsize: byte;
  sz: LongWord;
  myPos: integer;
  oField: byte;
begin
  myPos:=tPos;
  if UseExtStrLen then l:= ExtStrLen
  else
  begin
    if Length16Bit then begin;l:=GetWord( Pdata, myPos);inc(myPos,2);end
    else begin;l:=Pdata^[myPos];inc(myPos);end;
  end;

  oField:= Pdata^[myPos];
  inc(myPos);

  bsize:= oField and $1;

  rt:=0;
  if (oField and $8)= $8 then //RTF Info
  begin
    rt:=GetWord( Pdata, myPos);
    inc(myPos, 2);
  end;

  sz:=0;
  if (oField and $4)= $4 then //Far East Info
  begin
    sz:= GetLongWord( Pdata, myPos);
    inc(myPos, 4);
  end;

  Result:=int64(myPos-tPos) + l shl bsize+ rt shl 2 + sz;

end;

procedure GetSimpleString(const Length16Bit: boolean ;const Pdata: PArrayOfByte; const tPos: integer;const UseExtStrLen: boolean; const ExtStrLen: LongWord; var St: UTF16String; var StSize: integer);
var
  l, rt: LongWord;
  bsize: byte;
  sz: LongWord;
  myPos: integer;
  oField: byte;
  ShortSt: AnsiString;
begin
  myPos:=tPos;
  if UseExtStrLen then l:= ExtStrLen
  else
  begin
    if Length16Bit then begin;l:=GetWord( Pdata, myPos);inc(myPos,2);end
    else begin;l:=Pdata^[myPos];inc(myPos);end;
  end;

  oField:= Pdata^[myPos];
  inc(myPos);

  bsize:= oField and $1;

  rt:=0;
  if (oField and $8)= $8 then //RTF Info
  begin
    rt:=GetWord( Pdata, myPos);
    inc(myPos, 2);
  end;

  sz:=0;
  if (oField and $4)= $4 then //Far East Info
  begin
    sz:= GetLongWord( Pdata, myPos);
    inc(myPos, 4);
  end;

  StSize:=int64(myPos-tPos) + l shl bsize+ rt shl 2 + sz;
  if bsize=0 then
  begin
    SetLength(ShortSt, l);
    Move(pData^[myPos], ShortSt[1], l);
    St:=StringToWideStringNoCodePage(ShortSt);
  end else
  begin
    SetLength(St, l);
    Move(pData^[myPos], St[1], l shl bsize);
  end;

end;

function IsWide(const W: UTF16String): boolean;
var
  i:integer;
begin
  for i:=1 to length(w) do if ord(w[i])>$FF then begin;Result:=true;exit;end;
  Result:=false;
end;

function WideStringToStringNoCodePage(const W: UTF16String): AnsiString;
var
  i:integer;
begin
  SetLength(Result, Length(W));
  for i:=1 to length(w) do Result[i]:=AnsiChar(Ord(w[i]) and $FF);
end;

procedure CompressBestUnicode(const w: UTF16String; const PData: PArrayOfByte; const PDataPos: integer);
var
  i:integer;
begin
  for i:=1 to length(w) do
    if Ord(w[i])<=$FF then PData[PDataPos+i-1]:=Ord(w[i]) else PData[PDataPos+i-1]:=Ord('?');
end;

function StringToWideStringNoCodePage(const s: AnsiString): UTF16String;
var
  i:integer;
begin
  SetLength(Result, Length(s));
  for i:=1 to length(s) do Result[i]:=UTF16Char(Ord(s[i]));
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -