home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / unity / d56 / DW / DW10242.ZIP / StringWorks.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-07-07  |  29.1 KB  |  937 lines
  1. (*-------------------------------StringWorks.pas--------------------------
  2.  V1.0.242 - 08.07.2002 current release
  3. ------------------------------------------------------------------------*)
  4. unit StringWorks;
  5.  
  6. interface
  7.  
  8. uses Classes, Controls, Graphics, Forms, Dialogs, SysUtils, SystemWorks;
  9.  
  10. function StrIsInteger(Str: String): Boolean;
  11. function StrClearToInteger(Str: String): String;
  12. function MasterPath: String;
  13. function CodeString(Strng, Code : String) : String;
  14. function CodeStringDelim(Str, Password: String; Delimiter: Char): String;
  15. function DecodeStringDelim(Str: String; Delimiter: Char): String;
  16. function StringLen(Str: String): Integer;
  17. function StringCountInStr(SubStr, Str: String): Integer;
  18. //function StringToColor(Str: String): TColor;
  19. function SubPositionByIndex(Str, SubStr: String; Index: Integer): Integer;
  20. function StrToList(Str, Delimeter: String): TStringList;
  21. function ListToStr(List: TStringList; Delimeter: String): String;
  22. function StrLeft(Str: String; Count: Integer): String;
  23. function StrMid(Str: String; Start, Count: Integer): String;
  24. function StrRight(Str: String; Count: Integer): String;
  25. function StrPart(Str: String; Start, Stop: Integer): String;
  26. procedure ShowInteger(Int: Integer);
  27. function BoolToStr(Bool: Boolean): String;
  28. function StrToBool(Bool: String): Boolean;
  29. function AlignToStr(Align: TAlign): String;
  30. function StrToAlign(Align: String): TAlign;
  31. function AnchorsToStr(Anchors: TAnchors): String;
  32. function StrToAnchors(Anchors: String): TAnchors;
  33. function BiDiModeToStr(BiDiMode: TBiDiMode): String;
  34. function StrToBiDiMode(BiDiMode: String): TBiDiMode;
  35. function BorderIconsToStr(BorderIcons: TBorderIcons): String;
  36. function StrToBorderIcons(BorderIcons: String): TBorderIcons;
  37. function BorderStyleToStr(BorderStyle: TFormBorderStyle): String;
  38. function StrToBorderStyle(BorderStyle: String): TFormBorderStyle;
  39. function ConstraintsToStr(Constraints: TSizeConstraints): String;
  40. function StrToConstraints(Constraints: String): TSizeConstraints;
  41. function DefaultMonitorToStr(DefaultMonitor: TDefaultMonitor): String;
  42. function StrToDefaultMonitor(DefaultMonitor: String): TDefaultMonitor;
  43. function DragKindToStr(DragKind: TDragKind): String;
  44. function StrToDragKind(DragKind: String): TDragKind;
  45. function DragModeToStr(DragMode: TDragMode): String;
  46. function StrToDragMode(DragMode: String): TDragMode;
  47. function FontPitchToStr(FontPitch: TFontPitch): String;
  48. function StrToFontPitch(FontPitch: String): TFontPitch;
  49. function FontStyleToStr(FontStyle: TFontStyles): String;
  50. function StrToFontStyle(FontStyle: String): TFontStyles;
  51. function FontToStr(Font: TFont): String;
  52. function StrToFont(Font: String): TFont;
  53. function FormStyleToStr(FormStyle: TFormStyle): String;
  54. function StrToFormStyle(FormStyle: String): TFormStyle;
  55. function ScrollBarStyleToStr(ScrollBarStyle: TScrollBarStyle): String;
  56. function StrToScrollBarStyle(ScrollBarStyle: String): TScrollBarStyle;
  57. function ControlScrollBarToStr(ControlScrollBar: TControlScrollBar): String;
  58. function StrToControlScrollBar(ControlScrollBar: String): TControlScrollBar;
  59. function PositionToStr(Position: TPosition): String;
  60. function StrToPosition(Position: String): TPosition;
  61. function PrintScaleToStr(PrintScale: TPrintScale): String;
  62. function StrToPrintScale(PrintScale: String): TPrintScale;
  63. function WindowStateToStr(WindowState: TWindowState): String;
  64. function StrToWindowState(WindowState: String): TWindowState;
  65.  
  66. // Added rev. 1.0.235 / 11.12.2001
  67. function HexToBin(a: String): PChar;
  68. function BinToHex(a: PChar): String;
  69.  
  70. // added rev. 1.0.236 / 27.12.2001
  71. procedure ReverseStringList(var List: TStringList);
  72.  
  73. // added rev. 1.0.237 / 06.01.2002
  74. function ReplaceStr(OldStr, FillStr: String; ReplaceChar: Char; AlignRight: Boolean): String;
  75. function ReverseStr(const Str: String): String;
  76.  
  77. // added rev. 1.0.238 / 10.01.2002
  78. function CountCharInStr(Str: String; Chr: Char): Integer;
  79.  
  80. // added rev. 1.0.240 / 08.05.2002
  81. function AnsiToAscii(const AnsiStr: String): String;
  82. function AsciiToAnsi(const AsciiStr: String): String;
  83.  
  84. // added rev. 1.0.241 / 20.05.2002
  85. function VersionBlockToStr(const VersionBlock: TDWVersionBlock): String;
  86.  
  87. // added rev. 1.0.242 / 31.06.2002
  88. function ComPortToStr(const COMPort: TDWComPort): String;
  89. function StrToComPort(const Str: String): TDWComPort;
  90.  
  91. // added rev. 1.0.242 / 02.07.2002
  92. function SmashStr(ValueA, ValueB: String): String;
  93.  
  94. implementation
  95.  
  96. uses Windows;
  97.  
  98. function SmashStr(ValueA, ValueB: String): String;
  99. var
  100.   i : Integer;
  101.   strTemp : String;
  102. begin
  103.   strTemp := ValueB;
  104.   for i := 1 to Length(ValueB) do
  105.     if Pos(ValueB[i], ValueA) = 0 then
  106.       strTemp := StringReplace(strTemp, ValueB[i], '', [rfReplaceAll]);
  107.   Result := strTemp;
  108. end;
  109.  
  110. function ComPortToStr(const COMPort: TDWComPort): String;
  111. begin
  112.    result:= '';
  113.    case COMPort of
  114.    dwcptCOM1: result:= 'COM1:';
  115.    dwcptCOM2: result:= 'COM2:';
  116.    dwcptCOM3: result:= 'COM3:';
  117.    dwcptCOM4: result:= 'COM4:';
  118.    dwcptCOM5: result:= 'COM5:';
  119.    dwcptCOM6: result:= 'COM6:';
  120.    dwcptCOM7: result:= 'COM7:';
  121.    end;
  122. end;
  123.  
  124. function StrToComPort(const Str: String): TDWComPort;
  125. begin
  126.    result:= dwcptUnknown;
  127.    if Pos('COM1:', Str)<>0 then result:= dwcptCOM1;
  128.    if Pos('COM2:', Str)<>0 then result:= dwcptCOM2;
  129.    if Pos('COM3:', Str)<>0 then result:= dwcptCOM3;
  130.    if Pos('COM4:', Str)<>0 then result:= dwcptCOM4;
  131.    if Pos('COM5:', Str)<>0 then result:= dwcptCOM5;
  132.    if Pos('COM6:', Str)<>0 then result:= dwcptCOM6;
  133.    if Pos('COM7:', Str)<>0 then result:= dwcptCOM7;
  134. end;
  135.  
  136. function VersionBlockToStr(const VersionBlock: TDWVersionBlock): String;
  137. begin
  138.    result:= IntToStr(VersionBlock.dwVersionMajor) + '.' +
  139.             IntToStr(VersionBlock.dwVersionMinor);
  140. end;
  141.  
  142. function AnsiToAscii(const AnsiStr: String): String;
  143. var AsciiStr: string;
  144. begin
  145.   SetLength(AsciiStr, Length(AnsiStr));
  146.   if Length(AnsiStr) > 0 then CharToOem(PChar(AnsiStr), PChar(AsciiStr));
  147.   AnsiToAscii:= AsciiStr;
  148. end;
  149.  
  150. function AsciiToAnsi(const AsciiStr: String): String;
  151. var AnsiStr: string;
  152. begin
  153.   SetLength(AnsiStr, Length(AsciiStr));
  154.   if Length(AsciiStr) > 0 then OemToChar(PChar(AsciiStr), PChar(AnsiStr));
  155.   AsciiToAnsi:= AnsiStr;
  156. end;
  157.  
  158. function StrIsInteger(Str: String): Boolean;
  159. begin
  160.    result:= not (StrToIntDef(Str, -2147483647)=-2147483647);
  161. end;
  162.  
  163. function StrClearToInteger(Str: String): String;
  164. var i: integer;
  165. begin
  166.    Result := Str;
  167.    for i := Length(Result) downto 1 do
  168.       if not (Result[i] in ['0'..'9']) then
  169.          Delete(Result, i, 1);
  170. end;
  171.  
  172. function MasterPath: String;
  173. begin
  174.    result:= UpperCase(IncludeTrailingBackslash(ExtractFilePath(Application.Exename)));
  175. end;
  176.  
  177. function CodeString(Strng, Code : String) : String;
  178. var
  179.    i : byte;
  180.    h : string;
  181.    j : byte;
  182. begin
  183.    Code:= ReverseStr(Code);
  184.    i := 1;
  185.    h := '';
  186.    j := 1;
  187.    while (i <= length(strng)) do
  188.    begin
  189.       h := h + chr(ord(strng[i]) xor ord(code[j]));
  190.       inc(i);
  191.       if j = length(code) then j := 1 else inc(j);
  192.    end;
  193.    result:= h;
  194. end;
  195.  
  196. function CodeStringDelim(Str, Password: String; Delimiter: Char): String;
  197. begin
  198.    Password:= ReverseStr(Password);
  199.    result:= CodeString(Str, Password) + Delimiter + Password;
  200. end;
  201.  
  202. function DecodeStringDelim(Str: String; Delimiter: Char): String;
  203. var
  204.    TL: TStringList;
  205.    CodedStr, Pwd: String;
  206. begin
  207.    TL:= TStringList.Create;
  208.    TL.Assign(StrToList(Str, Delimiter));
  209.    CodedStr:= TL[0];
  210.    Pwd:= TL[1];
  211.    TL.Free;
  212. //   Pwd:= ReverseStr(Pwd);
  213.    result:= CodeString(CodedStr, Pwd);
  214. end;
  215.  
  216. function StringLen(Str: String): Integer;
  217. begin
  218.    result:= StrLen(PChar(Str));
  219. end;
  220.  
  221. function StringCountInStr(SubStr, Str: String): Integer;
  222. var
  223.    StrLn, SubLn, I: Integer;
  224.    TempStr: String;
  225. begin
  226.    StrLn:= StrLen(PChar(Str));
  227.    SubLn:= StrLen(PChar(SubStr));
  228.    TempStr:= Str;
  229.    result:= 0;
  230.    for I:= 0 to StrLn - 1 do begin
  231.       TempStr:= Copy(Str, I + 1, SubLn);
  232.       if TempStr = SubStr then Inc(result);
  233.    end;
  234. end;
  235.  
  236. {function StringToColor(Str: String): TColor;
  237.    function GetHexValue(Input: Char): Byte;
  238.    begin
  239.       case UpCase(Input) of
  240.          '0' : Result := 0;
  241.          '1' : Result := 1;
  242.          '2' : Result := 2;
  243.          '3' : Result := 3;
  244.          '4' : Result := 4;
  245.          '5' : Result := 5;
  246.          '6' : Result := 6;
  247.          '7' : Result := 7;
  248.          '8' : Result := 8;
  249.          '9' : Result := 9;
  250.          'A' : Result := 10;
  251.          'B' : Result := 11;
  252.          'C' : Result := 12;
  253.          'D' : Result := 13;
  254.          'E' : Result := 14;
  255.          'F' : Result := 15;
  256.       end;
  257.    end;
  258. var
  259.    Bytes    : Array[0..3] of Byte;
  260. begin
  261.    Bytes[0] := GetHexValue(Str[2]) * 16 + GetHexValue(Str[3]);
  262.    Bytes[1] := GetHexValue(Str[4]) * 16 + GetHexValue(Str[5]);
  263.    Bytes[2] := GetHexValue(Str[6]) * 16 + GetHexValue(Str[7]);
  264.    Bytes[3] := GetHexValue(Str[8]) * 16 + GetHexValue(Str[9]);
  265.    result := Bytes[3] + Bytes[2] * 256 + Bytes[1] * 256 * 256 + Bytes[0] * 256 * 256 * 256;
  266. end;        }
  267.  
  268. function SubPositionByIndex(Str, SubStr: String; Index: Integer): Integer;
  269. var
  270.    StrLn, SubLn, Lock, I: Integer;
  271.    TempStr: String;
  272. begin
  273.    StrLn:= StrLen(PChar(Str));
  274.    SubLn:= StrLen(PChar(SubStr));
  275.    result:= 0;
  276.    Lock:= 0;
  277.    for I:= 0 to StrLn - 1 do begin
  278.       TempStr:= Copy(Str, I + 1, SubLn);
  279.       if TempStr = SubStr then Inc(Lock);
  280.       if Lock = Index then begin
  281.          result:= I + 1;
  282.          break;
  283.       end;
  284.    end;
  285. end;
  286.  
  287. function StrToList(Str, Delimeter: String): TStringList;
  288. var
  289.    I, iPos1, iPos2, DelimCount, StringLen: Integer;
  290. begin
  291.    result:= TStringList.Create;
  292.    DelimCount:= StringCountInStr(Delimeter, Str);
  293.    if DelimCount < 1 then begin
  294.       result.Add(Str);
  295.       exit;
  296.    end;
  297.    StringLen:= StrLen(PChar(Str));
  298.    if Pos(Delimeter, Str) = 0 then exit else begin
  299.       result.Add(StrLeft(Str, Pos(Delimeter, Str) - 1));
  300.       for I:= 0 to StringCountInStr(Delimeter, Str) - 2 do begin
  301.          iPos1:= SubPositionByIndex(Str, Delimeter, I+1);
  302.          iPos2:= SubPositionByIndex(Str, Delimeter, I+2);
  303.          result.Add(StrMid(Str, iPos1 + 1, iPos2 - iPos1 - 1));
  304.       end;
  305.    end;
  306.       result.Add(StrPart(Str, SubPositionByIndex(Str, Delimeter, DelimCount)+1,
  307.          StringLen+1));
  308. end;
  309.  
  310. function ListToStr(List: TStringList; Delimeter: String): String;
  311. var
  312.    I: Integer;
  313.    TempStr: String;
  314. begin
  315.    for I:= 0 to List.Count - 1 do begin
  316.       TempStr:= TempStr + List[I] + Delimeter;
  317.    end;
  318.    Delete(TempStr, (StringLen(TempStr)-StringLen(Delimeter)+1), StringLen(Delimeter));
  319.    result:= TempStr;
  320. end;
  321.  
  322. function StrLeft(Str: String; Count: Integer): String;
  323. begin
  324.    result:= Copy(Str, 1, Count);
  325. end;
  326.  
  327. function StrMid(Str: String; Start, Count: Integer): String;
  328. begin
  329.    result:= Copy(Str, Start, Count);
  330. end;
  331.  
  332. function StrRight(Str: String; Count: Integer): String;
  333. var StrLn: Integer;
  334. begin
  335.    StrLn:= StrLen(PChar(Str));
  336.    result:= Copy(Str, StrLn - (Count - 1), Count);
  337. end;
  338.  
  339. function StrPart(Str: String; Start, Stop: Integer): String;
  340. //var StrLn: Integer;
  341. begin
  342.   // StrLn:= StrLen(PChar(Str));
  343.    result:= Copy(Str, Start, Stop - Start);
  344. end;
  345.  
  346. procedure ShowInteger(Int: Integer);
  347. begin
  348.    ShowMessage(IntToStr(Int));
  349. end;
  350.  
  351. function BoolToStr(Bool: Boolean): String;
  352. begin
  353.    if Bool then result:= '1' else result:= '0';
  354. end;
  355.  
  356. function StrToBool(Bool: String): Boolean;
  357. begin
  358.    result:= (Bool = '1');
  359. end;
  360.  
  361. function AlignToStr(Align: TAlign): String;
  362. begin
  363.    result:= 'alNone';
  364.    case Align of
  365.    alBottom:     result:= 'alBottom';
  366.    alClient:     result:= 'alClient';
  367.    alLeft:       result:= 'alLeft';
  368.    alRight:      result:= 'alRight';
  369.    alTop:        result:= 'alTop';
  370.    end;
  371. end;
  372.  
  373. function StrToAlign(Align: String): TAlign;
  374. begin
  375.    result:= alNone;
  376.    if Align = 'alBottom' then    result:= alBottom else
  377.    if Align = 'alClient' then    result:= alClient else
  378.    if Align = 'alLeft'   then    result:= alLeft else
  379.    if Align = 'alRight'  then    result:= alRight else
  380.    if Align = 'alTop'    then    result:= alTop;
  381. end;
  382.  
  383. function AnchorsToStr(Anchors: TAnchors): String;
  384. var TempList: TStringList;
  385. begin
  386.    TempList:= TStringList.Create;
  387.    if akLeft in Anchors then TempList.Add('akLeft');
  388.    if akTop  in Anchors then TempList.Add('akTop');
  389.    if akRight in Anchors then TempList.Add('akRight');
  390.    if akBottom in Anchors then TempList.Add('akBottom');
  391.    result:= ListToStr(TempList, '|');
  392.    TempList.Free;
  393. end;
  394.  
  395. function StrToAnchors(Anchors: String): TAnchors;
  396. var
  397.    TempList: TStringList;
  398.    I: Integer;
  399.    TempAnchors: TAnchors;
  400. begin
  401.    TempList:= StrToList(Anchors, '|');
  402.    for I:= 0 to TempList.Count - 1 do begin
  403.       if TempList[I] = 'akLeft'   then Include(TempAnchors, akLeft);
  404.       if TempList[I] = 'akTop'    then Include(TempAnchors, akTop);
  405.       if TempList[I] = 'akRight'  then Include(TempAnchors, akRight);
  406.       if TempList[I] = 'akBottom' then Include(TempAnchors, akBottom);
  407.    end;
  408.    result:= TempAnchors;
  409.    TempList.Free;
  410. end;
  411.  
  412. function BiDiModeToStr(BiDiMode: TBiDiMode): String;
  413. begin
  414.    case BiDiMode of
  415.    bdLeftToRight:             result:= 'bdLeftToRight';
  416.    bdRightToLeft:             result:= 'bdRightToLeft';
  417.    bdRightToLeftNoAlign:      result:= 'bdRightToLeftNoAlign';
  418.    bdRightToLeftReadingOnly:  result:= 'bdRightToLeftReadingOnly';
  419.    end;
  420. end;
  421.  
  422. function StrToBiDiMode(BiDiMode: String): TBiDiMode;
  423. begin
  424.    result:= bdLeftToRight;
  425.    if BiDiMode = 'bdLeftToRight'             then result:= bdLeftToRight else
  426.    if BiDiMode = 'bdRightToLeft'             then result:= bdRightToLeft else
  427.    if BiDiMode = 'bdRightToLeftNoAlign'      then result:= bdRightToLeftNoAlign else
  428.    if BiDiMode = 'bdRightToLeftReadingOnly'  then result:= bdRightToLeftReadingOnly;
  429. end;
  430.  
  431. function BorderIconsToStr(BorderIcons: TBorderIcons): String;
  432. var
  433.    TempList: TStringList;
  434. begin
  435.    TempList:= TStringList.Create;
  436.    if biSystemMenu in BorderIcons then TempList.Add('biSystemMenu');
  437.    if biMinimize   in BorderIcons then TempList.Add('biMinimize');
  438.    if biMaximize   in BorderIcons then TempList.Add('biMaximize');
  439.    if biHelp       in BorderIcons then TempList.Add('biHelp');
  440.    result:= ListToStr(TempList, '|');
  441.    TempList.Free;
  442. end;
  443.  
  444. function StrToBorderIcons(BorderIcons: String): TBorderIcons;
  445. var
  446.    TempList: TStringList;
  447.    I: Integer;
  448. begin
  449.    TempList:= StrToList(BorderIcons, '|');
  450.    for I:= 0 to TempList.Count -1 do begin
  451.       if TempList[I] = 'biSystemMenu' then Include(result, biSystemMenu);
  452.       if TempList[I] = 'biMinimize'   then Include(result, biMinimize);
  453.       if TempList[I] = 'biMaximize'   then Include(result, biMaximize);
  454.       if TempList[I] = 'biHelp'       then Include(result, biHelp);
  455.    end;
  456.    TempList.Free;
  457. end;
  458.  
  459. function BorderStyleToStr(BorderStyle: TFormBorderStyle): String;
  460. begin
  461.    result:= 'bsSizeable';
  462.    case BorderStyle of
  463.    bsDialog:         result:= 'bsDialog';
  464.    bsNone:           result:= 'bsNone';
  465.    bsSingle:         result:= 'bsSingle';
  466.    bsSizeable:       result:= 'bsSizeable';
  467.    bsSizeToolWin:    result:= 'bsSizeToolWin';
  468.    bsToolWindow:     result:= 'bsToolWindow';
  469.    end;
  470. end;
  471.  
  472. function StrToBorderStyle(BorderStyle: String): TFormBorderStyle;
  473. begin
  474.    result:= bsSizeable;
  475.    if BorderStyle = 'bsDialog'      then result:= bsDialog;
  476.    if BorderStyle = 'bsNone'        then result:= bsNone;
  477.    if BorderStyle = 'bsSingle'      then result:= bsSingle;
  478.    if BorderStyle = 'bsSizeable'    then result:= bsSizeable;
  479.    if BorderStyle = 'bsSizeToolWin' then result:= bsSizeToolWin;
  480.    if BorderStyle = 'bsToolWindow'  then result:= bsToolWindow;
  481. end;
  482.  
  483. function ConstraintsToStr(Constraints: TSizeConstraints): String;
  484. begin
  485.    with Constraints do
  486.       result:= IntToStr(MaxHeight) + '|' +
  487.                IntToStr(MaxWidth)  + '|' +
  488.                IntToStr(MinHeight) + '|' +
  489.                IntToStr(MinWidth);
  490. end;
  491.  
  492. function StrToConstraints(Constraints: String): TSizeConstraints;
  493. var
  494.    TempList: TStringList;
  495. begin
  496.    result:= TSizeConstraints.Create(Application.MainForm);
  497.    TempList:= StrToList(Constraints, '|');
  498.    result.MaxHeight:= StrToIntDef(TempList[0], 0);
  499.    result.MaxWidth:= StrToIntDef(TempList[1], 0);
  500.    result.MinHeight:= StrToIntDef(TempList[2], 0);
  501.    result.MinWidth:= StrToIntDef(TempList[3], 0);
  502.    TempList.Free;
  503. end;
  504.  
  505. function DefaultMonitorToStr(DefaultMonitor: TDefaultMonitor): String;
  506. begin
  507.    result:= 'dmPrimary';
  508.    case DefaultMonitor of
  509.    dmDesktop:     result:= 'dmDesktop';
  510.    dmPrimary:     result:= 'dmPrimary';
  511.    dmMainForm:    result:= 'dmMainForm';
  512.    dmActiveForm:  result:= 'dmActiveForm';
  513.    end;
  514. end;
  515.  
  516. function StrToDefaultMonitor(DefaultMonitor: String): TDefaultMonitor;
  517. begin
  518.    result:= dmPrimary;
  519.    if DefaultMonitor = 'dmDesktop' then result:= dmDesktop else
  520.    if DefaultMonitor = 'dmPrimary' then result:= dmPrimary else
  521.    if DefaultMonitor = 'dmMainForm' then result:= dmMainForm else
  522.    if DefaultMonitor = 'dmActiveForm' then result:= dmActiveForm;
  523. end;
  524.  
  525. function DragKindToStr(DragKind: TDragKind): String;
  526. begin
  527.    if DragKind = dkDrag then result:= 'dkDrag' else result:= 'dkDock';
  528. end;
  529.  
  530. function StrToDragKind(DragKind: String): TDragKind;
  531. begin
  532.    if DragKind = 'dkDrag' then result:= dkDrag else result:= dkDock;
  533. end;
  534.  
  535. function DragModeToStr(DragMode: TDragMode): String;
  536. begin
  537.    if DragMode = dmManual then result:= 'dmManual' else result:= 'dmAutomatic';
  538. end;
  539.  
  540. function StrToDragMode(DragMode: String): TDragMode;
  541. begin
  542.    if DragMode = 'dmManual' then result:= dmManual else result:= dmAutomatic;
  543. end;
  544.  
  545. function FontPitchToStr(FontPitch: TFontPitch): String;
  546. begin
  547.    result:= 'fpDefault';
  548.    case FontPitch of
  549.    fpDefault:     result:= 'fpDefault';
  550.    fpFixed:       result:= 'fpFixed';
  551.    fpVariable:    result:= 'fpVariable';
  552.    end;
  553. end;
  554.  
  555. function StrToFontPitch(FontPitch: String): TFontPitch;
  556. begin
  557.    result:= fpDefault;
  558.    if FontPitch = 'fpDefault'  then result:= fpDefault else
  559.    if FontPitch = 'fpFixed'    then result:= fpFixed else
  560.    if FontPitch = 'fpVariable' then result:= fpVariable;
  561. end;
  562.  
  563. function FontStyleToStr(FontStyle: TFontStyles): String;
  564. var
  565.    TempList: TStringList;
  566. begin
  567.    TempList:= TStringList.Create;
  568.    if fsBold      in FontStyle then TempList.Add('fsBold');
  569.    if fsItalic    in FontStyle then TempList.Add('fsItalic');
  570.    if fsUnderline in FontStyle then TempList.Add('fsUnderline');
  571.    if fsStrikeOut in FontStyle then TempList.Add('fsStrikeOut');
  572.    if TempList.Count = 0 then TempList.Add('fsNone');
  573.    result:= ListToStr(TempList, '~');
  574.    TempList.Free;
  575. end;
  576.  
  577. function StrToFontStyle(FontStyle: String): TFontStyles;
  578. var
  579.    TempList: TStringList;
  580.    I: Integer;
  581. begin
  582.    TempList:= StrToList(FontStyle, '~');
  583.    result:= [];
  584.    for I:= 0 to TempList.Count - 1 do begin
  585.       if TempList[I] = 'fsBold'      then Include(result, fsBold) else
  586.       if TempList[I] = 'fsItalic'    then Include(result, fsItalic) else
  587.       if TempList[I] = 'fsUnderline' then Include(result, fsUnderline) else
  588.       if TempList[I] = 'fsStrikeOut' then Include(result, fsStrikeOut);
  589.    end;
  590.    TempList.Free;
  591. end;
  592.  
  593. function FontToStr(Font: TFont): String;
  594. var
  595.    TempList: TStringList;
  596. begin
  597.    TempList:= TStringList.Create;
  598.    TempList.Add(IntToStr(Int64(Font.Charset)));
  599.    TempList.Add(ColorToString(Font.Color));
  600.    TempList.Add(IntToStr(Font.Height));
  601.    TempList.Add(Font.Name);
  602.    TempList.Add(FontPitchToStr(Font.Pitch));
  603.    TempList.Add(IntToStr(Font.Size));
  604.    TempList.Add(FontStyleToStr(Font.Style));
  605.    result:= ListToStr(TempList, '|');
  606.    TempList.Free;
  607. end;
  608.  
  609. function StrToFont(Font: String): TFont;
  610. var
  611.    TempList: TStringList;
  612.    bFont: TFont;
  613. begin
  614.    TempList:= StrToList(Font, '|');
  615.    bFont:= TFont.Create;
  616.    bFont.Charset:= StrToIntDef(TempList[0], 1);
  617.    bFont.Color:= StringToColor(TempList[1]);
  618.    bFont.Height:= StrToIntDef(TempList[2], -11);
  619.    bFont.Name:= TempList[3];
  620.    bFont.Pitch:= StrToFontPitch(TempList[4]);
  621.    bFont.Size:= StrToIntDef(TempList[5], 8);
  622.    bFont.Style:= StrToFontStyle(TempList[6]);
  623.    TempList.Free;
  624.    result:= bFont;
  625. end;
  626.  
  627. function FormStyleToStr(FormStyle: TFormStyle): String;
  628. begin
  629.    result:= 'fsNormal';
  630.    case FormStyle of
  631.    fsNormal:      result:= 'fsNormal';
  632.    fsMDIChild:    result:= 'fsMDIChild';
  633.    fsMDIForm:     result:= 'fsMDIForm';
  634.    fsStayOnTop:   result:= 'fsStayOnTop';
  635.    end;
  636. end;
  637.  
  638. function StrToFormStyle(FormStyle: String): TFormStyle;
  639. begin
  640.    result:= fsNormal;
  641.    if FormStyle = 'fsNormal'    then result:= fsNormal   else
  642.    if FormStyle = 'fsMDIChild'  then result:= fsMDIChild else
  643.    if FormStyle = 'fsMDIForm'   then result:= fsMDIForm  else
  644.    if FormStyle = 'fsStayOnTop' then result:= fsStayOnTop;
  645. end;
  646.  
  647. function ScrollBarStyleToStr(ScrollBarStyle: TScrollBarStyle): String;
  648. begin
  649.    result:= 'ssRegular';
  650.    case ScrollBarStyle of
  651.    ssRegular:        result:= 'ssRegular';
  652.    ssFlat:           result:= 'ssFlat';
  653.    ssHotTrack:       result:= 'ssHotTrack';
  654.    end;
  655. end;
  656.  
  657. function StrToScrollBarStyle(ScrollBarStyle: String): TScrollBarStyle;
  658. begin
  659.    result:= ssRegular;
  660.    if ScrollBarStyle = 'ssRegular' then result:= ssRegular else
  661.    if ScrollBarStyle = 'ssFlat' then result:= ssFlat else
  662.    if ScrollBarStyle = 'ssHotTrack' then result:= ssHotTrack;
  663. end;
  664.  
  665. function ControlScrollBarToStr(ControlScrollBar: TControlScrollBar): String;
  666. var
  667.    TempList: TStringList;
  668. begin
  669.    TempList:= TStringList.Create;
  670.    with ControlScrollBar do begin
  671.       TempList.Add(IntToStr(ButtonSize));
  672.       TempList.Add(ColorToString(Color));
  673.       TempList.Add(IntToStr(Increment));
  674.       TempList.Add(IntToStr(Margin));
  675.       TempList.Add(BoolToStr(ParentColor));
  676.       TempList.Add(IntToStr(Position));
  677.       TempList.Add(IntToStr(Range));
  678.       TempList.Add(IntToStr(Size));
  679.       TempList.Add(BoolToStr(Smooth));
  680.       TempList.Add(ScrollBarStyleToStr(Style));
  681.       TempList.Add(IntToStr(ThumbSize));
  682.       TempList.Add(BoolToStr(Tracking));
  683.       TempList.Add(BoolToStr(Visible));
  684.    end;
  685.    result:= ListToStr(TempList, '|');
  686.    TempList.Free;
  687. end;
  688.  
  689. function StrToControlScrollBar(ControlScrollBar: String): TControlScrollBar;
  690. var
  691.    TempList: TStringList;
  692.    rslt: TControlScrollBar;
  693. begin
  694.    TempList:= StrToList(ControlScrollBar, '|');
  695.    rslt:= TControlScrollBar.Create;
  696.    with rslt do begin
  697.       ButtonSize:=   StrToIntDef(TempList[0], 0);
  698. //      Color:=        StringToColor(TempList[1]);
  699.       Increment:=    StrToIntDef(TempList[2], 8);
  700.       Margin:=       StrToIntDef(TempList[3], 0);
  701.       ParentColor:=  StrToBool(TempList[4]);
  702. //      Position:=     StrToIntDef(TempList[5], 0);
  703. //      Range:=        StrToIntDef(TempList[6], 0);
  704.       Size:=         StrToIntDef(TempList[7], 0);
  705.       Smooth:=       StrToBool(TempList[8]);
  706.       Style:=        StrToScrollBarStyle(TempList[9]);
  707.       ThumbSize:=    StrToIntDef(TempList[10], 0);
  708.       Tracking:=     StrToBool(TempList[11]);
  709.       {Visible:=      StrToBool(TempList[12]);//}
  710.    end;
  711.    result:= rslt;
  712. end;
  713.  
  714. function PositionToStr(Position: TPosition): String;
  715. begin
  716.    result:= 'poDesigned';
  717.    case Position of
  718.    poDesigned:          result:= 'poDesigned';
  719.    poDefault:           result:= 'poDefault';
  720.    poDefaultPosOnly:    result:= 'poDefaultPosOnly';
  721.    poDefaultSizeOnly:   result:= 'poDefaultSizeOnly';
  722.    poScreenCenter:      result:= 'poScreenCenter';
  723.    poDesktopCenter:     result:= 'poDesktopCenter';
  724.    poMainFormCenter:    result:= 'poMainFormCenter';
  725.    poOwnerFormCenter:   result:= 'poOwnerFormCenter';
  726.    end;
  727. end;
  728.  
  729. function StrToPosition(Position: String): TPosition;
  730. begin
  731.    result:= poDesigned;
  732.    if Position = 'poDesigned' then result:= poDesigned else
  733.    if Position = 'poDefault' then result:= poDesigned else
  734.    if Position = 'poDefaultPosOnly' then result:= poDefaultPosOnly else
  735.    if Position = 'poDefaultSizeOnly' then result:= poDefaultSizeOnly else
  736.    if Position = 'poScreenCenter' then result:= poScreenCenter else
  737.    if Position = 'poDesktopCenter' then result:= poDesktopCenter else
  738.    if Position = 'poMainFormCenter' then result:= poMainFormCenter else
  739.    if Position = 'poOwnerFormCenter' then result:= poOwnerFormCenter;
  740. end;
  741.  
  742. function PrintScaleToStr(PrintScale: TPrintScale): String;
  743. begin
  744.    result:= 'poProportional';
  745.    case PrintScale of
  746.    poNone:         result:= 'poNone';
  747.    poProportional: result:= 'poProportional';
  748.    poPrintToFit:   result:= 'poPrintToFit';
  749.    end;
  750. end;
  751.  
  752. function StrToPrintScale(PrintScale: String): TPrintScale;
  753. begin
  754.    result:= poProportional;
  755.    if PrintScale = 'poNone'         then result:= poNone else
  756.    if PrintScale = 'poProportional' then result:= poProportional else
  757.    if PrintScale = 'poPrintToFit'   then result:= poPrintToFit;
  758. end;
  759.  
  760. function WindowStateToStr(WindowState: TWindowState): String;
  761. begin
  762.    result:= 'wsNormal';
  763.    case WindowState of
  764.    wsNormal:    result:= 'wsNormal';
  765.    wsMinimized: result:= 'wsMinimized';
  766.    wsMaximized: result:= 'wsMaximized';
  767.    end;
  768. end;
  769.  
  770. function StrToWindowState(WindowState: String): TWindowState;
  771. begin
  772.    result:= wsNormal;
  773.    if WindowState = 'wsNormal'    then result:= wsNormal else
  774.    if WindowState = 'wsMinimized' then result:= wsMinimized else
  775.    if WindowState = 'wsMaximized' then result:= wsMaximized;
  776. end;
  777.  
  778. function HexToBin(a: String): PChar;
  779. var
  780.   i, j: Integer;
  781.   s: String;
  782.   p, r: PChar;
  783. const
  784.   HexString: array[0..15] of Char = ('0', '1', '2', '3',
  785.                                      '4', '5', '6', '7',
  786.                                      '8', '9', 'A', 'B',
  787.                                      'C', 'D', 'E', 'F');
  788.   BinString: array[0..15] of String = ('0000', '0001', '0010', '0011',
  789.                                        '0100', '0101', '0110', '0111',
  790.                                        '1000', '1001', '1010', '1011',
  791.                                        '1100', '1101', '1110', '1111');
  792. begin
  793.   s := '';
  794.  r := StrAlloc(65000);
  795.   p := StrAlloc(65000);
  796.   StrPCopy(r, '');
  797.   for i := 1 to Length(a) do
  798.     s := s + IntToHex(Ord(a[i]), 2);
  799.   for i := 1 to Length(s) do begin
  800.    for j := 0 to 15 do begin
  801.      if s[i] = HexString[j] then begin
  802.    StrPCopy(p, '');
  803.         StrPCopy(p, BinString[j]);
  804.         StrCat(r, p);
  805.       end;
  806.     end;
  807.   end;
  808.   StrDispose(p);
  809.   Result := StrAlloc(65000);
  810.   StrCopy(Result, r);
  811. end;
  812.  
  813. function BinToHex(a: PChar): String;
  814. var
  815.  i, j: Integer;
  816.   s: String;
  817.   HexString: array[0..15] of Char;
  818.   BinString: array[0..15] of String;
  819. begin
  820.  HexString[0] := '0';
  821.   HexString[1] := '1';
  822.   HexString[2] := '2';
  823.   HexString[3] := '3';
  824.   HexString[4] := '4';
  825.   HexString[5] := '5';
  826.   HexString[6] := '6';
  827.   HexString[7] := '7';
  828.   HexString[8] := '8';
  829.   HexString[9] := '9';
  830.   HexString[10] := 'A';
  831.   HexString[11] := 'B';
  832.   HexString[12] := 'C';
  833.   HexString[13] := 'D';
  834.   HexString[14] := 'E';
  835.   HexString[15] := 'F';
  836.   BinString[0] := '0000';
  837.   BinString[1] := '0001';
  838.   BinString[2] := '0010';
  839.   BinString[3] := '0011';
  840.   BinString[4] := '0100';
  841.   BinString[5] := '0101';
  842.   BinString[6] := '0110';
  843.   BinString[7] := '0111';
  844.   BinString[8] := '1000';
  845.   BinString[9] := '1001';
  846.   BinString[10] := '1010';
  847.   BinString[11] := '1011';
  848.   BinString[12] := '1100';
  849.   BinString[13] := '1101';
  850.   BinString[14] := '1110';
  851.   BinString[15] := '1111';
  852.   s := '';
  853.   Result := '';
  854.   j := 0;
  855.   while a[j] <> #0 do begin
  856.    i := 0;
  857.  s := '';
  858.    while i < 4 do begin
  859.      s := s + a[j];
  860.       inc(i);
  861.       inc(j);
  862.     end;
  863.     for i := 0 to 15 do begin
  864.      if s = BinString[i] then begin
  865.         Result := Result + HexString[i];
  866.       end;
  867.     end;
  868.   end;
  869. end;
  870.  
  871. procedure ReverseStringList(var List: TStringList);
  872. var
  873.    TempList: TStringList;
  874.    I: Integer;
  875. begin
  876.    TempList:= TStringList.Create;
  877.    for I:= List.Count - 1 downto 0 do begin
  878.       TempList.Add(List[I]);
  879.    end;
  880.    List.Assign(TempList);
  881.    TempList.Free;
  882. end;
  883.  
  884. function ReplaceStr(OldStr, FillStr: String; ReplaceChar: Char; AlignRight: Boolean): String;
  885. var
  886.    fcCount, I, J, K: Integer;
  887. begin
  888.    if (StringLen(OldStr) < 1) then exit;
  889.    result:= OldStr;
  890.    if (StringLen(FillStr) < 1) then exit;
  891.    fcCount:= StringCountInStr(ReplaceChar, OldStr);
  892.    if fcCount < 1 then exit;
  893.    if not AlignRight then begin
  894.       K:= 0;
  895.       for I:= 1 to StringLen(OldStr) do begin
  896.          if OldStr[I] = ReplaceChar then begin
  897.             inc(K);
  898.             if not (K > StringLen(FillStr)) then OldStr[I]:= FillStr[K];
  899.          end;
  900.       end;
  901.    end else begin
  902.       FillStr:= ReverseStr(FillStr);
  903.       K:= 0;
  904.       for J:= StringLen(OldStr) downto 1 do begin
  905.          if OldStr[J] = ReplaceChar then begin
  906.             inc(K);
  907.             if not (K > StringLen(FillStr)) then OldStr[J]:= FillStr[K];
  908.          end;
  909.       end;
  910.    end;
  911.    result:= OldStr;
  912. end;
  913.  
  914. function ReverseStr(const Str: String): String;
  915. var
  916.    I: Integer;
  917. begin
  918.    result:= Str;
  919.    if StringLen(Str) < 2 then exit;
  920.    for I:= StringLen(Str) downto 1 do begin
  921.       result[I]:= Str[(StringLen(Str) - I) + 1];
  922.    end;
  923. end;
  924.  
  925. function CountCharInStr(Str: String; Chr: Char): Integer;
  926. var
  927.    I: Integer;
  928. begin
  929.    result:= 0;
  930.    for I:= 1 to StringLen(Str) do begin
  931.       if Str[I] = Chr then Inc(result);
  932.    end;
  933. end;
  934.  
  935. end.
  936.  
  937.