请教:菜单中没有使用权限的设为Enabled:=False; ,如何使鼠标移到此菜单上显示为:'你没有使用此功能的权限'的提示?

lpc444 2007-01-24 10:13:01
请教:菜单中没有使用权限的设为Enabled:=False; ,如何使鼠标移到此菜单上显示为:'你没有使用此功能的权限'的提示?
多谢!
...全文
415 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
lpc444 2007-01-29
  • 打赏
  • 举报
回复
多谢ok999ok(ok999ok)
再问一下,能否调用Delphi它的默认的Hint的黄色提示框来显示 ?
proer9988 2007-01-29
  • 打赏
  • 举报
回复
//多搜索一下,这里是我搜索的,来自CSDN
//我测试了一下,基本满足要求,要达到实用可能还需要修改一下,
//主要是提示的位置设计的不好,最好是靠近菜单的最右边
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
mnuFile: TMenuItem;
mnuNew: TMenuItem;
mnuOpen: TMenuItem;
mnuOpen1: TMenuItem;
mnuOpen2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
HintWindow: THintWindow;
procedure DisplayHint(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DisplayHint(Sender: TObject);
var
point1: TPoint;
width: integer;
size1: size;
hintstr: string;
begin
hintstr := GetLongHint(application.Hint);
if hintstr <> '' then
begin
//计算宽度;
GetTextExtentPoint32(getdc(form1.Handle), pchar(hintstr), length(hintstr), size1);
getcursorpos(point1);
//得到位置;
HintWindow.ActivateHint(Rect(point1.x,point1.y, point1.X +size1.cx, point1.y +size1.cy),hintstr);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowHint:=True;
Application.OnHint:=DisplayHint;
HintWindow:= THintWindow.Create(self);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
if Assigned(HintWindow) then
HintWindow.ReleaseHandle;
end;

end.
lenassnake 2007-01-28
  • 打赏
  • 举报
回复
用 Application.OnHint 事件, 适当的时候将其 nil 掉;

也可以单独处理 WM_MENUSELECT 消息
proer9988 2007-01-28
  • 打赏
  • 举报
回复
不好意思,没看清楚,还以为是VB!
下面是DELPHI的例子!
你也可以设置StatusBar1的AutoHit为TRUE,这样菜单提示自动显示在StatusBar1中。
下面的例子四显示在FORM2里。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ComCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Edit1: TMenuItem;
Object1: TMenuItem;
Links1: TMenuItem;
N1: TMenuItem;
GoTo1: TMenuItem;
Replace1: TMenuItem;
Find1: TMenuItem;
N2: TMenuItem;
PasteSpecial1: TMenuItem;
Paste1: TMenuItem;
Copy1: TMenuItem;
Cut1: TMenuItem;
N3: TMenuItem;
Repeatcommand1: TMenuItem;
Undo1: TMenuItem;
btn1: TButton;
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
private
procedure MyHit(sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnHint:=MyHit;
end;

procedure TForm1.MyHit(sender: TObject);
begin
form2.Label1.Caption:='MyHit';
form2.Show;
end;
end.
lpc444 2007-01-27
  • 打赏
  • 举报
回复
在Delphi中的代码如何?
proer9988 2007-01-26
  • 打赏
  • 举报
回复
'在模块:modvbworld.bas
Option Explicit
' VB-World.net global support library for demo projects
' John Percival, Feb '99


Public Const URL = "http://www.vb-world.net"
Public Const email = "john@vb-world.net"

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_SHOWNORMAL = 1

Public Sub gotoweb()
Dim Success As Long

Success = ShellExecute(0&, vbNullString, URL, vbNullString, "C:\", SW_SHOWNORMAL)

End Sub

Public Sub sendemail()
Dim Success As Long

Success = ShellExecute(0&, vbNullString, "mailto:" & email, vbNullString, "C:\", SW_SHOWNORMAL)

End Sub

'在Form1中,设计好菜单
Option Explicit

Private Sub Form_Load()
HookWindow Me
lblemail = email
lblurl = URL
End Sub

Private Sub lblemail_Click()
sendemail
End Sub

Private Sub lblurl_Click()
gotoweb
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnHookWindow
End Sub

proer9988 2007-01-26
  • 打赏
  • 举报
回复
'需要用到HOOK(窗口子类)技术:
'搜索得到的代码:
'在模块modMenu.bas
Option Explicit

Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&
Public Const MF_POPUP = &H10&
Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private oldwndproc As Long
Private subclassedhWnd As Long

Public Const WM_MENUSELECT = &H11F
Public Const WM_NCDESTROY = &H82
Public Const GWL_WNDPROC = (-4)

Public Sub HookWindow(SubClassForm As Form)

' if something is already subclassed, don't subclass anything else
If oldwndproc <> 0 Then Exit Sub

subclassedhWnd = SubClassForm.hwnd

'Get the handle for the old window procedure so it can be replaced and used later
oldwndproc = GetWindowLong(SubClassForm.hwnd, GWL_WNDPROC)

'Install custom window procedure for this window
SetWindowLong SubClassForm.hwnd, GWL_WNDPROC, AddressOf WndProc

End Sub

Private Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Does control want this message?
If Msg = WM_MENUSELECT Then

' This occurs when the menu is being closed
If lParam = 0 Then Exit Function

Dim MenuItemStr As String * 128
Dim MenuHandle As Integer

' Get the low word from wParam: this contains the command ID or position of the menu entry
MenuHandle = GetLowWord(wParam)

'If the highlighted menu is the top of a poup menu, pass menu item by position
If (GetHighWord(wParam) And MF_POPUP) = MF_POPUP Then

'Get the caption of the menu item
If GetMenuString(lParam, MenuHandle, MenuItemStr, 127, MF_BYPOSITION) = 0 Then Exit Function

Else ' Otherwise pass it by command ID

'Get the caption of the menu item
If GetMenuString(lParam, MenuHandle, MenuItemStr, 127, MF_BYCOMMAND) = 0 Then Exit Function

End If

' Add status bar message here!
frmMenu.lblSelItem = Trim$(MenuItemStr)

Else

'Otherwise, just call default window handler
WndProc = CallWindowProc(oldwndproc, hwnd, Msg, wParam, lParam)

End If

'Unhook this window if it is being destroyed
If Msg = WM_NCDESTROY Then
UnHookWindow
End If
End Function

Public Sub UnHookWindow()
' If there is nothing subclassed, there is nothing to unsubclass!
If oldwndproc = 0 Then Exit Sub

'Return to default window handler
SetWindowLong subclassedhWnd, GWL_WNDPROC, oldwndproc
oldwndproc = 0
End Sub

Public Function GetLowWord(Word As Long)
GetLowWord = CInt("&H" & Right$(Hex$(Word), 4))
End Function

Public Function GetHighWord(Word As Long)
GetHighWord = CInt("&H" & Left$(Hex$(Word), 4))
End Function


liuqifeiyu 2007-01-25
  • 打赏
  • 举报
回复
那就动态设定HINT啊
lpc444 2007-01-25
  • 打赏
  • 举报
回复
是的,我是放在数据库里,可以设置有效性,但就不能显示提示信息。
deansroom 2007-01-25
  • 打赏
  • 举报
回复
我感觉直接visble:=false;
直接隐藏
hfltp 2007-01-24
  • 打赏
  • 举报
回复
你把showhint属性设为true,再hint属性中填入默认的提示。
当你登陆后根据权限判断或根据enable属性判断,在代码中填写新的hint提示语。
仙侣步惊云 2007-01-24
  • 打赏
  • 举报
回复
你的程序必须是多用户的,然后根据登录的用户动态设置菜单项的enabled属性,并在hint中写提示信息.
proer9988 2007-01-24
  • 打赏
  • 举报
回复
提示信息放在数据库里,然后根据权限提取。
lpc444 2007-01-24
  • 打赏
  • 举报
回复
不行,
由于我的菜单有效性是动态设定的。
请各位指教,多谢!
windplume 2007-01-24
  • 打赏
  • 举报
回复
把showhint属性设为false,hint属性设为'你没有使用此功能的权限'。
登录时,根据用户权限,设定菜单Enabled:=False;再加上一句ShowHint := true;
这样最简洁。

2,495

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 数据库相关
社区管理员
  • 数据库相关社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧