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

📄 rm_jvfixededitpopup.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 2 页
字号:
var
  Value: TIntegerSet;
  I: Integer;
begin
  if IsPublishedProp(Edit, cClipboardCommands) then
  begin
    Result := [];
    // does it really have to be this complicated ?!
    Value := TIntegerSet(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;

{$IFDEF CLR}
[SuppressUnmanagedCodeSecurity, DllImport(user32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'LoadMenu')]
function LoadMenu(hInstance: HINST; lpMenuId: Integer): HMENU; overload; external;
{$ENDIF CLR}


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

    {$IFDEF CLR}
    Buf := StringBuilder.Create(BufLen);
    {$ENDIF CLR}
    if GetMenuString(hSubMenu, WM_UNDO, Buf, BufLen, MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[0].Caption := Buf{$IFDEF CLR}.ToString{$ENDIF};
    if GetMenuString(hSubMenu, WM_CUT, Buf, BufLen, MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[2].Caption := Buf{$IFDEF CLR}.ToString{$ENDIF};
    if GetMenuString(hSubMenu, WM_COPY, Buf, BufLen, MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[3].Caption := Buf{$IFDEF CLR}.ToString{$ENDIF};
    if GetMenuString(hSubMenu, WM_PASTE, Buf, BufLen, MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[4].Caption := Buf{$IFDEF CLR}.ToString{$ENDIF};
    if GetMenuString(hSubMenu, WM_CLEAR, Buf, BufLen, MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[5].Caption := Buf{$IFDEF CLR}.ToString{$ENDIF};
    if GetMenuString(hSubMenu, EM_SETSEL, Buf, BufLen, MF_BYCOMMAND) <> 0 then
      FPopupMenu.Items[7].Caption := Buf{$IFDEF CLR}.ToString{$ENDIF};
  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 Supports(Edit, 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: Longint;
  MsgResult: Longint;
  {$IFDEF CLR}
  p1, p2: IntPtr;
  {$ENDIF CLR}
begin
  Result := 0;
  if (Edit <> nil) and Edit.HandleAllocated then
  begin
    StartPos := 0;
    EndPos := 0;
    {$IFDEF CLR}
    p1 := Marshal.AllocHGlobal(SizeOf(StartPos));
    p2 := Marshal.AllocHGlobal(SizeOf(EndPos));
    try
      Marshal.StructureToPtr(TObject(StartPos), p1, True);
      Marshal.StructureToPtr(TObject(EndPos), p2, True);
      MsgResult := SendMessage(Edit.Handle, EM_GETSEL, Longint(p1), Longint(p2));
      StartPos := Marshal.ReadInt32(p1);
      EndPos := Marshal.ReadInt32(p2);
    finally
      Marshal.FreeHGlobal(p1);
      Marshal.FreeHGlobal(p2);
    end;
    {$ELSE}
    MsgResult := SendMessage(Edit.Handle, EM_GETSEL, Longint(@StartPos), Longint(@EndPos));
    {$ENDIF CLR}
    Result := EndPos - StartPos;
    if (Result <= 0) and (MsgResult > 0) then
      {$IFDEF CLR}
      Result := (MsgResult shr 16) - MsgResult and $0000FFFF;
      {$ELSE}
      Result := LongRec(MsgResult).Hi - LongRec(MsgResult).Lo;
      {$ENDIF CLR}
  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
  {$IFNDEF CLR}
  FreeAndNil(GlobalHiddenPopup);
  {$ENDIF !CLR}
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

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