Cambiar Letra en el Menu y conservar la Imagen

[ing_alsaac]

Hola a Todos:
Ya habia pedido su ayuda para este tema
y me recomendaron usar el evento OnDrawItem y OnMeasureItem
de la opcion para cambiar el tipo de letra,
el problema ahora fue de que trate de poner una imagen
dentro de la opción del menu pero no me la hace visible
por esos eventos, osea que puedo usar las imagenes
pero tengo que conservar el tamaño de
letra original del menu o puedo cambiar el tipo de letra
pero no puedo ver las imagenes que inserte en las opciones.
Ojala Puedan Ayudarme.

Laso opciones quedaban asi

procedure TForm1.Opciones1DrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
begin
with ACanvas do
begin
Font.Name:='Arial';
Font.Color:=clblack;
font.Size:=10;
DrawText(Handle,PChar((Sender as TMenuItem).Caption),-1,ARect,DT_VCENTER);
end;
end;

procedure TForm1.Opciones1MeasureItem(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);
begin
Width:=180;
Height:=30;
end;

[delphi.com.ar]

Si dibujás el texto "a mano", vas a tener que dibujar la imagen, podrías hacer un StretchDraw a la izquierda del ARect y luego dibujar el texto teniendo en cuenta el espacio utilizado por la imagen.

Saludos!

[andres1569]

Hola:

Aquí te envío un código que hace lo que tú quieres. Este código mira si hay un TImageList asociado al ParentMenu y dibuja la imagen correspondiente a la izquierda del texto. También tiene en cuenta algunas variables, tales como si el MenuItem está seleccionado, para dibujarlo de otro color, o si está Enabled a FALSE, para pintar la imagen y el texto en gris. En el evento OnMeasureItem también cambia el tipo de letra para ajustar las medidas al texto solicitado y mira si hay un TImageList asociado, de forma que al pintar el objeto no tengamos que hacer un StretchDraw sino que tanto la imagen como el texto ya quepan de antemano.

Hay casos que no están contemplados aquí, como si asignas un Bitmap directamente al MenuItem, o la alineación en caso de que sea un PopupMenu, o si Checked es TRUE, etc... si miras el código fuente de los Menus en la VCL verás que las rutinas DrawItem y MeasureItem ocupan un puñado de líneas porque controlan muchas posibilidades; en líneas generales este código puede ser útil la mayoría de veces. ¡Ah! si pones una línea de separación mediante el guión '-', no llames en este MenuItem a ninguno de estos eventos, así Delphi se encarga de dibujar la raya horizontal.

procedure TForm1.M_Abrir1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  AImgList : TCustomImageList;
  OffY : Integer;
begin
  with TMenuItem(Sender) do
  begin
    if Selected then ACanvas.Brush.Color := clHighLight
    else ACanvas.Brush.Color := clMenu;
    ACanvas.Brush.Style := bsSolid;
    ACanvas.FillRect (ARect);
    Inc (ARect.Left, 2);
    AImgList := GetParentMenu.Images;
    if Assigned(AImgList) then
    begin
      OffY := ((ARect.Bottom - ARect.Top) - AImgList.Height) div 2;
      AImgList.Draw (ACanvas, ARect.Left, ARect.Top + OffY, ImageIndex, Enabled);
      Inc (ARect.Left, AImgList.Width + 4);
    end;
    OffY := ((ARect.Bottom - ARect.Top) - ACanvas.TextHeight('M')) div 2;
    Inc (ARect.Top, OffY);
    ACanvas.Font.Name := 'Arial';
    if NOT Enabled then ACanvas.Font.Color := clGrayText
    else if Selected then ACanvas.Font.Color := clHighLightText
    else ACanvas.Font.Color := clMenuText;
    ACanvas.Brush.Style := bsClear;
    ACanvas.Font.Size := 16;
    DrawText(ACanvas.Handle, PChar(Caption), -1, ARect, DT_LEFT);
  end;
end;


procedure TForm1.M_Abrir1MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  AImgList : TCustomImageList;
begin
  ACanvas.Font.Name := 'Arial';
  ACanvas.Font.Size := 16;
  Height := ACanvas.TextHeight ('M') + 4;
  Width := ACanvas.TextWidth (TMenuItem(Sender).Caption) + 2;
  AImgList := TMenuItem(Sender).GetParentMenu.Images;
  if Assigned(AImgList) then
  begin
    if Height < AImgList.Height - 4 then Height := AImgList.Height + 4;
    Width := Width + AImgList.Width + 4;
  end;
end;

Salu2

[jusnjosesch]

Probé tu código y andubo muy bien. Incluso, le pude agregar la manera de que marque los checked.
Sin embargo, no es demasiado aplicable, porque la parte del menú que no tiene items queda del color clBtnFace, lo cual no es muy estético que digamos.
Hay alguna forma de pintar el espacio del menú no asignado a items, o de limitarlo en tamaño al espacio utilizado?
La verdad, yo no la encuentro, si existe, agradeceré me la enseñes.
Gracias de antemano.