| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 17142 人关注过本帖, 3 人收藏
标题:《奥运邮集》软件代码介绍——VB6初学之友
只看楼主 加入收藏
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
(2)相邻exe工程之间的转接;
各届邮集都是exe格式的文件,它们之间的转换有两个途径;
    ***第一个途径——任一届奥运邮集的首页和尾页,都有转到前一届或后一届的按钮来完成转换。
    由于转一另一届是需要打开exe格式的文件,所以需要用下面的特殊的代码:
    Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\XJ9.exe", vbMaximizedFocus
    注:XJ9.exe为将被打开的新一届邮集。
    提示:采用这种从一个exe文件转换一另一个exe文件时,原来的已打开的文件仍在进程中,而未被关闭;而采用下面的方法,打开一个新的exe文件后,就会关闭前面所有的已打开文件。
    这一段代码看似简单,但偶也是在很多论坛上才求教得到的,也曾来之不易。如果您今后设计软件遇到exe文件之间的转换或许能用得上,如果您有更好的代码也希望在这里交流。
    ***第二个途径——通过屏幕左侧的悬浮窗体上的导航钮(见图)。这一方式转换的特点是,打开某一届后,就会自动关闭掉前面其它已打开的各届。实现这一方式的代码举例如下:(有一段声明)
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "USER32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1
Private Sub Command3_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "第1届" ‘被关闭的所有届都要有相应这样的一组代码;
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第2届"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj3.exe", vbMaximizedFocus
End Sub
提示:由于目前夏季奥运会有29届,所以打开一届,就要设置关闭其它28届的28组代码,一个程序代码重复而又庞大。不知是否还有更好的代码?

[[it] 本帖最后由 jrs123 于 2008-5-3 19:57 编辑 [/it]]

悬浮窗.JPG (22.21 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册
2008-05-03 15:50
wangtuan7788
Rank: 1
等 级:新手上路
帖 子:286
专家分:0
注 册:2007-10-8
收藏
得分:0 
for i=1 to N '有几届n就写几
   strWinName = "第" & i & "届"
   hLong = FindWindow(vbNullString, strWinName)
   If hLong Then
   GetWindowThreadProcessId hLong, LpID
   Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
   TerminateProcess Ltem, 0
   hLong = 0
   End If
next
呵呵,不知道这样行不?

你笑我和你们不一样,我笑你们大家都一样~
2008-05-03 18:45
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
楼上朋友代码可行,已通过验证,
真不错,用此代码该工程至少省了三分之二的代码,
欢迎对奥运邮集软件代码多提宝贵意见!
2008-05-03 20:40
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
为什么会出现自变量未定义错?
在悬浮窗的软件中采用上述方案,(即多了下面12行)会出现"自变量未定义"错误,问题出在何处?那位能指正一下?(出错处见图)
Option Explicit '以下是悬浮窗用,加了此段,会出错"编译错误,自变量未定义"
Private Declare Function SetWindowPos Lib "USER32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const Swp_nomove = &H2
Private Const Swp_nosize = &H1
Private Const HWND_NOTOPMOST = -2
Private Const hwnd_topmost = -1
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "USER32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetParent Lib "USER32" (ByVal hWnd As Long) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type '悬浮窗体止
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '以下均常(0)

Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "USER32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1
Private Sub Command1_Click()
For i = 1 To 30 '有几届n就写几
   strWinName = "第" & i & "届"
   hLong = FindWindow(vbNullString, strWinName)
   If hLong Then
   GetWindowThreadProcessId hLong, LpID
   Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
   TerminateProcess Ltem, 0
   hLong = 0
   End If
Next
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj1.exe", vbMaximizedFocus
''UnloadMe False, True '关闭钮用(补)
End Sub

Private Sub Command10_Click()
For i = 1 To 30 '有几届n就写几
   strWinName = "第" & i & "届"
   hLong = FindWindow(vbNullString, strWinName)
   If hLong Then
   GetWindowThreadProcessId hLong, LpID
   Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
   TerminateProcess Ltem, 0
   hLong = 0
   End If
Next
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj10.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub

Private Sub Command11_Click()
For i = 1 To 30 '有几届n就写几
   strWinName = "第" & i & "届"
   hLong = FindWindow(vbNullString, strWinName)
   If hLong Then
   GetWindowThreadProcessId hLong, LpID
   Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
   TerminateProcess Ltem, 0
   hLong = 0
   End If
Next
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj11.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub

自变量未定义.jpg (11.01 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册


编译错误.JPG (6.9 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册
2008-05-06 18:11
wangtuan7788
Rank: 1
等 级:新手上路
帖 子:286
专家分:0
注 册:2007-10-8
收藏
得分:0 
加一句dim i as integer

你笑我和你们不一样,我笑你们大家都一样~
2008-05-06 22:14
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
还不行,请看附件,
还是变量未定义

[[it] 本帖最后由 jrs123 于 2008-5-7 11:11 编辑 [/it]]

开一届关其余自变量未定义.rar (8.06 KB) 自变量未定义

2008-05-07 11:09
wangtuan7788
Rank: 1
等 级:新手上路
帖 子:286
专家分:0
注 册:2007-10-8
收藏
得分:0 
Dim i As Integer
Dim strWinName As String
Dim hLong As Long, LpID As Long, Ltem As Long

你笑我和你们不一样,我笑你们大家都一样~
2008-05-07 19:09
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
通过了,谢谢wangtuan7788
2008-05-09 09:38
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
系统退出的两种不同方式
(3)系统退出;
    系统退出分为两个内容;一是各届单独退出,一是奥运邮集软件整体退出,下面分别讲解:
    ***各届单独退出——各届退出的钮只有一个,就是在每页的下面,点击该钮,会弹出“系统询问”对话框,问您是否在退出?(见图)
    当点击“是”后,要求关闭该届所有已打开的窗体。代码如下:(如要退出第17届奥运会)
Private Sub Command19_Click() '退出钮
If MsgBox("你要退出《第17届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") = vbYes Then
   Unload Me
   End
   Else
   Cancel = True
    End If
End Sub
Private Sub UnloadMe(bQuestion As Boolean, bEnd As Boolean, Optional ByRef Cancel As Integer)
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "第17届(1)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第17届(2)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
    . '如果有多页面,则要重复上述代码
    .
    .
End Sub   
提示:如果点击窗体右上角的关闭钮也要求弹出“系统询问”框,就需要加下面一段代码:(奥运邮集软件各届退出均未选用此代码,而是保留关闭本窗体的功能)
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '关闭钮用弹出“系统询问”
    If UnloadMode = 0 Then bQuestion = True
End Sub

关闭第17届.jpg (22.83 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册
2008-05-10 08:51
hxfly
Rank: 5Rank: 5
等 级:贵宾
威 望:17
帖 子:5810
专家分:118
注 册:2005-4-7
收藏
得分:0 
这样的原创文章应该加精,BCCN的强大离不开你们......

2008-05-10 17:24
快速回复:《奥运邮集》软件代码介绍——VB6初学之友
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.019257 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved