Sujet Précédent Sujet Suivant

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

denisbertin Messages postés 245 Date d'inscription lundi 22 avril 2013 Statut Membre Dernière intervention 13 mai 2023 - 27 juil. 2020 à 13:43
denisbertin Messages postés 245 Date d'inscription lundi 22 avril 2013 Statut Membre Dernière intervention 13 mai 2023 - 10 août 2020 à 08:48
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

Réponse 1 / 3
papyvore Messages postés 223 Date d'inscription samedi 15 novembre 2003 Statut Membre Dernière intervention 16 décembre 2021 15
Modifié le 30 juil. 2020 à 23:58
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.

1
denisbertin Messages postés 245 Date d'inscription lundi 22 avril 2013 Statut Membre Dernière intervention 13 mai 2023 1
Modifié le 10 août 2020 à 08:49
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.
0
Réponse 2 / 3
cs_yanb Messages postés 271 Date d'inscription lundi 27 octobre 2003 Statut Membre Dernière intervention 7 juillet 2022 14
31 juil. 2020 à 10:50
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;


@+
1
denisbertin Messages postés 245 Date d'inscription lundi 22 avril 2013 Statut Membre Dernière intervention 13 mai 2023 1
Modifié le 2 août 2020 à 05:05
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}
0
Réponse 3 / 3
denisbertin Messages postés 245 Date d'inscription lundi 22 avril 2013 Statut Membre Dernière intervention 13 mai 2023 1
30 juil. 2020 à 09:04
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.
0

Discussions similaires

Convertir un code hexadecimal en couleur
cs_rappeur -
Arthenius -

14 réponses
Couleur de fond d'une cellule excel
lorre0041 -
isophie -

7 réponses
[Photoshop] : Image noir et blanc en image blanc et noir ?
kristoufiol -
titoine2000 -

4 réponses
menu en c
sebz10 -
decricri62 -

4 réponses
comment créer un sous menu
msi79 -
msi79 -

8 réponses
Rejoignez-nous