Bonjour, est ce que quelqu'un sait comment faire pour changer la couleur du menu

Signaler
Messages postés
221
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
10 août 2020
-
Messages postés
221
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
10 août 2020
-
Bonjour, est ce que quelqu'un sait comment faire pour changer la couleur du menu

dans le langage de l'API de Windows et les propriétés d'affichage d'un menu créé

avec les fonctions de l'Api de Windows comme AppendMenu, SetMenu etc ... ?

Denis A+plus.

3 réponses

Messages postés
193
Date d'inscription
samedi 15 novembre 2003
Statut
Membre
Dernière intervention
8 août 2020
7
salut
mettre OwnerDraw à true et pour chaque item sa couleur si tu veut ,
ou reprendre la même procedure pour les items que tu choisi
procedure NomItemDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
  LeftPos: Integer;
  TopPos: Integer;
  TextLength: Integer;
  Text: string;
begin
  Text := (Sender as TMenuItem).Caption;
  if Selected then
    ACanvas.Brush.Color := clGreen
  else
   ACanvas.Brush.Color := clBlue;
  ACanvas.FillRect(ARect);
  ACanvas.Font.Color := clWhite;
  ACanvas.Font.Style := [fsBold];
  // Draw right in the middle of the menu
  TopPos := ARect.Top +
    (ARect.Bottom - ARect.Top - ACanvas.TextHeight('W')) div 2;
  TextLength := Length(Text);
  if TextLength > (ARect.Right - ARect.Left) then
    LeftPos := ARect.Left + 3
  else
    LeftPos := ARect.Left + (ARect.Right - ARect.Left -
      ACanvas.TextWidth(Text)) div 2;
  ACanvas.TextOut(LeftPos, TopPos, Text);
end;

oups je viens de relire et c'est pas ce que tu attends je laisse le post ça peut servir a d'autres.

Messages postés
221
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
10 août 2020
1
En fait après quelque recherche je me suis aperçu pour cela qu'il faudrait dériver le message wm_drawItem,
J'ai presque tout les éléments nécessaire en main, je me demande si en qualité de développeur et de conseilleur logiciel je peut vous citer avec votre pseudo sur mon site web, j'ai besoin de votre accord.
Messages postés
257
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 août 2020
9
Salut,

Les infos sur les menus API sont dans la msdn par exemple en partant des termes que tu cites
https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-appendmenua
Pour modifier le plus simple pour moi est de passer par un HBitmap
https://docs.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createcompatiblebitmap

Voici un exemple à améliorer pour avoir un point de départ dans tes recherches

private
  procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;

const
  SC_MonItem = WM_USER + 1;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  if Msg.CmdType = SC_MonItem then
    ShowMessage('Mon Message Menu Item') 
  else
    inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TempDC: Cardinal;
  MemoryDC: cardinal;
  BitmapDC: HBITMAP;
  RectDC: TRect;
  PenDC: HPEN;
  BrushDC: Cardinal;
  HFontDC: HFONT;
  nHeight: Integer;
  S: string;
begin
  AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, '');
  TempDC := GetDC(GetDesktopWindow);
  MemoryDC := CreateCompatibleDC(TempDC);  
  BitmapDC := CreateCompatibleBitmap(TempDC, 80, 18);
  try
    S := 'Mon Item';
    SelectObject(MemoryDC, BitmapDC);
    SetRect(RectDC, 0, 0, 80, 18);
    PenDC := CreatePen(PS_DOT, 1, RGB(0,128,0));
    SelectObject(MemoryDC, PenDC);
    BrushDC := CreateSolidBrush(RGB(255,255,0));
    SelectObject(MemoryDC, BrushDC);
    Rectangle(MemoryDC, RectDC.Left, RectDC.Top, RectDC.Right, RectDC.Bottom);
    nHeight := MulDiv(10, GetDeviceCaps(MemoryDC, LOGPIXELSY), 72);
    HFontDC := CreateFont(nHeight, 0, 0, 0, FW_BOLD, 0, 1, 0, DEFAULT_CHARSET, OUT_OUTLINE_PRECIS,
                CLIP_DEFAULT_PRECIS, 0, VARIABLE_PITCH, 'Arial');
    SelectObject(MemoryDC, HFontDC);
    SetTextColor(MemoryDC, $000000FF);
    SetBkMode(MemoryDC, TRANSPARENT);
    TextOut(MemoryDC, 4, 2, PChar(S), Length(S));
    AppendMenu(GetSystemMenu(Handle, FALSE), MF_BITMAP, SC_MonItem, PChar(BitmapDC));
  finally
    DeleteObject(PenDC);
    DeleteObject(BrushDC);
    DeleteDC(MemoryDC);
    ReleaseDC(0, TempDC);
  end;
end;


@+
Messages postés
221
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
10 août 2020
1
J'écris des procédures comme celle-ci : elle permettent avec un textout que vous connaissait et qui permet de colorier des mots comme ceci, la première chaine contient PChar(S) afficher et la deuxième le mot à rechercher, celui qui va conrrespondre.

{Cette procedure permet la Colorisation Syntaxique du panneau des désignations et des périphériques - denis Bertin le 28.10.2019}
procedure text_out_find(Paintdc:hdc; x,y:integer; apc,bpc:pchar; color:tcolorref);
      var p:pchar;
          pc:wutil.pc1024;
          Size:tsize;
          alpha:tcolorref;
      begin
      if not afficher_la_colorisation_syntaxique then exit;
      strcopy(pc,apc);
      p:=strpos(pc,bpc);
      if p<>nil then
        begin
        p^:=#0;
        GetTextExtentPoint(Paintdc,pc,strlen(pc),Size);
        if color=g_base.RGB_Vert then
          if woutil.global_bool_noir_ou_blanc then
            alpha:=settextcolor(Paintdc,color)
          else
            alpha:=settextcolor(Paintdc,g_base.RGB_Vert_foncer)
        else
          alpha:=settextcolor(Paintdc,color);
        textout(Paintdc,x+Size.cx,y,bpc,strlen(bpc));
        settextcolor(Paintdc,alpha);
        end;
      end; {text_out_find}

procedure text_out_color_number(Paintdc:hdc; x,y:integer; ficelle:string; color:tcolorref);
  var i:integer; {l'itérateur de boucle, il varie de '0' à '9', avec ord qui renvoie son ordre AsCii}
      local_apc:pc10;
  begin
  if not afficher_la_colorisation_syntaxique then exit;
  for i:=ord('0') to ord('9') do
    begin
    local_apc[0]:=chr(i); local_apc[1]:=chr(0);
    text_out_find_next(Paintdc,x,y,pchar(ficelle),local_apc,color);
    end; {for i}
  text_out_find_next(Paintdc,x,y,pchar(ficelle),'.',color);
  text_out_find_next(Paintdc,x,y,pchar(ficelle),',',color);
  end; {text_out_color_number}

procedure text_out_find_next(Paintdc:hdc; x,y:integer; apc,bpc:pchar; color:tcolorref);
  var i:integer;
      p,q:pchar;
      pc:wutil.pc1024;
      Size:tsize;
      alpha:tcolorref;
  begin
      if not afficher_la_colorisation_syntaxique then exit;
      for i:=pred(strlen(apc)) downto 0 do
        begin
        strcopy(pc,apc);
        q:=@pc[i];
        p:=strpos(q,bpc);
        if p<>nil then
          begin
          p^:=#0;
          alpha:=settextcolor(Paintdc,color);
          GetTextExtentPoint(Paintdc,pc,strlen(pc),Size);
          TextOut(Paintdc,x+Size.cx,y,bpc,strlen(bpc));
          SetTextColor(Paintdc,alpha);
          end;
        end;
  end; {text_out_find_next}
Messages postés
221
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
10 août 2020
1
Bonjour, Effectivement, ce n'est pas tout a fait les fonctions que je compte utiliser
car si j'utilise bien Delphi-(7) pour compiler mon programme, j'utilise plutôt les fonctions
de Application interface de Window (API) mais je ne connait pas les fonctions qui me permettrais d'obtenir un résultat similaire ce celle du "Canvas" de Delphi.
écrit à Bourges.