Tlablel et TPopupmenuRésolu

Question

apres plusieurs recherche comment fait on pour afficher un menupopup en dessous d1 tlabel lorsque l on clique dessus

et comment fait ton pour changer de couleur lorsque l'on survole le tlabel 

cordialement

Cirec · Accepted Answer

ben tu poses un TPopupMenu sur la fiche .. tu le complètes comme tu veux .. et dans l'inspecteur d'objets tu sélectionnes le Label et tu cliques à droite de la propriété "PopupMenu" (sur la petite flèche) et tu sélectionnes le PopupMenu et voilà

le popupmenu s'ouvre en faisant un contextuel sur le Label 

si tu veux qu'il souvre au clique gauche il faut mettre ce code dans le OnClick du Label:

procedure TForm1.Label1Click(Sender: TObject);
[b]begin
  /bPopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;



[hr]@+Cirec
[hr]

Cirec · Answer

à partir de Delphi7 le TLabel possède une propriété "PopupMenu" et deux évènements "OnMouseEnter" & "OnMouseLeave" 

ce qui répond à tes attentes  


[hr]@+Cirec
[hr]

eclems · Answer

merci cirec
pourrais tu me faire un petit exemple concretement

eclems · Answer

en regardand de mon coter j'ai pu trouver ceci :=>
procedure TForm1.lblLogMouseEnter(Sender: TObject);
begin
  lblLog.Font.Color := clBlue;
  lblLog.Font.Style := [fsBold];
end;

procedure TForm1.lblLogMouseLeave(Sender: TObject);
begin
lblLog.Font.Color := $00E8E8E8;
lblLog.Font.Style := [];
end;

mais maintenant je n'arrive pas a afficher le popupmenu sur le mon label

je bloque un peut 
si quelqu'un pouvais m'aider 

cordialement

eclems · Answer

EN DEMMANDANT A UN AMIS IL MA OFFERT CETTE UNITER QUI REPONDAIT A MES ATTENTE JE VOUS LA COMMUNIQUE unit xOCLabel; interface uses Windows, classes, Messages, SysUtils, Graphics, Controls, Forms, Dialogs, StdCtrls; type TXOCPosition = (PLeft,PEnter,PMDown,PMUp); TXOCEventLABEL = procedure(Sender: TObject;_Rect: TRect;_CA:TCanvas;_Position:TXOCPosition;_Text:string;_SELECTED:Boolean) of object; TExoSeeLabel = class(TLabel) private MLeave : TNotifyEvent; MEnter : TNotifyEvent; FOnDrawXOCLABEL: TXOCEventLABEL; FShadowCOLOR : TColor; F__ColorOVER : TColor; F__OriginalFontCOLOR : TColor; FXLShadowSpace : Integer; F__HintLabel : TLabel; procedure _SetShadowCOLOR(Val:TColor); procedure _Set__ColorOVER(Val:TColor); procedure _SetXLShadowSpace(Val:Integer); procedure FFFontChanged(var Message: TMessage); message CM_FONTCHANGED; protected procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure _DrawText(var Rect: TRect; Flags: Longint); procedure Paint; override; public FXOCPosition : TXOCPosition; Is_SelecTed : Boolean; constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property OnDrawXOCLABEL: TXOCEventLABEL read FOnDrawXOCLABEL write FOnDrawXOCLABEL; property OnMouseLeave: TNotifyEvent read MLeave write MLeave; property OnMouseEnter: TNotifyEvent read MEnter write MEnter; property ShadowCOLOR: TColor read FShadowCOLOR write _SetShadowCOLOR; property __ColorOVER: TColor read F__ColorOVER write _Set__ColorOVER; property XLShadowSpace : Integer read FXLShadowSpace write _SetXLShadowSpace; property __HintLabel : TLabel read F__HintLabel write F__HintLabel; end; procedure Register; implementation procedure Register; begin RegisterComponents('Vcl++', [TExoSeeLabel]); end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ constructor TExoSeeLabel.Create(AOwner: TComponent); begin inherited Create(AOwner); ShadowCOLOR := clNone; ShowAccelChar:=false; FXLShadowSpace:=1; FXOCPosition:=PLeft; Is_SelecTed :=false; end; //------------------------------------------------------------------------------ destructor TExoSeeLabel.Destroy; begin inherited Destroy; end; //------------------------------------------------------------------------------ procedure TExoSeeLabel.MouseLeave(var Message: TMessage); begin if Assigned(F__HintLabel) then F__HintLabel.Caption:=''; if (F__ColorOVER<>clNone) then begin FXLShadowSpace:=1; Font.Color:=F__OriginalFontCOLOR; Invalidate; end; if Assigned (MLeave) then MLeave(Self); end; //------------------------------------------------------------------------------ procedure TExoSeeLabel.MouseEnter(var Message: TMessage); begin if Assigned(F__HintLabel) then F__HintLabel.Caption:=Hint; if (F__ColorOVER<>clNone) then begin F__OriginalFontCOLOR:=Font.Color; FXLShadowSpace:=2; Font.Color:=F__ColorOVER; Invalidate; end; if Assigned (MEnter) then MEnter(Self); end; //------------------------------------------------------------------------------ procedure TExoSeeLabel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // if (F__ColorOVER<>clNone) then begin FXLShadowSpace:=1; Invalidate; inherited; Font.Color:=F__OriginalFontCOLOR; end; end; (* *) //------------------------------------------------------------------------------ procedure TExoSeeLabel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (F__ColorOVER<>clNone) then begin Invalidate; inherited; end; end; //------------------------------------------------------------------------------ procedure TExoSeeLabel._DrawText(var Rect: TRect; Flags: Longint); var Text: string; begin Text := GetLabelText; // if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and // (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' '; if not ShowAccelChar then Flags := Flags or DT_NOPREFIX; Flags := Flags or DT_END_ELLIPSIS or DT_PATH_ELLIPSIS; Flags := DrawTextBiDiModeFlags(Flags); Canvas.Font := Font; if not Enabled then begin OffsetRect(Rect, FXLShadowSpace, FXLShadowSpace); Canvas.Font.Color := $00B7B7B7; DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); OffsetRect(Rect, -FXLShadowSpace, -FXLShadowSpace); Canvas.Font.Color := $005F5F5F; DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); end else begin if FShadowCOLOR<>clNone then begin OffsetRect(Rect, FXLShadowSpace, FXLShadowSpace); Canvas.Font.Color :=FShadowCOLOR; DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); OffsetRect(Rect, -FXLShadowSpace, -FXLShadowSpace); Canvas.Font.Color :=Font.Color; end; DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); end; end; //------------------------------------------------------------------------------ procedure TExoSeeLabel.Paint; const Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER); WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK); var Rect: TRect; DrawStyle: Longint; begin with Canvas do begin Rect := ClientRect; //if Assigned(FOnDrawXOCLABEL)then FOnDrawXOCLABEL(Self,Rect,Canvas,FXOCPosition,Caption,Is_SelecTed) //else begin if not Transparent then begin Brush.Color := Self.Color; Brush.Style := bsSolid; FillRect(Rect); end; Brush.Style := bsClear; DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment]; _DrawText(Rect, DrawStyle); end; end; //end; //------------------------------------------------------------------------------ procedure TExoSeeLabel._SetShadowCOLOR(Val:TColor); begin FShadowCOLOR:=val; Invalidate; end; //------------------------------------------------------------------------------ procedure TExoSeeLabel._Set__ColorOVER(Val:TColor); begin F__ColorOVER:=Val; Invalidate; end; //------------------------------------------------------------------------------ procedure TExoSeeLabel._SetXLShadowSpace(Val:Integer); begin FXLShadowSpace:=val; Invalidate; end; //------------------------------------------------------------------------------ procedure TExoSeeLabel.FFFontChanged(var Message: TMessage); begin inherited; end; end.

Tlablel et TPopupmenu

5 réponses

Votre réponse

Discussions similaires