Hint - Kolorowanie składni

Rav

Witam wszystkich.
O czym będzie ten artykuł? Myślę, że tytuł przemawia sam za siebie jednak sprecyzuję. Zajmiemy się hintami czyli dymkami podpowiedzi a konkretniej ich "ulepszaniem". Ostatnio byłem na Torry'm i zaciekawił mnie jeden z komponentów - HTMLHint - jest to komponent, który umożliwia m.in. stosowanie w hintach różnych kolorów czcionki, stylów, wstawianie obrazków itp. Wszystko dobrze, tylko nie darmowe...

O hintach pisał już Adam Boduch, więc nie będziemy się zajmowali samymi hintami jako takimi, lecz właśnie tymi właściwościami które wcześniej wymieniłem a więc kolorowaniem składni i stylami czcionki czyli pogrubianiem, kursywą, podkreśleniem i przekreśleniem.

Na samym początku należałoby się zastanowić nad tym w jaki sposób chcemy wykonać nasze zadanie. Oczywiście musimy stworzyć klasę pochodną od THintWindow i zająć się własnym "malowaniem" płótna hinta. Jednak wcześniej musimy zastanowić się nad tym w jaki sposób będziemy chcieli by kolory czcionki zmieniały się zgodnie z tym jak chcemy. Powiedzmy, że chcesz napisać "To jest przykładowy hint" przy czym "To" ma być czerwone "jest" fioletowe, "przykładowy" żółte i wreszcie "hint" zielone. Można by kazać programowi kodować poszczególne wyrazy właśnie tymi kolorami ale jest to bezsensowne, gdyż na przykład hint dotyczący innego komponentu chcemy kolorować w inny sposób. Musimy więc zastosować "kodowanie" hinta, które później w czasie wyświetlania będzie "rozkodowywane".
Dla naszych rozważań przyjmiemy następujące kodowanie:

<0> - kolor zerowy
<1> - kolor pierwszy
...
<9> - kolor dziewiąty
<b> - włączenie / wyłączenie pogrubienia
<u> - włączenie / wyłączenie podkreślenia
<i> - włączenie / wyłączenie kursywy
<s> - włączenie / wyłączenie przekreślenia

Jak już pewnie zdążyliście się domyślić następujące kodowanie będzie się wpisywało we właściwość HINT danego komponentu w postaci np. "<1>To <2>jest <3>przykładowy <5><b><u>hint". W porządku teraz zajmijmy się tworzeniem naszego "dymka".

 TCodeHint=class(THintWindow) 
public 
  procedure ActivateHint(ARect: TRect; const AHint: string); override; 
  procedure Paint; override; 
end; 

Zajmijmy się najpierw rysowaniem czyli procedure Paint ponieważ to przede wszystkim tutaj rozgrywa się cały główny problem. Zadeklarujemy sobie zmienną licznik typu integer, która będzie odpowiedzialna za ustalenie pozycji znaku, który obecnie analizujemy a także zmienną pozycja typu TPoint, która będzie odpowiadała za pozycję pisanego znaku na canvas hint'a.
Najpierw napiszę kod a później go omówię:

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;

Wpierw ustalamy domyślny kolor czcionki i jej styl - gdybyśmy tego nie zrobili to hint przyjmowałby taki kolor jaki był używany przy ostatnim wyświetleniu. Możesz to sprawdzić kładąc np. dwa Buttony i w hint jednego wpisać hint zakodowany a w drugim bez kodowania. Między pętlą repeat a until wykonuje się kod tak długo aż zostaną przeanalizowane wszystkie znaki. Przy każdym przejściu przez pętlę zostaje zwiększony licznik - pozycja znaku. Jeżeli napotkamy na znak "<" analizujemy czy pojawił się kod czy nie. Rozwiązujemy to sprawdzając jaki jest następny znak. Jeżeli jest to jeden z uwzględnionych przez nas znaków wówczas dokonujemy zmian w stylu czcionki lub w jej kolorze. Następnie przeskakujemy o dwa znaki (pomijamy znak ">"</code>). Jeżeli jednak to nie jest znak z naszego kodowania lub nie trafiliśmy na znak <code>"<" wówczas rysujemy go na płótnie hint'a. Tłumaczenia wymaga ta linia:

pozycja.x := pozycja.x + TextWidth(Caption[licznik]);

Jest ona po to abyśmy wiedzieli gdzie mamy rozpocząć rysowanie kolejnego znaku. Analogicznie jest z:

if (Caption[licznik]=Chr(13)) and (Caption[licznik+1]=Chr(10)) then // następna linijka hinta
           begin
             pozycja.y := pozycja.y+TextHeight('X');
...

Sprawdzamy czy znaki nie tworzą znaku następnej linii (jeżeli tego nie uwzględnimy to hint będzie wprawdzie wyświetlał dwie i więcej linijek ale tekst pojawi się tylko w pierwszej linijce).

Myślę, że powinno to być zrozumiałe. Teraz powinniśmy się zająć procedurą ActivateHint. Jednak proponuję ci dać na razie tę procedurę jako komentarz w np. w znaki {} lub //
(czyli

TCodeHint=class(THintWindow) 
public 
  // procedure ActivateHint(ARect: TRect; const AHint: string); override; 
  procedure Paint; override; 
end;

)

W FormCreate uaktywnij nasz stworzony hint:

  HintWindowClass := TCodeHint;
  Application.ShowHint := false;
  Application.ShowHint := true; 

Daj na formę jakiś Button i wpisz mu we właściwość hint: "<b>Tego hinta niestety nie widać poprawnie" i nie zapomnij ustawić mu ShowHint na True. Uruchom program. Zauważyłeś coś? Nasz hint wyświetla się ale tekst nie jest cały. Wyłącz program i wpisz we właściwość hint Buttona: "<1>To <2>jest <3>przykładowy <5><b><u>hint".

Uruchom. Super, koloruje składnię tak jak chcieliśmy. Teraz widzimy cały tekst ale niestety pojawia się duży margines z prawej strony. Dlaczego? Ponieważ Windows dobrał wielkość hinta do długości wpisanego tekstu. Zapytasz czemu więc raz jest za mały a drugim razem za długi. Już tłumaczę - za pierwszym razem pogrubialiśmy tekst a za drugim kolorowaliśmy (no i na końcu też pogrubiliśmy i podkreśliliśmy). Jak więc pewnie się domyśliłeś zależy to od rodzaju czcionki a konkretniej jej stylu. I o to chodzi. Czcionki pogrubione, kursywa mają inną szerokość niż ta sama czcionka bez pogrubienia. To jeżeli chodzi o za mały rozmiar hinta. Zaś dodatkowy margines brał się z tego, że wpisywaliśmy dodatkowe znaki, które nie były przecież później rysowane. Musimy więc jakoś rozwiązać ten problem - musimy znać rozmiar potrzebny i taki wyświetlić. Stwórzmy więc funkcję, która nam to określi i umieśćmy ją w sekcji

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&lt;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;

Myślę, że powyższy kod powinien być wystarczająco czytelny - przeprowadzamy symulację jakbyśmy rysowali na hincie, tyle, że bez pokazywania efektu - w wyniku otrzymujemy wymiary nam potrzebne

Przystąpmy więc do oprogramowania ActivateHint:

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;

Nie ma tu wiele do tłumaczenia - ustalamy rozmiar ARect na podstawie funkcji która nam wyliczyła potrzebne wymiary i zwiększamy te rozmiary o 4 (po 2 piksele z każdej strony)
Następnie wyświetlamy hinta.

Tak wygląda cały kod:

 
(***********************************************) 
(*                              *) 
(*TCodeHint                             *) 
(* Copyright (c) 2003 by Rafał J. Łabudek <21.04.2003>   *) 
(* E - mail: [email protected]              *) 
(*                              *) 
(***********************************************)
unit ColorHint;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;
 
type
  TForm1=class(TForm)
    procedure FormCreate(Sender: TObject);
    Button1: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TCodeHint=class(THintWindow) 
  private
    function MaxHW (Tekst: string): TPoint;
  public
    procedure ActivateHint(ARect: TRect; const AHint: string); override;
    procedure Paint; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TCodeHint;
  Application.ShowHint := not ShowHint; {lub jak kto woli false a potem true }
  Application.ShowHint := not ShowHint;
end;
 
procedure TCodeHint.Paint;
var
  pozycja: TPoint;
  licznik: integer;
begin
  licznik:=0;
 
  pozycja.x:=2; // marginesy lewy i górny
  pozycja.y:=2;
 
  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 := 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;
 
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);
end;
 
end.

I na tym zakończę artykuł. Myślę, że wytłumaczyłem to w przystępny sposób. Oczywiście można sobie bardziej rozbudować kodowanie aby było np. tak jak w html czyli <b> włącza pogrubienie a </b> wyłącza - myślę, że teraz nie powinno być już z tym problemu. W podobny sposób można także dodawać np. obrazki z ImageList.

Pozdrawiam wszystkich

Rav

6 komentarzy

a co bedzie jak program napotka:

"WG tego przycisku a<s będzie doskonałe"

Jeżeli napotkamy na znak "<" analizujemy czy pojawił się kod czy nie. Rozwiązujemy to sprawdzając jaki jest następny znak. Jeżeli jest to jeden z uwzględnionych przez nas znaków wówczas dokonujemy zmian w stylu czcionki lub w jej kolorze. Następnie przeskakujemy o dwa znaki (pomijamy znak ">").

Czy program sprawdza czy rzeczywiście znak > tam jest?

Trzeba poprawić, bo to zostało ze starej wersji serwisu. Ktoś chętny?

nie wiem, czy to forum czy art tak był pisany ale mam pełno „ oraz ” i jeszcze kilka podobnych, przez co art jest nieczytelny :(

Witam.
Jeśli chodzi o fajne hinty (z bajerkami) to polecam również pakiecik
JEDI VCL 2.10 for D5-D7 (http://jvcl.sourceforge.net)
a w nim komponencik o nazwie
JvBalloonHint.
Artykuł naprawdę dobry.
Pozdrofka...

Takiego artykułu szukałem :).

Wszystkie źródła w Delphi wstawiaj pomiędzy tagi <delphi> </delphi>.