Home: Code Repository: Mastering Delphi 5

Project CUSTPOP

Project Structure

CUSTPOP.DPR
POPFORM.PAS
POPFORM.DFM

program CustPop;

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

{$R *.RES}

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

unit PopForm;

interface

uses
  SysUtils, Windows, Classes, Graphics, Forms, Controls,
  StdCtrls, Menus, Dialogs, ExtCtrls;

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 *.DFM}

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
  // add dynamic items
  PopupMenu2.Items.Add (NewLine);
  PopupMenu2.Items.Add (NewItem (TimeToStr (Now),
    0, False, True, nil, 0, ''));
  // show popup
  ScreenPoint := ClientToScreen (MousePos);
  PopupMenu2.Popup (ScreenPoint.X, ScreenPoint.Y);
  Handled := True;
  // remove dynamic items
  PopupMenu2.Items [4].Free;
  PopupMenu2.Items [3].Free;
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
  Caption = 'Change Color and Alignment'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnMouseDown = Label3MouseDown
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 0
    Top = 0
    Width = 447
    Height = 50
    Align = alTop
    Alignment = taCenter
    Caption = 'Big Label'
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -44
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    OnContextPopup = Label1ContextPopup
  end
  object Label2: TLabel
    Left = 0
    Top = 282
    Width = 447
    Height = 33
    Align = alBottom
    Alignment = taCenter
    Caption = 'Second Label'
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -29
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    OnContextPopup = Label2ContextPopup
  end
  object Label3: TLabel
    Left = 0
    Top = 50
    Width = 447
    Height = 232
    Align = alClient
    Color = clGray
    ParentColor = False
    OnMouseDown = Label3MouseDown
  end
  object ColorDialog1: TColorDialog
    Ctl3D = True
    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