Форум: "Основная";
Текущий архив: 2002.01.21;
Скачать: [xml.tar.bz2];
ВнизОптимизация процедуры Найти похожие ветки
← →
Alx2 (2002-01-03 09:17) [6]Мой вариант:
Procedure WriteText(ARect: TRect; Text: ShortString);
Var
Widths, K : Integer;
pos1, pos2: Integer;
subtext : String;
Modif : String;
Tops : Integer;
fStyles : TFontStyles;
Begin
Tops := 0;
Widths := 2;
fStyles := Canvas.Font.Style;
Repeat
pos1 := Pos("[", Text);
pos2 := Pos("]", Text);
If pos1 = 0 Then pos1 := Length(Text) + 1;
subtext := Copy(Text, 1, pos1 - 1);
Canvas.TextOut(ARect.Left + Widths, ARect.Top + 2 + Tops, subtext);
Widths := Widths + Canvas.TextWidth(subtext) + 2;
Modif := Copy(Text, pos1 + 1, pos2 - pos1 - 1);
If Length(Modif) = 0 Then Modif := " ";
Modif := UpperCase(Modif);
Case Modif[1] Of
"#":
Begin
For K := 2 To Length(Modif) Do
Case Modif[K] Of
"B": fStyles := fStyles + [fsBold];
"U": fStyles := fStyles + [fsUnderline];
"I": fStyles := fStyles + [fsItalic];
"S": Canvas.Font.Name := "Symbol";
"Z": Canvas.Font.Size := 7;
"X":
Begin
Canvas.Font.Size := 7;
Tops := 6;
End;
End;
Canvas.Font.Style := fStyles;
End;
"$":
Begin
For K := 2 To Length(Modif) Do
Case Modif[K] Of
"B": fStyles := fStyles - [fsBold];
"U": fStyles := fStyles - [fsUnderline];
"I": fStyles := fStyles - [fsItalic];
"S": Canvas.Font.Name := "Arial Cyr";
"Z": Canvas.Font.Size := 10;
"X":
Begin
Canvas.Font.Size := 10;
Tops := 0;
End;
End;
Canvas.Font.Style := fStyles;
End;
End;
If pos2 <> 0 Then Delete(Text, 1, pos2);
Until (pos1 = 0) Or (pos2 = 0);
End;
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.01.21;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.004 c