home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / libraries / translib / ifpstrans.pas
Pascal/Delphi Source File  |  2001-05-07  |  6KB  |  158 lines
  1. unit ifpstrans;
  2. {
  3.   Innerfuse Pascal Script Trans library
  4.   For license see Innerfuse Pascal Script license file
  5.  
  6. }
  7.  
  8. interface
  9.  
  10. uses
  11.   ifspas, ifs_var, ifs_utl;
  12.  
  13. procedure RegisterTransLibrary(p: TIfPasScript);
  14. {
  15. function TransformExtendedToString(E: Extended): string;
  16. function TransformDoubleToString(E: Double): string;
  17. function TransformSingleToString(E: Single): string;
  18. function TransformIntegertoString(E: Longint): string;
  19. function TransformSmallInttoString(E: SmallInt): string;
  20. function TransformBytetoString(E: Byte): string;
  21. function TransformShortIntToString(E: ShortInt): string;
  22. function TransformWordtoString(E: Word): string;
  23.  
  24. function TransformStringToExtended(E: String): Extended;
  25. function TransformStringToDouble(E: String): Double;
  26. function TransformStringToSingle(E: String): Single;
  27. function TransformStringToInteger(E: String): Longint;
  28. function TransformStringToSmallInt(E: String): SmallInt;
  29. function TransformStringToByte(E: String): Byte;
  30. function TransformStringToShortInt(E: String): ShortInt;
  31. function TransformStringToWord(E: String): word;
  32. }
  33.  
  34. implementation
  35.  
  36.  
  37. function TransformFunc(Sender: TIfPasScript; ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  38. var
  39.   s: string;
  40. begin
  41.   TransformFunc := ENoError;
  42.   if Proc^.Name = 'TRANSFORMEXTENDEDTOSTRING' then begin
  43.     SetLength(s, sizeof(Extended));
  44.     Move(VM_Get(Params,0)^.CV_Extended, s[1], Sizeof(Extended));
  45.     SetString(res, s);
  46.   end else
  47.   if Proc^.Name = 'TRANSFORMDOUBLETOSTRING' then begin
  48.     SetLength(s, sizeof(Double));
  49.     Move(VM_Get(Params,0)^.CV_Double, s[1], Sizeof(Double));
  50.     SetString(res, s);
  51.   end else
  52.   if Proc^.Name = 'TRANSFORMSINGLETOSTRING' then begin
  53.     SetLength(s, sizeof(Single));
  54.     Move(VM_Get(Params,0)^.CV_Single, s[1], Sizeof(Single));
  55.     SetString(res, s);
  56.   end else
  57.   if Proc^.Name = 'TRANSFORMINTEGERTOSTRING' then begin
  58.     SetLength(s, sizeof(Longint));
  59.     Move(VM_Get(Params,0)^.CV_SInt32, s[1], Sizeof(Longint));
  60.     SetString(res, s);
  61.   end else
  62.   if Proc^.Name = 'TRANSFORMSMALLINTTOSTRING' then begin
  63.     SetLength(s, sizeof(SmallInt));
  64.     Move(VM_Get(Params,0)^.CV_SInt16, s[1], Sizeof(SmallInt));
  65.     SetString(res, s);
  66.   end else
  67.   if Proc^.Name = 'TRANSFORMBYTETOSTRING' then begin
  68.     SetLength(s, sizeof(Byte));
  69.     Move(VM_Get(Params,0)^.CV_UByte, s[1], Sizeof(Byte));
  70.     SetString(res, s);
  71.   end else
  72.   if Proc^.Name = 'TRANSFORMSHORTINTTOSTRING' then begin
  73.     SetLength(s, sizeof(ShortInt));
  74.     Move(VM_Get(Params,0)^.CV_SByte, s[1], Sizeof(ShortInt));
  75.     SetString(res, s);
  76.   end else
  77.   if Proc^.Name = 'TRANSFORMWORDTOSTRING' then begin
  78.     SetLength(s, sizeof(Word));
  79.     Move(VM_Get(Params,0)^.CV_Uint16, s[1], Sizeof(Word));
  80.     SetString(res, s);
  81.   end else
  82.   if Proc^.Name = 'TRANSFORMSTRINGTOEXTENDED' then begin
  83.     if Length(S) <> Sizeof(Extended) then
  84.       TransformFunc := EOutOfRange
  85.     else
  86.       Move(S[1], Res^.CV_Extended, SizeoF(Extended)); 
  87.   end else
  88.   if Proc^.Name = 'TRANSFORMSTRINGTODOUBLE' then begin
  89.     if Length(S) <> Sizeof(Double) then
  90.       TransformFunc := EOutOfRange
  91.     else
  92.       Move(S[1], Res^.CV_Double, SizeOf(Double)); 
  93.   end else
  94.   if Proc^.Name = 'TRANSFORMSTRINGTOSINGLE' then begin
  95.     if Length(S) <> Sizeof(Single) then
  96.       TransformFunc := EOutOfRange
  97.     else
  98.       Move(S[1], Res^.CV_Single, SizeoF(Single)); 
  99.   end else
  100.   if Proc^.Name = 'TRANSFORMSTRINGTOINTEGER' then begin
  101.     S := GetString(VM_Get(Params, 0));
  102.     if Length(S) <> Sizeof(Longint) then
  103.       TransformFunc := EOutOfRange
  104.     else
  105.       Move(S[1], Res^.CV_SInt32, SizeOf(Longint));
  106.   end else
  107.   if Proc^.Name = 'TRANSFORMSTRINGTOSMALLINT' then begin
  108.     S := GetString(VM_Get(Params, 0));
  109.     if Length(S) <> Sizeof(SmallInt) then
  110.       TransformFunc := EOutOfRange
  111.     else
  112.       Move(S[1], Res^.CV_SInt16, SizeOf(SmallInt));
  113.   end else
  114.   if Proc^.Name = 'TRANSFORMSTRINGTOBYTE' then begin
  115.     S := GetString(VM_Get(Params, 0));
  116.     if Length(S) <> Sizeof(byte) then
  117.       TransformFunc := EOutOfRange
  118.     else
  119.       Move(S[1], Res^.CV_UByte, SizeOf(Byte));
  120.   end else
  121.   if Proc^.Name = 'TRANSFORMSTRINGTOSHORTINT' then begin
  122.     S := GetString(VM_Get(Params, 0));
  123.     if Length(S) <> Sizeof(ShortInt) then
  124.       TransformFunc := EOutOfRange
  125.     else
  126.       Move(S[1], Res^.CV_SByte, SizeOf(ShortInt));
  127.   end else
  128.   if Proc^.Name = 'TRANSFORMSTRINGTOWORD' then begin
  129.     S := GetString(VM_Get(Params, 0));
  130.     if Length(S) <> Sizeof(Word) then
  131.       TransformFunc := EOutOfRange
  132.     else
  133.       Move(S[1], Res^.CV_UInt16, Sizeof(Word));
  134.   end;
  135. end;
  136.  
  137. procedure RegisterTransLibrary(p: TIfPasScript);
  138. begin
  139.   P.AddFunction(@TransformFunc, 'function TransformExtendedToString(E: Extended): string;', nil);
  140.   P.AddFunction(@TransformFunc, 'function TransformDoubleToString(E: Double): string;', nil);
  141.   P.AddFunction(@TransformFunc, 'function TransformSingleToString(E: Single): string;', nil);
  142.   P.AddFunction(@TransformFunc, 'function TransformIntegertoString(E: Longint): string;', nil);
  143.   P.AddFunction(@TransformFunc, 'function TransformSmallInttoString(E: SmallInt): string;', nil);
  144.   P.AddFunction(@TransformFunc, 'function TransformBytetoString(E: Byte): string;', nil);
  145.   P.AddFunction(@TransformFunc, 'function TransformShortIntToString(E: ShortInt): string;', nil);
  146.   P.AddFunction(@TransformFunc, 'function TransformWordtoString(E: Word): string;', nil);
  147.   P.AddFunction(@TransformFunc, 'function TransformStringToExtended(E: String): Extended;', nil);
  148.   P.AddFunction(@TransformFunc, 'function TransformStringToDouble(E: String): Double;', nil);
  149.   P.AddFunction(@TransformFunc, 'function TransformStringToSingle(E: String): Single;', nil);
  150.   P.AddFunction(@TransformFunc, 'function TransformStringToInteger(E: String): Longint;', nil);
  151.   P.AddFunction(@TransformFunc, 'function TransformStringToSmallInt(E: String): SmallInt;', nil);
  152.   P.AddFunction(@TransformFunc, 'function TransformStringToByte(E: String): Byte;', nil);
  153.   P.AddFunction(@TransformFunc, 'function TransformStringToShortInt(E: String): ShortInt;', nil);
  154.   P.AddFunction(@TransformFunc, 'function TransformStringToWord(E: String): word;', nil);
  155. end;
  156.  
  157. end.
  158.