Zmiana koloru obramowania GroupBoxa

W odpowiedzi na post z forum tej strony dotyczący zmiany koloru obramowania GroupBox'a napisałem procedurkę ColorGroupBox(). Żądany efekt daje ona jednak tylko w Windows XP na formie z komponentem XPManifest. Stosując tę procedurę w swoim programie pamiętajcie więc o sprawdzeniu jaki system operacyjny posiada użytkownik oraz o wstawieniu na formę komponentu XPManifest (zakładka Win32). W innym przypadku efekt nie będzie zadowalający.

Oto treść procedury:

procedure ColorGroupBox(GroupBox : TGroupBox; Color : TColor);
var TextWdh : Integer;
    Rigth,Bottom : Integer;
    C : TCanvas;
begin
 
C := TCanvas.Create;
C.Handle := GetDC(GroupBox.Handle);
 
// Pobranie długości Caption'a w pikselach
C.Font := GroupBox.Font;
TextWdh := C.TextWidth(GroupBox.Caption);
 
C.Pen.Color := Color;
 
Rigth := GroupBox.Width;
Bottom := GroupBox.Height;
 
  if GroupBox.Caption <>

<font face="Courier New" color="blue">''</span>

 then
    begin
      C.MoveTo(2,6);
      C.LineTo(8,6);
 
      C.MoveTo(TextWdh+8,6);
      C.LineTo(Rigth-2,6);
 
      C.MoveTo(Rigth-3,6);
      C.LineTo(Rigth-3,8);
 
      C.MoveTo(Rigth-2,7);
      C.LineTo(Rigth-2,9);
 
      C.MoveTo(Rigth-1,8);
      C.LineTo(Rigth-1,Bottom-2);
    end else
 
    begin
      C.MoveTo(2,0);
      C.LineTo(Rigth-2,0);
 
      C.MoveTo(Rigth-3,0);
      C.LineTo(Rigth-3,2);
 
      C.MoveTo(Rigth-2,1);
      C.LineTo(Rigth-2,3);
 
      C.MoveTo(Rigth-1,2);
      C.LineTo(Rigth-1,Bottom-2);
    end;
 
C.MoveTo(Rigth-2,Bottom-2);
C.LineTo(Rigth-2,Bottom-4);
 
C.MoveTo(Rigth-3,Bottom-1);
C.LineTo(Rigth-3,Bottom-3);
 
C.MoveTo(2,Bottom-1);
C.LineTo(Rigth-3,Bottom-1);
 
C.MoveTo(2,Bottom-1);
C.LineTo(2,Bottom-3);
 
C.MoveTo(1,Bottom-2);
C.LineTo(1,Bottom-4);
 
  if GroupBox.Caption <> '' then
    begin
      C.MoveTo(0,Bottom-3);
      C.LineTo(0,7);
 
      C.MoveTo(1,7);
      C.LineTo(1,9);
 
      C.MoveTo(2,7);
      C.LineTo(2,6);
    end else
 
    begin
      C.MoveTo(0,Bottom-3);
      C.LineTo(0,1);
 
      C.MoveTo(1,1);
      C.LineTo(1,3);
 
      C.MoveTo(2,1);
      C.LineTo(2,0);
    end;
 
end;

Przykład użycia:

ColorGroupBox(GroupBox1,clRed);

Powrót do domyślnego koloru (dla początkujących):

GroupBox1.Repaint;

Jako załącznik do artykułu dodałem kod źródłowy przykładowego pogramu stosującego tę procedurę.