⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvfixededitpopup.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
procedure THiddenPopupObject.DoUndo(Sender: TObject);
var
  PopupIntf: IFixedPopupIntf;
begin
  if Assigned(Edit) and Edit.HandleAllocated then
  begin
    if Edit.GetInterface(IFixedPopupIntf, PopupIntf) then
      PopupIntf.Undo
    else
      Edit.Perform(WM_UNDO, 0, 0);
  end;
end;

type
  TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;

function THiddenPopupObject.GetClipboardCommands: TJvClipboardCommands;
const
  cClipboardCommands = 'ClipboardCommands';
var
  Value: TIntegerSet;
  I: Integer;
begin
  if IsPublishedProp(Edit, cClipboardCommands) then
  begin
    Result := [];
    // does it really have to be this complicated ?!
    Integer(Value) := GetOrdProp(Edit, cClipboardCommands);
    for I := 0 to SizeOf(Integer) * 8 - 1 do
      if I in Value then
        Include(Result, TJvClipboardCommand(I));
  end
  else
    Result := [caCopy, caCut, caPaste, caUndo];
end;

procedure THiddenPopupObject.GetDefaultMenuCaptions;
var
  H: HMODULE;
  hMenu, hSubMenu: THandle;
  Buf: array [0..255] of Char;
begin
  // get the translated captions from Windows' own default popup:
  H := GetModuleHandle('user32.dll');
  hMenu := LoadMenu(H, MakeIntResource(1));
  if hMenu = 0 then
    Exit;
  try
    hSubMenu := GetSubMenu(hMenu, 0);
    if hSubMenu = 0 then
      Exit;

    if GetMenuString(hSubMenu, WM_UNDO, Buf, SizeOf(Buf), MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[0].Caption := Buf;
    if GetMenuString(hSubMenu, WM_CUT, Buf, SizeOf(Buf), MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[2].Caption := Buf;
    if GetMenuString(hSubMenu, WM_COPY, Buf, SizeOf(Buf), MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[3].Caption := Buf;
    if GetMenuString(hSubMenu, WM_PASTE, Buf, SizeOf(Buf), MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[4].Caption := Buf;
    if GetMenuString(hSubMenu, WM_CLEAR, Buf, SizeOf(Buf), MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[5].Caption := Buf;
    if GetMenuString(hSubMenu, EM_SETSEL, Buf, SizeOf(Buf), MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[7].Caption := Buf;
  finally
    DestroyMenu(hMenu);
  end;
end;

{function THiddenPopupObject.GetPopupMenu: TPopupMenu;
begin
  Result := GetPopupMenuEx(True);
end;}

function THiddenPopupObject.GetPopupMenuEx(Update: Boolean): TPopupMenu;
var
  m: TMenuItem;
begin
  if FPopupMenu = nil then
  begin
    FPopupMenu := TPopupMenu.Create(Self);
    { build menu:
      Undo
      -
      Cut
      Copy
      Paste
      Delete
      -
      Select All
    }

    // start off with resourcestrings (in case GetDefaultMenuCaptions fails)
    m := TMenuItem.Create(Self);
    m.Caption := RsUndoItem;
    m.OnClick := DoUndo;
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := '-';
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := RsCutItem;
    m.OnClick := DoCut;
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := RsCopyItem;
    m.OnClick := DoCopy;
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := RsPasteItem;
    m.OnClick := DoPaste;
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := RsDeleteItem;
    m.OnClick := DoDelete;
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := '-';
    FPopupMenu.Items.Add(m);

    m := TMenuItem.Create(Self);
    m.Caption := RsSelectAllItem;
    m.OnClick := DoSelectAll;
    FPopupMenu.Items.Add(m);

    if not GlobalUseResourceStrings then
      GetDefaultMenuCaptions;
  end;
  if Update then
    UpdateItems;
  Result := FPopupMenu;
end;

procedure THiddenPopupObject.UpdateItems;
var
  cc: TJvClipboardCommands;
  ASelLength: Integer;
  AReadOnly: Boolean;
  ATextLen: Integer;
  PopupIntf: IFixedPopupIntf;
begin
  if (Edit <> nil) and Edit.HandleAllocated then
  begin
    cc := GetClipboardCommands;
    FPopupMenu.PopupComponent := Edit;

    if Edit.GetInterface(IFixedPopupIntf, PopupIntf) then
    begin
      // undo
      FPopupMenu.Items[0].Enabled := (caUndo in cc) and PopupIntf.CanUndo;
      // cut
      FPopupMenu.Items[2].Enabled := (caCut in cc) and PopupIntf.HasSelection and PopupIntf.CanCut;
      // copy
      FPopupMenu.Items[3].Enabled := (caCopy in cc) and PopupIntf.HasSelection and PopupIntf.CanCopy;
      // paste
      FPopupMenu.Items[4].Enabled := (caPaste in cc) and PopupIntf.CanPaste;
      // delete
      FPopupMenu.Items[5].Enabled := PopupIntf.HasSelection and PopupIntf.CanCut;
      // select all
      FPopupMenu.Items[7].Enabled := PopupIntf.CanSelectAll;
    end
    else
    begin
      ASelLength := SelLength;
      AReadOnly := ReadOnly;
      ATextLen := GetTextLen;

      // undo
      FPopupMenu.Items[0].Enabled := (caUndo in cc) and CanUndo;
      // cut
      FPopupMenu.Items[2].Enabled := (ASelLength > 0) and not AReadOnly and (caCut in cc);
      // copy
      FPopupMenu.Items[3].Enabled := (ASelLength > 0) and (caCopy in cc);
      // paste
      FPopupMenu.Items[4].Enabled := not AReadOnly and (caPaste in cc);
      // delete
      FPopupMenu.Items[5].Enabled := (ASelLength > 0) and not AReadOnly { and (caCut in cc)};
      // select all
      FPopupMenu.Items[7].Enabled := (ATextLen > 0) and (ASelLength <> ATextLen);
    end;
  end;
end;

function THiddenPopupObject.GetTextLen: Integer;
begin
  if (Edit <> nil) and Edit.HandleAllocated then
    Result := Edit.GetTextLen
  else
    Result := 0;
end;

function THiddenPopupObject.ReadOnly: Boolean;
begin
  if (Edit <> nil) and Edit.HandleAllocated then
    Result := GetWindowLong(Edit.Handle, GWL_STYLE) and ES_READONLY = ES_READONLY
  else
    Result := False;
end;

function THiddenPopupObject.SelLength: Integer;
var
  StartPos, EndPos: Integer;
  MsgResult: Longint;
begin
  Result := 0;
  if (Edit <> nil) and Edit.HandleAllocated then
  begin
    StartPos := 0;
    EndPos := 0;
    MsgResult := SendMessage(Edit.Handle, EM_GETSEL, Longint(@StartPos), Longint(@EndPos));
    Result := EndPos - StartPos;
    if (Result <= 0) and (MsgResult > 0) then
      Result := LongRec(MsgResult).Hi - LongRec(MsgResult).Lo;
  end;
end;

procedure THiddenPopupObject.SetEdit(const Value: TWinControl);
begin
  if FEdit <> Value then
  begin
    if FEdit <> nil then
      FEdit.RemoveFreeNotification(Self);
    FEdit := Value;
    if FEdit <> nil then
      FEdit.FreeNotification(Self);
  end;
end;

procedure THiddenPopupObject.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FEdit) then
    FEdit := nil;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  FreeAndNil(GlobalHiddenPopup);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -