Форум: "Основная";
Текущий архив: 2002.01.21;
Скачать: [xml.tar.bz2];

Вниз

Оптимизация процедуры   Найти похожие ветки 

← →
Alx2   (2002-01-03 10:51) [7]

То, что выше - по мотивам вопроса.
Теперь - почти полностью переделанный вариант. Скорость на порядок выше:

Procedure WriteText(ARect: TRect; Const Text: String);
Var
len : Integer;
fStyles : TFontStyles;
Tops, Widths: Integer;
OutRect : TRect;
Procedure GetSubText(Var K: Integer);
Var S: String;
Start : Integer;
Begin
Start := k;
While (K <= len) And (Text[K] <> "[") Do inc(K);
S := Copy(Text, Start, K - Start);
OutRect := Rect(ARect.Left+ Widths,Arect.Top+ 2 + Tops,ARect.Right,ARect.Bottom);
Canvas.TextRect(OutRect,OutRect.Left,OutRect.Top,S);
// Canvas.TextOut(ARect.Left + Widths, ARect.Top + 2 + Tops, S);
Widths := Widths + Canvas.TextWidth(S) + 2;
if Widths>ARect.Right-ARect.Left then
k := Len+1;
End;
Procedure SetAttrib(Var K: Integer);
Begin
If (K < len) And (Text[K] = "[") Then
Begin
inc(K);
If Text[K] In ["#", "$"] Then
Begin
If Text[K] = "#" Then
Begin
inc(K);
While (K <= len) And (Text[K] <> "]") Do
Begin
Case Text[K] Of
"B","b": fStyles := fStyles + [fsBold];
"U","u": fStyles := fStyles + [fsUnderline];
"I","i": fStyles := fStyles + [fsItalic];
"S","s": Canvas.Font.Name := "Symbol";
"Z","z": Canvas.Font.Size := 7;
"X","x":
Begin
Canvas.Font.Size := 7;
Tops := 6;
End;
End;
inc(K);
End;
End
Else
Begin
inc(K);
While (K <= len) And (Text[K] <> "]") Do
Begin
Case Text[K] Of
"B","b": fStyles := fStyles - [fsBold];
"U","u": fStyles := fStyles - [fsUnderline];
"I","i": fStyles := fStyles - [fsItalic];
"S","s": Canvas.Font.Name := "Arial Cyr";
"Z","z": Canvas.Font.Size := 10;
"X","x":
Begin
Canvas.Font.Size := 10;
Tops := 0;
End;
End;
inc(K);
End;
End;
Canvas.Font.Style := fStyles;
End;
inc(K);
End;
End;

Var
K: Integer;

Begin
len := Length(Text);
Tops := 0;
Widths := 2;
fStyles := Canvas.Font.Style;

K := 1;
While K <= Len Do
Begin
GetSubText(K);
SetAttrib(K);
End;
End;



---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.01.21;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.44 MB
Время: 0.004 c