无法忍受如此耻辱！竟然说csdn无人！！！！tchvb进来！

shawls 2002-05-28 12:10:40
解决方案：
model中：

Option Explicit

Public OldWindowProc As Long
' 保存默认的窗口函数的地址
Public Const WM_CONTEXTMENU = &H7B
' 当右击文本框时，产生这条消息

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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


Public Function SubClass1_WndMessage(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long
If Msg <> WM_CONTEXTMENU Then
SubClass1_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
' 如果消息不是WM_CONTEXTMENU，就调用默认的窗口函数处理
Exit Function
End If
SubClass1_WndMessage = True
End Function


自定义控件中：

加入一个usermenu的菜单－－测试
加入两个textbox：text1,text2

Option Explicit
Private Const GWL_WNDPROC = (-4)

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
OldWindowProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)
' 取得窗口函数的地址
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
' 用SubClass1_WndMessage代替窗口函数处理消息
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, OldWindowProc)
' 恢复窗口的默认函数
PopupMenu usermenu
' 弹出自定义菜单
End Sub


其他接口自己写，实现了功能！
...全文
110 40 打赏 收藏 转发到动态 举报
写回复
用AI写文章
40 条回复
切换为时间正序
请发表友善的回复…
发表回复
Paul888 2002-05-28
  • 打赏
  • 举报
 回复
吊就一个字。。。。
shawls 2002-05-28
  • 打赏
  • 举报
 回复
to jshyjyw(紫狐)

我只是表达我自己的情感罢了，不好意思



我是小山，我喜欢VB，现在在学习C#和.net的相关知识

欢迎您使用： SourceCode Explorer(源代码数据库)
当前版本： 1.0.690
作者： Shawls
来自： Http://www.dapha.net
个人主页： Http://Shawls.Yeah.Net
E-Mail： ShawFile@163.Net
QQ： 9181729
shawls 2002-05-28
  • 打赏
  • 举报
 回复

工程2.vbp

Type=Exe
Form=Form1.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINNT\System32\stdole2.tlb#OLE Automation
Object=*\A工程1.vbp
Form=Form2.frm
Startup="Form1"
Command32=""
Name="工程2"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="HeroKingSoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1


工程1.vbp

VERSION 5.00
Object = "*\A工程1.vbp"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 555
Left = 4110
TabIndex = 1
Top = 1620
Width = 495
End
Begin 工程1.UserControl1 UserControl11
Height = 2925
Left = 30
TabIndex = 0
Top = 90
Width = 4605
_ExtentX = 8123
_ExtentY = 5159
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
Form2.Show
End Sub

form2.frm

VERSION 5.00
Object = "*\A工程1.vbp"
Begin VB.Form Form2
Caption = "Form2"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form2"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin 工程1.UserControl1 UserControl11
Height = 2835
Left = 240
TabIndex = 0
Top = 300
Width = 4155
_ExtentX = 7329
_ExtentY = 5001
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

lihonggen0 2002-05-28
  • 打赏
  • 举报
 回复





tchvb(tchvb)：这样的家伙,问问题就老实点,先学会做人!!!!!


再者，谁都不是CSDN的职业答题人,看到了，心情好，就答，象tchvb这样，激将法是没有用的,只会令大家反感!!!!!!!

jshyjyw 2002-05-28
  • 打赏
  • 举报
 回复
实在没有耐心把原来那个帖子看完。
发这样的帖子，说这样的话的人头脑有病！
我只有三颗★，说明我的水平不高。
但我仍然尽可能帮助别人。
永远不要嘲笑别人。帮助别人使自己快乐。
shawls 2002-05-28
  • 打赏
  • 举报
 回复
beta1:
组1.vbg

VBGROUP 5.0
Project=工程1.vbp
StartupProject=工程2.vbp

工程1.vbp
Type=Control
UserControl=UserControl1.ctl
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINNT\System32\stdole2.tlb#OLE Automation
Module=Module1; Module1.bas
Startup="(None)"
Command32=""
Name="工程1"
HelpContextID="0"
CompatibleMode="1"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="HeroKingSoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=1
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
ThreadingModel=1

[MS Transaction Server]
AutoRefresh=1

UserControl1.ctl
VERSION 5.00
Begin VB.UserControl UserControl1
ClientHeight = 3600
ClientLeft = 0
ClientTop = 0
ClientWidth = 4800
ScaleHeight = 3600
ScaleWidth = 4800
Begin VB.TextBox Text2
Height = 1065
Left = 450
TabIndex = 1
Text = "Text2"
Top = 1500
Width = 3465
End
Begin VB.TextBox Text1
Height = 885
Left = 300
Locked = -1 'True
TabIndex = 0
Text = "Text1"
Top = 270
Width = 3675
End
Begin VB.Menu usermenu
Caption = "usermenu"
Visible = 0 'False
Begin VB.Menu sss
Caption = "ss"
End
Begin VB.Menu sfs
Caption = "sf"
End
Begin VB.Menu sfa
Caption = "sfs"
End
Begin VB.Menu erw
Caption = "asf"
End
Begin VB.Menu afsa
Caption = "sfa"
End
End
End
Attribute VB_Name = "UserControl1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Const GWL_WNDPROC = (-4)

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
OldWindowProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)
' 取得窗口函数的地址
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
' 用SubClass1_WndMessage代替窗口函数处理消息
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, OldWindowProc)
' 恢复窗口的默认函数
PopupMenu usermenu
' 弹出自定义菜单
End Sub


Module1.bas
Attribute VB_Name = "Module1"
Option Explicit

Public OldWindowProc As Long
' 保存默认的窗口函数的地址
Public Const WM_CONTEXTMENU = &H7B
' 当右击文本框时，产生这条消息

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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


Public Function SubClass1_WndMessage(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long
If Msg <> WM_CONTEXTMENU Then
SubClass1_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
' 如果消息不是WM_CONTEXTMENU，就调用默认的窗口函数处理
Exit Function
End If
SubClass1_WndMessage = True
End Function



shawls 2002-05-28
  • 打赏
  • 举报
 回复

怕什么，技术是需要交流的，他不愿意就算了！

我无所谓的，他不公开，我公开，请大家批判！

有了批评才会有提高，
chenyiwei 2002-05-28
  • 打赏
  • 举报
 回复
打了这么多，搞不好最后还会招来tchvb的嘲笑。哈
shawls 2002-05-28
  • 打赏
  • 举报
 回复

补充：text1.lock=true!
shawls 2002-05-28
  • 打赏
  • 举报
 回复

原来的帖子：
http://www.csdn.net/expert/topic/757/757198.xml?temp=.9023554

可以看看人家多么高大！！！！

哼！
shawls 2002-05-28
  • 打赏
  • 举报
 回复
控件+代码下载：http://listenshaw.myetang.com/textmenu.rar

2002-5-28的下午5点以后才会上传，我要睡觉了！
doyang 2002-05-28
  • 打赏
  • 举报
 回复
有本事把这个解决了
http://www.csdn.net/expert/topic/746/746920.xml?temp=.6127588
hillmanweb 2002-05-28
  • 打赏
  • 举报
 回复
小山,支持你!
ningkang 2002-05-28
  • 打赏
  • 举报
 回复
那个鸟人不敢来了？？？？？？
acev 2002-05-28
  • 打赏
  • 举报
 回复

sorry,不谈政治。
孙小雄 2002-05-28
  • 打赏
  • 举报
 回复
acev(acev) 谢谢你的评价阿 我和小山都是被他骂的患难兄弟
小山很了不起
大家应该记住tchvb(tchvb）
lyqof908 2002-05-28
  • 打赏
  • 举报
 回复
支持Shawls (小山(求职的程序员-谁让我发挥作用？))
我除了不会他说的继承外，功能我都能制作出来。
lihonggen0 2002-05-28
  • 打赏
  • 举报
 回复
u p
wzsswz 2002-05-28
  • 打赏
  • 举报
 回复
我行我素，你们说，谁管谁。。。。
yclyz 2002-05-28
  • 打赏
  • 举报
 回复
难的!!!
支持Shawls (小山(求职的程序员-谁让我发挥作用？)) !
加载更多回复（20）
Shamebot:耻辱！ 耻辱！ 耻辱！
羞耻机器人 shamebot是一个Slack和用于分发耻辱感。 设置 克隆此项目 运行heroku create 创建一个 将命令设置为/anon或任何您喜欢的命令 将URL设置为新的Heroku域，并附加/webhook （例如https://wailing-winds-0421.herokuapp.com/webhook ） 将斜杠命令令牌添加到Heroku： heroku config:set SLACK_OUTGOING_WEBHOOK_TOKEN= 创建一个 将传入的Webhook URL添加到Heroku： heroku config:set SLACK_INCOMING_WEBHOOK_URL= 版权 版权所有:copyright:Brian Donohue 特此免费授予获得此软件和相关文档文件（“软件”）副本的任何人无限制地处理软件的权利，包括
教育（和心理学）的耻辱：和双重敢于
教育（和心理学）的耻辱：和双重敢于教育（和心理学）的耻辱：和双重敢于 SIDNEY L. PRESSEY 俄亥俄州立大学 在过去的 50 年里，工业生产力、交通运输和通讯的进步令人震惊。 相比之下，学校教育变化不大。 与五十年前相比，教师培训现在更加混乱，名气也越来越小。 为了纠正这种情况，数百万美元被投入到教育研究中。 尽管其中大部分是好的，但如果它使某些几乎普遍存在的实践变得更容易容忍，它甚至可能会造成伤害，这些实践长期以来被证明是严重错误的，但现在通常被认为是理所当然的或被认为无法改变，本文大胆地宣布，有了一点创新的勇气，这整个局面可能会得到转变——教育效率大大提高，也获得了新的教育和心理理解。 没有课程、时钟、日历限制！ 三十年前，Learned 和 Wood (1938) 报告说，宾夕法尼亚州大约 10% 的高中生在一系列据称涵盖大学教育基本知识的测试中得分高于大学毕业生的平均水平。 最近，德雷塞尔根据他对综合考试的使用得出结论，大约 10% 的学生在注册基础入门课程之前可以获得“C”或更高的成绩（Gage，1963，第 386 页）。 然而，可能的甚至严重的重叠仍然被忽视—
bb：用go编写的耻辱公告板
LINUX的bb 耻骨公告板 在过去10天内构建了此文件，以用作pubnix的公告板： ://heathens.club/ 我们想要一个定制板。 所以我建了一个。 而已！ 说明： (ROW 42 and 43 in bb.go) admin = "username" //set this to your home folder name on your pubnix boardtitle = "Title of the board" //set this to whatever you want 完成后，只需构建并运行它即可，即构建bb.go 然后运行“ ./bb mod”以初始化所有文件夹。 然后，您将拥有一个正在运行的pubnix公告板。 只要确保所有其他用户都可以访问该应用程序即可。 也许将其放在二进制文件夹中。 ARGS说明： Usage of ./
crypto-against-humanity:加密反人类-永无止境的全球耻辱游戏
加密反人类 什么是反人类密码？ Crypto Against Humanity是一张Cards Against Humanity永无止境的游戏，所有参与者都在竞争寻找最佳比赛的机会。 加密经济原语可以激励和奖励卡的创建和管理。 用户将黑卡提交给Token Curated Registry并创建白卡，每张白卡都具有关联的绑定曲线市场。 玩家通过购买与当前回合中与黑卡最匹配的白卡来参与。 每12小时随机选择一张黑卡。 玩家可以通过出售早期购买的白卡或创建社区认为有价值的黑卡来赚钱！ 我该怎么玩？ 我们仍在构建反人类密码，但您可以在CryptoAgainstHumanity.io上进行测试！ 我们目前正在Ropsten测试网络上运行它，但计划尽快在主网上启动！ 如何在本地部署它？ 如果要部署和测试本地语言，则可以采用以下两种方式之一进行操作：带缓存的常规方式或不带缓存的“陈旧”方式。 要
OutSystems Launcher-crx插件
这个扩展允许您在当前屏幕上打开服务Studio。 适用于系统外应用程序的Chrome扩展程序，具有以下惊人功能：/！\启动器*启动当前OS应用程序的Service Studio * Service Studio将在当前环境中打开！ 哦耶！ *并且在同一屏幕上显示浏览器！ 哇！ *您也可以快速访问当前环境的服务中心！ /！\当前页面视图状态（Web应用程序）*工具栏按钮/图标现在显示Web应用程序视图状态！ *没有更多的计算或其他扩展来检索OS视图状态*是的..它会在每个平台上更新ajax刷新/！\快速链接*访问社区Web属性，例如论坛，Idea和Forge *检查产品更新以及新功能！ *可以快速访问以创建2.0.11版本的票证：*升级以适应OutSystems应用程序（网络和移动）OS 10版本*在OutSystems Device Preview中可以使用*图标标记现在显示Web应用程序的视图状态大小*在平台“ Bad boy！”中添加了“新增功能”的通知。...耻辱列表：( **修复了设备预览问题**修复了Google云端硬盘冲突**根据用户反馈删除了控制台警告！谢谢陌生人:) 支持语言:English
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

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

+ 用AI写文章