[moo2k]

Ребята, подскажите как сохранить стиль шрифта (жирный, курсив и т.д)? Я пишу текстовый редактор, уже научился сохранять сам шрифт и его размер. Все данные о шрифте хранятся у меня в ini-файле. Заранее благодарен.

[Decoding]

Вот пример из DRKB

Код:

 
uses...Registry; 
 
procedure SaveFontToRegistry(Font: TFont; SubKey: string); 
var 
  R: TRegistry; 
  FontStyleInt: byte; 
  FS: TFontStyles; 
begin 
  R := TRegistry.Create; 
  try 
    FS := Font.Style; 
    Move(FS, FontStyleInt, 1); 
    R.OpenKey(SubKey, True); 
    R.WriteString('Font Name', Font.Name); 
    R.WriteInteger('Color', Font.Color); 
    R.WriteInteger('CharSet', Font.Charset); 
    R.WriteInteger('Size', Font.Size); 
    R.WriteInteger('Style', FontStyleInt); 
  finally 
    R.Free; 
  end; 
end; 
 
function ReadFontFromRegistry(Font: TFont; SubKey: string): boolean; 
var 
  R: TRegistry; 
  FontStyleInt: byte; 
  FS: TFontStyles; 
begin 
  R := TRegistry.Create; 
  try 
    result := R.OpenKey(SubKey, false); if not result then exit; 
    Font.Name := R.ReadString('Font Name'); 
    Font.Color := R.ReadInteger('Color'); 
    Font.Charset := R.ReadInteger('CharSet'); 
    Font.Size := R.ReadInteger('Size'); 
    FontStyleInt := R.ReadInteger('Style'); 
    Move(FontStyleInt, FS, 1); 
    Font.Style := FS; 
  finally 
    R.Free; 
  end; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if FontDialog1.Execute then 
    begin 
      SaveFontToRegistry(FontDialog1.Font, 'Delphi Kingdom\Fonts'); 
    end; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  NFont: TFont; 
begin 
  NFont := TFont.Create; 
  if ReadFontFromRegistry(NFont, 'Delphi Kingdom\Fonts') then 
    begin //здесь добавить проверку - существует ли шрифт 
      Label1.Font.Assign(NFont); 
      NFont.Free; 
    end; 
end;

[Decoding]

Вот еще один

Код:

 
function FontToStr(font: TFont): string; 
  procedure yes(var str: string); 
  begin 
 
    str := str + 'y'; 
  end; 
  procedure no(var str: string); 
  begin 
 
    str := str + 'n'; 
  end; 
begin 
 
  {кодируем все атрибуты TFont в строку} 
  Result := ''; 
  Result := Result + IntToStr(font.Color) + '|'; 
  Result := Result + IntToStr(font.Height) + '|'; 
  Result := Result + font.Name + '|'; 
  Result := Result + IntToStr(Ord(font.Pitch)) + '|'; 
  Result := Result + IntToStr(font.PixelsPerInch) + '|'; 
  Result := Result + IntToStr(font.size) + '|'; 
  if fsBold in font.style then 
    yes(Result) 
  else 
    no(Result); 
  if fsItalic in font.style then 
    yes(Result) 
  else 
    no(Result); 
  if fsUnderline in font.style then 
    yes(Result) 
  else 
    no(Result); 
  if fsStrikeout in font.style then 
    yes(Result) 
  else 
    no(Result); 
end; 
 
procedure StrToFont(str: string; font: TFont); 
begin 
 
  if str = '' then 
    Exit; 
  font.Color := StrToInt(tok('|', str)); 
  font.Height := StrToInt(tok('|', str)); 
  font.Name := tok('|', str); 
  font.Pitch := TFontPitch(StrToInt(tok('|', str))); 
  font.PixelsPerInch := StrToInt(tok('|', str)); 
  font.Size := StrToInt(tok('|', str)); 
  font.Style := []; 
  if str[0] = 'y' then 
    font.Style := font.Style + [fsBold]; 
  if str[1] = 'y' then 
    font.Style := font.Style + [fsItalic]; 
  if str[2] = 'y' then 
    font.Style := font.Style + [fsUnderline]; 
  if str[3] = 'y' then 
    font.Style := font.Style + [fsStrikeout]; 
end; 
 
function tok(sep: string; var s: string): string; 
 
  function isoneof(c, s: string): Boolean; 
  var 
    iTmp: integer; 
  begin 
    Result := False; 
    for iTmp := 1 to Length(s) do 
    begin 
      if c = Copy(s, iTmp, 1) then 
      begin 
        Result := True; 
        Exit; 
      end; 
    end; 
  end; 
var 
 
  c, t: string; 
begin 
 
  if s = '' then 
  begin 
    Result := s; 
    Exit; 
  end; 
  c := Copy(s, 1, 1); 
  while isoneof(c, sep) do 
  begin 
    s := Copy(s, 2, Length(s) - 1); 
    c := Copy(s, 1, 1); 
  end; 
  t := ''; 
  while (not isoneof(c, sep)) and (s  '') do 
  begin 
    t := t + c; 
    s := Copy(s, 2, length(s) - 1); 
    c := Copy(s, 1, 1); 
  end; 
  Result := t; 
end;

[moo2k]

Списибо, вам! Ваш moo2k