Project Structure

• QCustPop.dpr
• PopForm.pas
• PopForm.dfm

program QCustPop;

uses
  QForms,
  PopForm in 'PopForm.pas' {FormPopup}; {FormColorText}

{$R *.res}

begin
  Application.CreateForm(TFormPopup, FormPopup);
  Application.Run;
end.

unit PopForm;

interface

uses
  SysUtils, Qt, Classes, QGraphics, QForms, QControls,
  QStdCtrls, QMenus, QDialogs, QExtCtrls, Types, QTypes;

type
  TFormPopup = class(TForm)
    ColorDialog1: TColorDialog;
    PopupMenu1: TPopupMenu;
    BackColor2: TMenuItem;
    PopupMenu2: TPopupMenu;
    Left2: TMenuItem;
    Center2: TMenuItem;
    Right2: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Label3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure Left2Click(Sender: TObject);
    procedure Center2Click(Sender: TObject);
    procedure Right2Click(Sender: TObject);
    procedure BackColor2Click(Sender: TObject);
    procedure Label2ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
  end;

var
  FormPopup: TFormPopup;

implementation

{$R *.xfm}

procedure TFormPopup.Label3MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ClientPoint, ScreenPoint: TPoint;
begin
  if Button = mbRight then
  begin
    ClientPoint.X := X;
    ClientPoint.Y := Y;
    ScreenPoint := Label3.ClientToScreen (ClientPoint);
    PopupMenu1.Popup (ScreenPoint.X, ScreenPoint.Y)
  end;
end;

procedure TFormPopup.Label1ContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var
  ScreenPoint: TPoint;
begin
  // FIX for the CLX version only
  if PopupMenu2.Items.Count = 3 then
  begin
    // add dynamic items
    PopupMenu2.Items.Add (NewLine);
    PopupMenu2.Items.Add (NewItem (TimeToStr (Now),
      0, False, True, nil, 0, ''));
  end;
  // show popup
  ScreenPoint := ClientToScreen (MousePos);
  PopupMenu2.Popup (ScreenPoint.X, ScreenPoint.Y);
  Handled := True;
  // remove dynamic items (FIXED for CLX)
  if PopupMenu2.Items.Count > 3 then
  begin
    PopupMenu2.Items [4].Free;
    PopupMenu2.Items [3].Free;
  end;
end;

procedure TFormPopup.Left2Click(Sender: TObject);
begin
  Label1.Alignment := taLeftJustify;
  (Sender as TMenuItem).Checked := True;
end;

procedure TFormPopup.Center2Click(Sender: TObject);
begin
  Label1.Alignment := taCenter;
end;

procedure TFormPopup.Right2Click(Sender: TObject);
begin
  Label1.Alignment := taRightJustify;
end;

procedure TFormPopup.BackColor2Click(Sender: TObject);
begin
  ColorDialog1.Color := Label3.Color;
  if ColorDialog1.Execute then
    Label3.Color := ColorDialog1.Color;
end;

procedure TFormPopup.Label2ContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
  ColorDialog1.Color := Label2.Color;
  if ColorDialog1.Execute then
    Label2.Color := ColorDialog1.Color;
  Handled := True;
end;

end.

object FormPopup: TFormPopup
  Left = 270
  Top = 112
  Width = 455
  Height = 342
  VertScrollBar.Range = 83
  Caption = 'Change Color and Alignment'
  Color = clButton
  Font.CharSet = fcsLatin1
  Font.Color = clBlack
  Font.Height = 11
  Font.Name = 'MS Sans Serif'
  Font.Pitch = fpVariable
  Font.Style = []
  Font.Weight = 40
  ParentFont = False
  OnMouseDown = Label3MouseDown
  PixelsPerInch = 96
  TextHeight = 13
  TextWidth = 6
  object Label1: TLabel
    Left = 0
    Top = 0
    Width = 455
    Height = 50
    Align = alTop
    Alignment = taCenter
    Caption = 'Big Label'
    Font.CharSet = fcsLatin1
    Font.Color = clBlack
    Font.Height = 44
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnContextPopup = Label1ContextPopup
  end
  object Label2: TLabel
    Left = 0
    Top = 309
    Width = 455
    Height = 33
    Align = alBottom
    Alignment = taCenter
    Caption = 'Second Label'
    Font.CharSet = fcsLatin1
    Font.Color = clBlack
    Font.Height = 29
    Font.Name = 'Arial'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    OnContextPopup = Label2ContextPopup
  end
  object Label3: TLabel
    Left = 0
    Top = 50
    Width = 455
    Height = 259
    Align = alClient
    Color = clGray
    ParentColor = False
    OnMouseDown = Label3MouseDown
  end
  object ColorDialog1: TColorDialog
    Left = 32
    Top = 72
  end
  object PopupMenu1: TPopupMenu
    AutoPopup = False
    Left = 32
    Top = 128
    object BackColor2: TMenuItem
      Caption = '&Back Color...'
      OnClick = BackColor2Click
    end
  end
  object PopupMenu2: TPopupMenu
    AutoPopup = False
    Left = 32
    Top = 184
    object Left2: TMenuItem
      Caption = '&Left'
      GroupIndex = 1
      RadioItem = True
      ShortCut = 16460
      OnClick = Left2Click
    end
    object Center2: TMenuItem
      Caption = '&Center'
      Checked = True
      GroupIndex = 1
      RadioItem = True
      ShortCut = 16451
      OnClick = Center2Click
    end
    object Right2: TMenuItem
      Caption = '&Right'
      GroupIndex = 1
      RadioItem = True
      ShortCut = 16466
      OnClick = Right2Click
    end
  end
end