Hint - Kolorowanie składni

procedure TCodeHint.Paint;
var
pozycja: TPoint;
licznik: integer;
begin
licznik:=0;
with Canvas do
begin
Font.Color := clBlack; // domyślny kolor jeżeli nie wpisano kodu
Font.Style:=[]; // domyślny styl jeżeli nie wpisano kodu
repeat // powtarzanie pętli tak długo aż skończą się znaki w hint

licznik := licznik+1;
if Caption[licznik] <> '<' then
begin
if (Caption[licznik]=Chr(13)) and (Caption[licznik+1]=Chr(10)) then // następna linijka hinta
begin
pozycja.y := pozycja.y+TextHeight('X');
pozycja.x := ClientRect.Left+2; // 2 - margines
licznik := licznik+1;
end
else
begin
TextOut(pozycja.x, pozycja.y, Caption[licznik]);
pozycja.x:=pozycja.x+TextWidth(Caption[licznik]); // ustal nowa pozycje
end;
end
else // pojawił się znacznik
begin

if licznik+2<=Length(Caption) then
begin
case Caption[licznik+1] of // ustawienie stylu zależnie od znacznika
'b': if Font.Style=Font.Style+[fsBold] then Font.Style:=Font.Style-[fsBold]
else Font.Style:=Font.Style+[fsBold];
'i': if Font.Style=Font.Style+[fsItalic] then Font.Style:=Font.Style-[fsItalic]
else Font.Style:=Font.Style+[fsItalic];
'u': if Font.Style=Font.Style+[fsUnderline] then Font.Style:=Font.Style-[fsUnderline]
else Font.Style:=Font.Style+[fsUnderline];
's': if Font.Style=Font.Style+[fsStrikeOut] then Font.Style:=Font.Style-[fsStrikeOut]
else Font.Style:=Font.Style+[fsStrikeOut];
'0': Font.Color:=clBlack;
'1': Font.Color:=clRed;
'2': Font.Color:=clBlue;
'3': Font.Color:=clGreen;
'4': Font.Color:=clAqua;
'5': Font.Color:=clFuchsia;
'6': Font.Color:=clLime;
'7': Font.Color:=clPurple;
'8': Font.Color:=clMaroon;
'9': Font.Color:=clWhite;
end;
licznik:=licznik+2;
end;
end;

until licznik>=Length(Caption);
end;
end;

private:
function MaxHW (Tekst: string): TPoint;

function TCodeHint.MaxHW(Tekst: string): TPoint;
var
pozycja: integer;
licznik: integer;
Max: TPoint;
Plotno: TBitmap;
begin

// ustalamy maksymalna szerokość i wysokość tekstu w hint

Plotno:=TBitmap.Create;
try
Plotno.Width:=10; // rozmiary nie są istotne
Plotno.Height:=10;

Plotno.Canvas.Font.Assign(Form1.Font); // przypisanie czcionki

pozycja:=2;
licznik:=0;
Max.x:=0; // wyzerowaie pozycji x
Max.y:=0; // wyzerowanie pozycji y

with Plotno.Canvas do // symulacja rysowania
begin
Font.Color:=clBlack;
Font.Style:=[];
Max.y:=2+TextHeight('X'); // wstępne ustalenie wysokości
repeat
licznik:=licznik+1;
if Tekst[licznik] <> '<' then
begin
if (Tekst[licznik]=Chr(13)) and (Tekst[licznik+1]=Chr(10)) then
begin
if Max.x<pozycja then Max.x:=pozycja;
Max.y:=Max.y+TextHeight('X');
pozycja:=2; // wyzerowanie pozycji x
licznik:=licznik+1;
end
else
begin
pozycja:=pozycja+TextWidth(Tekst[licznik]); // ustal nowa pozycje
end;
end
else // pojawił się znacznik
begin

if licznik+2<=Length(Tekst) then
begin
case Tekst[licznik+1] of // ustawienie stylu zależnie od znacznika
'b': if Font.Style=Font.Style+[fsBold] then Font.Style:=Font.Style-[fsBold]
else Font.Style:=Font.Style+[fsBold];
'i': if Font.Style=Font.Style+[fsItalic] then Font.Style:=Font.Style-[fsItalic]
else Font.Style:=Font.Style+[fsItalic];
'u': if Font.Style=Font.Style+[fsUnderline] then Font.Style:=Font.Style-[fsUnderline]
else Font.Style:=Font.Style+[fsUnderline];
's': if Font.Style=Font.Style+[fsStrikeOut] then Font.Style:=Font.Style-[fsStrikeOut]
else Font.Style:=Font.Style+[fsStrikeOut];
// '0' .. '9' są nieistotne z pkt widzenia szerokości
end;
licznik:=licznik+2;

end;
end;

if Max.x<pozycja then Max.x:=pozycja;
until licznik>=Length(Tekst);

end;
finally
Plotno.Free; // zwolnienie bitmapy
end;
Result:=Max;
end;

procedure TCodeHint.ActivateHint (ARect: TRect; const AHint: string);
var
Rozmiar: TPoint;
PozycjaHinta: TPoint;
begin

// ustalamy rozmiar i właściwości hinta
Canvas.Font.Assign(Form1.Font);

Caption := AHint;

Rozmiar := MaxHW(AHint);

ARect.Right := ARect.Left + Rozmiar.x+4; // 4 - margines lewi i prawy
ARect.Bottom:= ARect.Top + Rozmiar.y+4; // 4 - margines górny i dolny

BoundsRect := ARect;

PozycjaHinta := ClientToScreen(Point(0, 0));

SetWindowPos(Handle, HWND_TOPMOST, PozycjaHinta.X, PozycjaHinta.Y, 0, 0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE); // wyświetlamy hinta
end;

(***********************************************)
(* *)
(*TCodeHint *)
(* Copyright (c) 2003 by Rafał J. Łabudek <21.04.2003> *)
(* E - mail: mrrafi@interia.pl *)
(* *)
(***********************************************)
unit ColorHint;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;

type
TForm1=class(TForm)
procedure FormCreate(Sender: