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ę.