Как сохранять параметры TFont, TBrush…

Как сохранять параметры TFont, TBrush...

procedure strtofont(str: string; font: tfont);
function fonttostr(font: tfont): string;

procedure strtobrush(str : string; brush : tbrush);
function brushtostr(brush: tbrush): string;

implementation

uses sysutils;

function firstwordseperator(sep : string;var workstr : string; cut :
boolean) : string;
var counter : word;
begin // "abcxdef" -> counter=4
counter:=pos(sep,workstr);
if counter>0
then result:=copy(workstr,1,counter-1)
else result:=workstr;

if cut then
begin
if counter>0
then delete(workstr,1,counter+length(sep)-1)
else workstr:='';
end;
end;


function tok(sep: string; var s: string): string;
// gives back part of string before the given seperator
// and throws away this part and the seperator
begin
result:=firstwordseperator(sep,s,true);
end;

procedure yesno(yes : boolean;var str:string);
begin
if yes
then
str:=str+'y'
else
str:=str+'n';
end;

function fonttostr(font: tfont): string;
begin
{encode all attributes of a tfont into a string}
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) + ' ';
yesno(fsbold in font.style,result);
yesno(fsitalic in font.style,result);
yesno(fsunderline in font.style,result);
yesno(fsstrikeout in font.style,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[1] = 'y' then font.style := font.style + [fsbold];
if str[2] = 'y' then font.style := font.style + [fsitalic];
if str[3] = 'y' then font.style := font.style + [fsunderline];
if str[4] = 'y' then font.style := font.style + [fsstrikeout];
end;

// ##########################################


function brushtostr(brush: tbrush): string;
begin
result := '';
result := result + inttostr(brush.color) + ' ';

case brush.style of
bssolid : result:=result+'1';
bsclear : result:=result+'2';
bsbdiagonal : result:=result+'3';
bsfdiagonal : result:=result+'4';
bscross : result:=result+'5';
bsdiagcross : result:=result+'6';
bshorizontal : result:=result+'7';
bsvertical : result:=result+'8';
end;
end;


procedure strtobrush(str : string; brush : tbrush);
begin
if str = '' then exit;
brush.color := strtoint(tok(' ', str));

brush.style := bssolid;
case upcase(str[1]) of // enumerated like in helppage
'1' : brush.style := bssolid;
'2' : brush.style := bsclear;
'3' : brush.style := bsbdiagonal;
'4' : brush.style := bsfdiagonal;
'5' : brush.style := bscross;
'6' : brush.style := bsdiagcross;
'7' : brush.style := bshorizontal;
'8' : brush.style := bsvertical;
end;
end;

Эта запись была добавлена в Пятница, 9 мая, 2008 - 14:01 В разделы TFont, Классы. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.