强制类型转换(12分)

var
str : string;
color : Tcolor;
begin
str := 'clWindowText';
color := 要将str强制转换成 Tcolor,该怎么做?
end;

TRY
StringToColor

拜托,有这个函数吗?在哪个单元里?

如
StringToColor('clRed')

Grahpics单元

那 TFontStyles 和 String 之间的转换呢?

procedure TForm1.Button1Click(Sender: TObject);
begin
color :=StringToColor('$02FF8800');
end;

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

那 TFontStyles 和 String 之间的转换呢?

怎么做呢

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

将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

先在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;

例子很完整,谢谢二位.

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