ListBox degradado
 

Hola,
No hace mucho me preguntaba como obtener un color diferente de selección en un ListBox o ComboBox independientemente de aquel que viene por defecto en Windows-Apariencia, pero creo que debería de empezar a preguntar como puedo lograr crear un rectángulo pequeño CON UN COLOR DEGRADADO y sin borde, ya que obteniendo esta respuesta quizá lo pueda acomodar a la investigación de modificar la selección que presentan los componentes ListBox o ComboBox y convertir esta selección en degradado, no se si me estoy liando, pero la finalidad es obtener un ListBox o un Componente Menú del tipo del Programa Super Utilities 6.0
Alguna sugerencia?
Un saludo.

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

Hola Roman
El fin de semana acabo de revisar tu código (antes no tuve tiempo) y funciona de maravilla, un par de consultas más por favor:

1.- El gradiente de tu código va de izquierda a derecha (vertical) verdad?, ¿como puedo implementar un gradiente HORIZONTAL por decir blanco, celeste, blanco (por dar un ejemplo), son 3 colores?, voy bien?
2.- ¿Como implementar tu código en un TMenu?, para que la selección también se vea diferente

Agradecerte bastante el tiempo que te hayas tomado en confeccionar el código, disculpa las molestias, pero Yo aprendo solamente a través de los ejemplos, cuando en el TMenu quise cambiar por ejemplo así:

if odSelected in State // AQUÍ YA ME DA ERROR DE COMPILACIÓN
then GradientRect(MainMenu1.Canvas.Handle, Rect, clNavy, clWhite) //AQUÍ creo que no existe Handle
else MainMenu1.Canvas.FillRect(Rect);
etc, etc,

Un saludo

El gradiente que ejemplifiqué es horizontal, se degrada de izquierda a derecha. Color1 es el color inicial (izquierda) y Color2 el final (derecha).

Lo que tu planteas también es horizontal pero con tres puntos de degradación (desconozco el término técnico). Tendrás que investigarle a la función GradientFill así como a las estructuras de datos que usa: TRIVERTEX, GRADIENT_TRIANGLE, GRADIENT_RECTANGLE, y los modos de degradado: GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V y GRADIENT_FILL_TRIANGLE.

Yo más no sé de la función pues apenas ayer la conocí.

En cuanto a lo del menú, bueno, no esperes que con sólo copiar y pegar todo va a resultar a la primera. Ya estaría yo buscando cómo se adapta a un menú- como en efecto, acabo de hacer.

En el caso de menús, si bien TMainMenu tiene la propiedad OwnerDraw, cada item tiene su evento OnDrawItem. Lo que puedes hacer es asignar el mismo evento a todos los items:

Código Delphi [-]
procedure TForm1.MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
  Item: TMenuItem;
  Flags: Integer;

begin
  if Selected then
    GradientRect(
      ACanvas.Handle,
      ARect,
      GetSysColor(COLOR_ACTIVECAPTION),
      GetSysColor(COLOR_GRADIENTACTIVECAPTION)
    )
  else
    ACanvas.FillRect(ARect);

  Item := Sender as TMenuItem;
  Flags := DT_SINGLELINE or DT_VCENTER;
  Inc(ARect.Left, 6);

  ACanvas.Brush.Style := bsClear;
  DrawText(ACanvas.Handle, PChar(Item.Caption), Length(Item.Caption), ARect, Flags);
end;

En este ejemplo, uso como colores de degradación, los que usa el sistema para las barras de título, de manera que la selección queda similar.

Si en lugar de COLOR_ACTIVECAPTION y COLOR_GRADIENTACTIVECAPTION, usas COLOR_INACTIVECAPTION y COLOR_GRADIENTINACTIVECAPTION, obtienes los colores que usa el sistema para las barras de título inactiva (normalmente, grises).

Si en un ListBox escoges unos u otros según el ListBox tenga o no el foco, te queda un bonito efecto: degradado azul cuando tiene el foco y degradado gris cuando no lo tiene.

Y antes de que preguntes, el caso de un PopupMenu es idéntico al de un MainMenu.

// Saludos

OK, gracias roman
Probaré el nuevo código.
Un saludo