开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
PopForm.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

PopForm.pas：源码内容
  1. unit PopForm;
  3. interface
  5. uses
  6.   SysUtils, Qt, Classes, QGraphics, QForms, QControls,
  7.   QStdCtrls, QMenus, QDialogs, QExtCtrls, Types, QTypes;
  9. type
  10.   TFormPopup = class(TForm)
  11.     ColorDialog1: TColorDialog;
  12.     PopupMenu1: TPopupMenu;
  13.     BackColor2: TMenuItem;
  14.     PopupMenu2: TPopupMenu;
  15.     Left2: TMenuItem;
  16.     Center2: TMenuItem;
  17.     Right2: TMenuItem;
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     Label3: TLabel;
  21.     procedure Label3MouseDown(Sender: TObject; Button: TMouseButton;
  22.       Shift: TShiftState; X, Y: Integer);
  23.     procedure Label1ContextPopup(Sender: TObject; MousePos: TPoint;
  24.       var Handled: Boolean);
  25.     procedure Left2Click(Sender: TObject);
  26.     procedure Center2Click(Sender: TObject);
  27.     procedure Right2Click(Sender: TObject);
  28.     procedure BackColor2Click(Sender: TObject);
  29.     procedure Label2ContextPopup(Sender: TObject; MousePos: TPoint;
  30.       var Handled: Boolean);
  31.   end;
  33. var
  34.   FormPopup: TFormPopup;
  36. implementation
  38. {$R *.xfm}
  40. procedure TFormPopup.Label3MouseDown(Sender: TObject;
  41.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  42. var
  43.   ClientPoint, ScreenPoint: TPoint;
  44. begin
  45.   if Button = mbRight then
  46.   begin
  47.     ClientPoint.X := X;
  48.     ClientPoint.Y := Y;
  49.     ScreenPoint := Label3.ClientToScreen (ClientPoint);
  50.     PopupMenu1.Popup (ScreenPoint.X, ScreenPoint.Y)
  51.   end;
  52. end;
  54. procedure TFormPopup.Label1ContextPopup(Sender: TObject;
  55.   MousePos: TPoint; var Handled: Boolean);
  56. var
  57.   ScreenPoint: TPoint;
  58. begin
  59.   // FIX for the CLX version only
  60.   if PopupMenu2.Items.Count = 3 then
  61.   begin
  62.     // add dynamic items
  63.     PopupMenu2.Items.Add (NewLine);
  64.     PopupMenu2.Items.Add (NewItem (TimeToStr (Now),
  65.       0, False, True, nil, 0, ''));
  66.   end;
  67.   // show popup
  68.   ScreenPoint := ClientToScreen (MousePos);
  69.   PopupMenu2.Popup (ScreenPoint.X, ScreenPoint.Y);
  70.   Handled := True;
  71.   // remove dynamic items (FIXED for CLX)
  72.   if PopupMenu2.Items.Count > 3 then
  73.   begin
  74.     PopupMenu2.Items [4].Free;
  75.     PopupMenu2.Items [3].Free;
  76.   end;
  77. end;
  79. procedure TFormPopup.Left2Click(Sender: TObject);
  80. begin
  81.   Label1.Alignment := taLeftJustify;
  82.   (Sender as TMenuItem).Checked := True;
  83. end;
  85. procedure TFormPopup.Center2Click(Sender: TObject);
  86. begin
  87.   Label1.Alignment := taCenter;
  88. end;
  90. procedure TFormPopup.Right2Click(Sender: TObject);
  91. begin
  92.   Label1.Alignment := taRightJustify;
  93. end;
  95. procedure TFormPopup.BackColor2Click(Sender: TObject);
  96. begin
  97.   ColorDialog1.Color := Label3.Color;
  98.   if ColorDialog1.Execute then
  99.     Label3.Color := ColorDialog1.Color;
  100. end;
  102. procedure TFormPopup.Label2ContextPopup(Sender: TObject;
  103.   MousePos: TPoint; var Handled: Boolean);
  104. begin
  105.   ColorDialog1.Color := Label2.Color;
  106.   if ColorDialog1.Execute then
  107.     Label2.Color := ColorDialog1.Color;
  108.   Handled := True;
  109. end;
  111. end.