File: synpopupmenu.pas

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (131 lines) | stat: -rw-r--r-- 3,375 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
unit SynPopupMenu;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Menus, SynEdit, SynEditStrConst;

type
  TSynDefaultPopupMenu = (dpmDisabled, dpmBefore, dpmAfter);

  TSynPopupMenu = class(TPopupMenu)
  private
    FDefaultPopupMenu: TSynDefaultPopupMenu;
    procedure FillDefaultMenu;
    procedure ClearDefaultMenu;
  protected
    procedure ItemOnClick(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure PopUp(X, Y: Integer); override;
  published
    property DefaultPopupMenu: TSynDefaultPopupMenu read
      FDefaultPopupMenu write FDefaultPopupMenu default dpmBefore;
  end;

implementation

type
  TMenuEntry = (meNone, meUndo, meRedo, meCut, meCopy, mePaste,
                meDelete, meSelectAll);

{ TSynPopupMenu }

constructor TSynPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
  FDefaultPopupMenu := dpmBefore;
end;

procedure TSynPopupMenu.FillDefaultMenu;
var
  i: Integer;

  procedure AddMenuItem(const ACaption: string; const ATag: TMenuEntry);
  var
    FItem: TMenuItem;
  begin
    FItem := TMenuItem.Create(Self);
    FItem.Caption := ACaption;
    FItem.OnClick := @ItemOnClick;
    FItem.Tag := Integer(ATag);
    if FDefaultPopupMenu = dpmAfter then
      Items.Add(FItem)
    else
      Items.Insert(i, FItem);
    Inc(i);
  end;

var
  FEmpty: Boolean;
begin
  if FDefaultPopupMenu = dpmDisabled then
    Exit;
  i := 0;
  FEmpty := Items.Count = 0;
  if not FEmpty and (FDefaultPopupMenu = dpmAfter) then     // separator
    AddMenuItem('-', meNone);
  AddMenuItem(SYNS_Undo, meUndo);
  AddMenuItem(SYNS_Redo, meRedo);
  AddMenuItem('-', meNone);
  AddMenuItem(SYNS_Cut, meCut);
  AddMenuItem(SYNS_Copy, meCopy);
  AddMenuItem(SYNS_Paste, mePaste);
  AddMenuItem('-', meNone);
  AddMenuItem(SYNS_Delete, meDelete);
  AddMenuItem(SYNS_SelectAll, meSelectAll);
  if not FEmpty and (FDefaultPopupMenu = dpmBefore) then    // separator
    AddMenuItem('-', meNone);
end;

procedure TSynPopupMenu.ClearDefaultMenu;
var
  i: Integer;
begin
  for i := Items.Count - 1 downto 0 do
    if Items[i].OnClick = @ItemOnClick then
      Items.Delete(i);
end;

procedure TSynPopupMenu.ItemOnClick(Sender: TObject);
begin
  with TCustomSynEdit(PopupComponent) do
    case TMenuEntry(TMenuItem(Sender).Tag) of
      meUndo:      Undo;
      meRedo:      Redo;
      meCut:       CutToClipboard;
      meCopy:      CopyToClipboard;
      mePaste:     PasteFromClipboard;
      meDelete:    SelText := '';
      meSelectAll: SelectAll;
    end;
end;

procedure TSynPopupMenu.PopUp(X, Y: Integer);
var
  i: Integer;
begin
  ClearDefaultMenu;
  if PopupComponent is TCustomSynEdit then
  begin
    FillDefaultMenu;
    for i := 0 to Items.Count - 1 do
      with TCustomSynEdit(PopupComponent) do
        if Items[i].OnClick = @ItemOnClick then   // make sure it's ours
          case TMenuEntry(Items[i].Tag) of
            meUndo:      Items[i].Enabled := CanUndo;
            meRedo:      Items[i].Enabled := CanRedo;
            meCut:       Items[i].Enabled := SelAvail and not ReadOnly;
            meCopy:      Items[i].Enabled := SelAvail;
            mePaste:     Items[i].Enabled := CanPaste;
            meDelete:    Items[i].Enabled := SelAvail and not ReadOnly;
            meSelectAll: Items[i].Enabled := HasText([shtIncludeVirtual]);
          end;
  end;
  inherited;
end;

end.