home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / UTILS / PROFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-15  |  4.1 KB  |  146 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira System Library 1.0                           }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit Profile;
  10.  
  11. { TProfile is a simple extension of TIniFile that can read and
  12.   write string lists, and properties of fonts and headers.
  13.  
  14.   The strings and headers are stored in the way Delphi stores
  15.   INI lists, e.g.
  16.  
  17.   [Strings]
  18.   Count=2
  19.   S0=abc
  20.   S1=def
  21.  
  22.   Fonts are written so that the values can easily be edited, e.g.
  23.  
  24.   [Main window]
  25.   FontName=MS Sans Serif
  26.   FontSize=8
  27.   FontStyle=Bold Italic
  28. }
  29.  
  30. interface
  31.  
  32. uses Classes, IniFiles, Graphics, ExtCtrls;
  33.  
  34. type
  35.   TProfile = class(TIniFile)
  36.   public
  37.     procedure ReadStrings(const section: string; s: TStrings);
  38.     procedure WriteStrings(const section: string; s: TStrings);
  39.     procedure WriteSectionValues(const section: string; s: TStrings);
  40.     procedure ReadFont(const section: string; Font: TFont);
  41.     procedure WriteFont(const section: string; Font: TFont);
  42.     procedure ReadHeader(const section: string; Header: THeader);
  43.     procedure WriteHeader(const section: string; Header: THeader);
  44.   end;
  45.  
  46. implementation
  47.  
  48. uses SysUtils, Strings;
  49.  
  50. procedure TProfile.ReadStrings(const section: string; s: TStrings);
  51. var
  52.   i: Integer;
  53. begin
  54.   for i := 0 to ReadInteger(section, 'Count', 0)-1 do
  55.     s.Add(ReadString(section, 'S' + IntToStr(i), ''));
  56. end;
  57.  
  58.  
  59. procedure TProfile.WriteStrings(const section: string; s: TStrings);
  60. var i: Integer;
  61. begin
  62.   WriteInteger(section, 'Count', s.Count);
  63.   for i := 0 to s.Count-1 do WriteString(section, 'S' + IntToStr(i), s[i]);
  64. end;
  65.  
  66.  
  67. procedure TProfile.WriteSectionValues(const section: string; s: TStrings);
  68. var i: Integer;
  69. begin
  70.   for i := 0 to s.Count-1 do
  71.     WriteString(section, GetStrKey(s[i]), GetStrValue(s[i]));
  72. end;
  73.  
  74.  
  75. procedure TProfile.ReadFont(const section: string; Font: TFont);
  76. var
  77.   s : string[63];
  78.   n : Integer;
  79.   fs : TFontStyles;
  80. begin
  81.   s := ReadString(section,  'FontName', '');
  82.   if s > '' then Font.Name := s;
  83.  
  84.   n := ReadInteger(section, 'FontSize', 0);
  85.   if n > 0 then Font.Size := n;
  86.  
  87.   s := Lowercase(ReadString(section, 'FontStyle', ''));
  88.   if s > '' then begin
  89.     fs := [];
  90.     if Pos('bold', s) > 0 then Include(fs, fsBold);
  91.     if Pos('italic', s) > 0 then Include(fs, fsItalic);
  92.     if Pos('underline', s) > 0 then Include(fs, fsUnderline);
  93.     if Pos('strikeout', s) > 0 then Include(fs, fsStrikeOut);
  94.     Font.Style := fs;
  95.   end
  96.   else Font.Style := [];
  97.  
  98.   s := ReadString(section, 'FontColor', '');
  99.   if s > '' then Font.Color := StringToColor(s);
  100. end;
  101.  
  102.  
  103. procedure TProfile.WriteFont(const section: string; Font: TFont);
  104. var
  105.   s : string[63];
  106. begin
  107.   with Font do begin
  108.     WriteString(section,  'FontName', Name);
  109.     WriteInteger(section, 'FontSize', Size);
  110.     s := '';
  111.     if fsBold in Style then AppendStr(s, 'Bold ');
  112.     if fsItalic in Style then AppendStr(s, 'Italic ');
  113.     if fsUnderline in Style then AppendStr(s, 'Underline ');
  114.     if fsStrikeOut in Style then AppendStr(s, 'Strikeout ');
  115.     WriteString(section, 'FontStyle', s);
  116.     WriteString(section, 'FontColor', ColorToString(Font.Color));
  117.   end;
  118. end;
  119.  
  120.  
  121. procedure TProfile.ReadHeader(const section: string; Header: THeader);
  122. var
  123.   i, w: Integer;
  124. begin
  125.   for i := 0 to ReadInteger(section, 'SectionCount', 0) do
  126.     with Header do
  127.       if i < Sections.Count then begin
  128.         w := ReadInteger(section, 'Section' + IntToStr(i), -1);
  129.         if w > -1 then SectionWidth[i] := w;
  130.       end;
  131. end;
  132.  
  133.  
  134. procedure TProfile.WriteHeader(const section: string; Header: THeader);
  135. var
  136.   i: Integer;
  137. begin
  138.   with Header do begin
  139.     WriteInteger(section, 'SectionCount', Sections.Count);
  140.     for i := 0 to Sections.Count-1 do
  141.       WriteInteger(section, 'Section' + IntToStr(i), SectionWidth[i]);
  142.   end;
  143. end;
  144.  
  145. end.
  146.