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

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

Delphi控件源码

开发平台：

Delphi

PopForm.pas：源码内容
  1. unit PopForm;
  3. interface
  5. uses
  6.   SysUtils, Windows, Classes, Graphics, Forms, Controls,
  7.   StdCtrls, Menus, Dialogs, ExtCtrls;
  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 *.DFM}
  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.   // add dynamic items
  60.   PopupMenu2.Items.Add (NewLine);
  61.   PopupMenu2.Items.Add (NewItem (TimeToStr (Now),
  62.     0, False, True, nil, 0, ''));
  63.   // show popup
  64.   ScreenPoint := ClientToScreen (MousePos);
  65.   PopupMenu2.Popup (ScreenPoint.X, ScreenPoint.Y);
  66.   Handled := True;
  67.   // remove dynamic items
  68.   PopupMenu2.Items [4].Free;
  69.   PopupMenu2.Items [3].Free;
  70. end;
  72. procedure TFormPopup.Left2Click(Sender: TObject);
  73. begin
  74.   Label1.Alignment := taLeftJustify;
  75.   (Sender as TMenuItem).Checked := True;
  76. end;
  78. procedure TFormPopup.Center2Click(Sender: TObject);
  79. begin
  80.   Label1.Alignment := taCenter;
  81. end;
  83. procedure TFormPopup.Right2Click(Sender: TObject);
  84. begin
  85.   Label1.Alignment := taRightJustify;
  86. end;
  88. procedure TFormPopup.BackColor2Click(Sender: TObject);
  89. begin
  90.   ColorDialog1.Color := Label3.Color;
  91.   if ColorDialog1.Execute then
  92.     Label3.Color := ColorDialog1.Color;
  93. end;
  95. procedure TFormPopup.Label2ContextPopup(Sender: TObject;
  96.   MousePos: TPoint; var Handled: Boolean);
  97. begin
  98.   ColorDialog1.Color := Label2.Color;
  99.   if ColorDialog1.Execute then
  100.     Label2.Color := ColorDialog1.Color;
  101.   Handled := True;
  102. end;
  104. end.