home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / HTMLmove / HtmlTool.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-15  |  2.9 KB  |  121 lines
  1. unit HtmlTool;
  2.  
  3. interface
  4.  
  5. uses Classes, SysUtils, ComCtrls;
  6.  
  7. { file based }
  8. procedure HtmlHeader(var AFile: TextFile; ATitle: string; const S: array of shortstring);
  9. procedure HtmlFooter(var AFile: TextFile; const S: array of shortstring);
  10. procedure HtmlOutline(var AFile: TextFile; Tree: TTreeView);
  11.  
  12. { Miscellaneous }
  13. function DosToUnixPath(const Path: string): string;
  14. function UnixToDosPath(const Path: string): string;
  15. function RelToAbsPath(Ref, Path: string): string;
  16. function AbsToRelPath(Ref, Path: string): string;
  17.  
  18. implementation
  19.  
  20. { file based }
  21. procedure HtmlHeader(var AFile: TextFile; ATitle: string; const S: array of shortstring);
  22. var
  23.   i: integer;
  24. begin
  25.   { write Html header }
  26.   Writeln(AFile, '<HTML>');
  27.   Writeln(AFile, '<HEAD><TITLE> ');
  28.   Writeln(AFile, ATitle);
  29.   Writeln(AFile, '</TITLE>');
  30.   for i := 0 to High(S) do
  31.   begin
  32.     Write(AFile, '<META> ');
  33.     Writeln(AFile, S[i]);
  34.   end;
  35.   Writeln(AFile, '</HEAD>');
  36. end;
  37.  
  38. procedure HtmlFooter(var AFile: TextFile; const S: array of shortstring);
  39. var
  40.   i: integer;
  41. begin
  42.   { Html footer }
  43.   Writeln(AFile, '<HR>');
  44.   for i := 0 to High(S) do
  45.     Writeln(AFile, S[i]);
  46.   Writeln(AFile, '</BODY></HTML>');
  47. end;
  48.  
  49. procedure HtmlOutline(var AFile: TextFile; Tree: TTreeView);
  50. var
  51.   i, j: integer;
  52.   CurLev: word;
  53. begin
  54.   CurLev := 0;
  55.   { iterate through the outline }
  56.   for i := 0 to Tree.Items.Count-1 do
  57.   begin
  58.     { if Node is visible }
  59.     if Tree.Items[i].IsVisible then
  60.     begin
  61.       { if level goes up... }
  62.       if Tree.Items[i].Level > CurLev then
  63.       begin
  64.         Write(AFile, '<UL>'); { increase indent }
  65.         Inc(CurLev);      { increase CurLev }
  66.       end;
  67.       { if level goes down... }
  68.       if Tree.Items[i].Level < CurLev then
  69.         { for CurLev down to the new level }
  70.         for j := CurLev downto Tree.Items[i].Level+1 do
  71.         begin
  72.           Write(AFile, '</UL>'); { close list level }
  73.           Dec(CurLev);  { decrease CurLev }
  74.         end;
  75.       Write(AFile, '<LI>');
  76.       Write(AFile, Tree.Items[i].Text); { write out the actual text }
  77.       Writeln(AFile, '</A>')
  78.     end;
  79.   end;
  80.   for j := CurLev downto 0 do Writeln(AFile, '</UL>'); { close all list levels }
  81. end;
  82.  
  83. { Miscellaneous }
  84. function TranslateChar(const Str: string; FromChar, ToChar: Char): string;
  85. var
  86.   I: Integer;
  87. begin
  88.   Result := Str;
  89.   for I := 1 to Length(Result) do
  90.     if Result[I] = FromChar then
  91.       Result[I] := ToChar;
  92. end;
  93.  
  94. function DosToUnixPath(const Path: string): string;
  95. begin
  96.   Result := TranslateChar(Path, '\', '/');
  97. end;
  98.  
  99. function UnixToDosPath(const Path: string): string;
  100. begin
  101.   Result := TranslateChar(Path, '/', '\');
  102. end;
  103.  
  104.  
  105. function RelToAbsPath(Ref, Path: string): string;
  106. begin
  107.   try
  108.     ChDir(Ref);
  109.     Result := ExpandFileName(Path);
  110.   except
  111.     Result := Path;
  112.   end;
  113. end;
  114.  
  115. function AbsToRelPath(Ref, Path: string): string;
  116. begin
  117.   Result := ExtractRelativePath(Ref, Path);
  118. end;
  119.  
  120. end.
  121.