库存管理软件版1楼: var
str : string;
color : Tcolor;
begin
str := ＇＇clWindowText＇＇;
color := 要将str强制转换成 Tcolor,该怎么做？
end;

2楼: TRY
StringToColor 如库存软件

3楼: 拜托,有这个函数吗？在哪个单元里？

4楼: 如
StringToColor(＇＇clRed＇＇)

5楼: Grahpics单元

6楼: 那 TFontStyles 和 String 之间的转换呢？

库存管理软件版7楼: procedure TForm1.Button1Click(Sender: TObject);
begin
color :=StringToColor(＇＇$02FF8800＇＇);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
color :=StringToColor(＇＇clWindowText＇＇);
end;

8楼: 那 TFontStyles 和 String 之间的转换呢？

怎么做呢

9楼: TFontStyles是一個集合類型,你想要轉換成字符串的什么格式呢？？
像這樣 ＇＇fsBold, fsItalic, fsUnderline, fsStrikeOut＇＇
還是像這樣 ＇＇fsBold;fsItalic;fsUnderline;fsStrikeOut＇＇
或才是像這樣 ＇＇fsBold|fsItalic|fsUnderline|fsStrikeOut＇＇？
沒有一個標准

10楼: 将Font对像转化为字符串存储

作者：


看看下面的代码：

function FontToString(Font: TFont): string;

begin

with Font do

Result := Format(＇＇%.8x%.8x%.4x%.4x%.1x%.2x%.1x%.4x%s＇＇, [Color, Height, Size,

PixelsPerInch, Byte(Pitch), CharSet, Byte(Style), Length(Name), Name]);

end;

procedure StringToFont(Str: string; Font: TFont);

var

Buff: string;

begin

if Length(Str) < 33 then raise Exception.Create(＇＇Error Font Format String＇＇);

Buff := Copy(Str, 1, 8);

Font.Color := StrToInt(＇＇$＇＇ + Buff);

Buff := Copy(Str, 9, 8);

Font.Height := StrToInt(＇＇$＇＇ + Buff);

Buff := Copy(Str, 17, 4);

Font.Size := StrToInt(＇＇$＇＇ + Buff);

Buff := Copy(Str, 21, 4);

Font.PixelsPerInch := StrToInt(＇＇$＇＇ + Buff);

Buff := Copy(Str, 25, 1);

Font.Pitch := TFontPitch(StrToInt(＇＇$＇＇ + Buff));

Buff := Copy(Str, 26, 2);

Font.Charset := TFontCharSet(StrToInt(＇＇$＇＇ + Buff));

Buff := Copy(Str, 28, 1);

Font.Style := TFontStyles(Byte(StrToInt(＇＇$＇＇ + Buff)));

Buff := Copy(Str, 29, 4);

Font.Name := Copy(Str, 33, StrToInt(＇＇$＇＇ + Buff));

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Text := FontToString(Memo1.Font);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if FontDialog1.Execute then

Memo1.Font := FontDialog1.Font;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

StringToFont(Memo1.Text, Memo1.Font);

end;

DvNews

11楼: 先在memo1和memo2中各輸入一些字符

function FontStylesToString(aFontStyles: TFontStyles; sComma: string = ＇＇,＇＇): string;
var
s: string;
begin
s := ＇＇＇＇;
if fsBold in aFontStyles then
s := s + ＇＇fsBold＇＇ + sComma;
if fsItalic in aFontStyles then
s := s + ＇＇fsItalic＇＇ + sComma;
if fsUnderline in aFontStyles then
s := s + ＇＇fsUnderline＇＇ + sComma;

if fsStrikeOut in aFontStyles then
s := s + ＇＇fsStrikeOut＇＇ + sComma;
Delete(s, length(s), 1);
Result := s;
end;

function StringToFontStyles(strFont: string; sComma: string = ＇＇,＇＇): TFontStyles;
var
aFontStyles: TFontStyles;
strTmp, strFS: string;
i: Integer;
begin
aFontStyles:=[];
strTmp := strFont + sComma;
i := Pos(sComma,strTmp);

while i > 0 do
begin
strFS := Copy(strTmp, 0, i - 1);
if strFS = ＇＇fsBold＇＇ then
aFontStyles := aFontStyles + [fsBold]
else if strFS = ＇＇fsItalic＇＇ then
aFontStyles := aFontStyles + [fsItalic]
else if strFS = ＇＇fsUnderline＇＇ then
aFontStyles := aFontStyles + [fsUnderline]
else if strFS = ＇＇fsStrikeOut＇＇ then
aFontStyles := aFontStyles + [fsStrikeOut];
strTmp:=Copy(strTmp, i+1,length(strTmp));
i := Pos(sComma,strTmp);
end;
Result := aFontStyles;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FontStylesToString(Memo1.font.style, ＇＇,＇＇));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
str: string;
begin
str := FontStylesToString(Memo1.font.style, ＇＇,＇＇);
Memo2.Font.Style := StringToFontStyles(str, ＇＇,＇＇);
ShowMessage(FontStylesToString(Memo2.font.style, ＇＇,＇＇));
end;

12楼: 例子很完整,谢谢二位. 如网吧管理软件

13楼: 也謝謝樓主,有些問題本人以前沒想過。