Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 06 - Project QCustPop

Project Structure

QCustPop.dpr
program QCustPop;

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

{$R *.res}

begin
  Application.CreateForm(TFormPopup, FormPopup);
  Application.Run;
end.
PopForm.pas
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.
PopForm.xfm
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