Question

delphi 中Memo的Font保存问题！！

Memo的Font下的属性都是什么形式的？都能够转化为str保存进access数据库中吗？如果不能的话有什么其他的方法保存进access中？
有没有保存到access数据库里的方法？

Answer 1

可以把font信息存到inifile里去，这是delphi常用的存储窗口信息的文件 比如说：
uses
Inifiles;
procedure SaveFont(FName: string; Section: string; smFont: TFont); // 存储字体格式
var
FStream: TIniFile;
begin
FStream := TIniFile.Create(FName); // 打开/新建inifile
try
FStream.WriteString(Section, 'Name', smFont.Name); // 写入字体资料
FStream.WriteInteger(Section, 'CharSet', smFont.CharSet);
FStream.WriteInteger(Section, 'Color', smFont.Color);
FStream.WriteInteger(Section, 'Size', smFont.Size);
FStream.WriteInteger(Section, 'Style', Byte(smFont.Style));
finally
FStream.Free;
end;
end;

procedure LoadFont(FName: string; Section: string; smFont: TFont); // 读取字体
var
FStream: TIniFile;
begin
FStream := TIniFile.Create(Fname);
try
smFont.Name := FStream.ReadString(Section, 'Name', smFont.Name);
smFont.CharSet := TFontCharSet(FStream.ReadInteger(Section, 'CharSet', smFont.CharSet));
smFont.Color := TColor(FStream.ReadInteger(Section, 'Color', smFont.Color));
smFont.Size := FStream.ReadInteger(Section, 'Size', smFont.Size);
smFont.Style := TFontStyles(Byte(FStream.ReadInteger(Section, 'Style', Byte(smFont.Style))));
finally
FStream.Free;
end;
end;

// 用法
// 关闭窗口时保存 label1 字体
procedure TForm1.formClose(Sender: TObject);
begin
SaveFont('font.ini', 'label', label1.Font);
end;

// 运用字体
procedure TForm1.Label1DblClick(Sender: TObject);
begin
if FontDialog1.Execute then
label1.Font := FontDialog1.Font
end;

// 在窗口打开时，读取字体
procedure TForm1.formCreate(Sender: TObject);
begin
LoadFont('font.ini', 'label', label1.Font);
end;

Answer 2

这是我在用的。
function FontToString(AFont: TFont; AIncludeColor: Boolean): String;
var
sStyle: String;
begin
with AFont do begin
sStyle := '';
if (fsBold in Style) then sStyle := sStyle + csfsBold;
if (fsItalic in Style) then sStyle := sStyle + csfsItalic;
if (fsUnderline in Style) then sStyle := sStyle + csfsUnderline;
if (fsStrikeOut in Style) then sStyle := sStyle + csfsStrikeout;
if ((Length(sStyle) > 0) and ('|' = sStyle[1])) then
sStyle := Copy(sStyle, 2, Length(sStyle) - 1);

Result := Format('"%s", %d, [%s]',[name, Size, sStyle]);
if AIncludeColor then
Result := Result + Format(', [%s]',[ColorToString(Color)]);
end;
end;

procedure StringToFont(AStrFont: string; AFont: TFont; AIncludeColor: Boolean);
var
iValue: Integer;
sStyle: String;
begin
with AFont do
try
//字体名称
iValue := Pos(',', AStrFont);
name := Copy(AStrFont, 2, iValue - 3);
Delete(AStrFont, 1, iValue);
//字体大小
iValue := Pos(',', AStrFont);
Size := StrToInt(Copy(AStrFont, 2, iValue - 2));
Delete(AStrFont, 1, iValue);
//字形
iValue := Pos(',', AStrFont);
sStyle := '|' + Copy(AStrFont, 3, iValue - 4);
Delete(AStrFont, 1, iValue);
//颜色
if AIncludeColor then
Color := StringToColor(Copy(AStrFont, 3, Length(AStrFont) - 3));

Style := [];
if (Pos(csfsBold, sStyle) > 0) then Style := Style + [fsBold];
if (Pos(csfsItalic, sStyle) > 0) then Style := Style + [fsItalic];
if (Pos(csfsUnderline, sStyle) > 0) then Style := Style + [fsUnderline];
if (Pos(csfsStrikeout, sStyle) > 0) then Style := Style + [fsStrikeOut];
except
AFont.Color := clBlack;
AFont.Name := '宋体';
AFont.Size := 9;
AFont.Style := [];
end;
end;

Answer 3

请查看TFont类