ListBox degradado

[roman]

En principio, esta rutina te dibujará un gradiente simple entre dos colores:

Código Delphi [-]
procedure GradientRect(DC: HDC; R: TRect; Color1, Color2: TColor);
var
  Vertices: array[0..1] of TTriVertex;
  Rect: TGradientRect;
  Color: Integer;

begin
  Color := ColorToRgb(Color1);
  Vertices[0].X := R.Left;
  Vertices[0].Y := R.Top;
  Vertices[0].Red := $100*GetRValue(Color);
  Vertices[0].Green := $100*GetGValue(Color);
  Vertices[0].Blue := $100*GetBValue(Color);
  Vertices[0].Alpha := 0;

  Color := ColorToRgb(Color2);
  Vertices[1].X := R.Right;
  Vertices[1].Y := R.Bottom;
  Vertices[1].Red := $100*GetRValue(Color);
  Vertices[1].Green := $100*GetGValue(Color);
  Vertices[1].Blue := $100*GetBValue(Color);
  Vertices[1].Alpha := 0;

  Rect.UpperLeft := 0;
  Rect.LowerRight := 1;

  GradientFill(DC, Vertices[0], 2, @Rect, 1, GRADIENT_FILL_RECT_H);
end;

La rutina recibe el identificador del canvas sobre el que vas a dibujar, el rectángulo del canvas donde vas a pintar el gradiente y los colores inicial y final del gradiente.

Sin embargo, en Delphi7, y creo que también en Delphi6, hay un error en la definición del tipo TTriVertex:

Código Delphi [-]
TTriVertex = record
  X, Y: LongInt;
  Red: COLOR16;
  Green: COLOR16;
  Blue: COLOR16;
  Alpha: COLOR16;
end;

o, mejor dicho, en la definición de COLOR16. Está declarado como ShortInt cuando debe ser Word. No sé si esto se corrigió en algún parche y de hecho no sé si tengo instalados los parches. El caso es que, dado que los tipos de datos son de tamaño distinto, la función GradientFill se confunde.

Para arreglarlo deberás redeclarar TTriVertex:

Código Delphi [-]
TTriVertex = record
  X, Y: LongInt;
  Red: Word;
  Green: Word;
  Blue: Word;
  Alpha: Word;
end;

y entonces reimportar la función GradientFill con:

Código Delphi [-]
function GradientFill(DC: HDC; var Vertex: TTriVertex; NumVertex: ULONG; Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; external msimg32;

Con esta rutina, puedes implementar el evento OnDrawItem de un ListBox:

Código Delphi [-]
procedure TForm1.ListBox1DrawItem(...);
begin
  if odSelected in State
    then GradientRect(Listbox1.Canvas.Handle, Rect, clNavy, clWhite)
    else ListBox1.Canvas.FillRect(Rect);

  ListBox1.Canvas.Brush.Style := bsClear;
  ListBox1.Canvas.TextOut(Rect.Left + 1, Rect.Top + 1, ListBox1.Items[Index]);
end;

con lo que obtendrás el efecto deseado: la selección, en lugar de un color sólido será un gradiente.

// Saludos