《奥运邮集》软件代码介绍——VB6初学之友(页 2) - VB6论坛

野比发表于 2008-4-12 03:49

辛苦了，加油哦，支持一个。

jrs123 发表于 2008-4-12 14:38

本讲小结:

本讲“《奥运邮集》软件窗体页面的结构”小结：欢迎交流[qq]791465768[/qq]
应知：（1）如果窗体内的控件超出一个屏幕高度，就需要设置滚动条代码与模块，同时应能实现鼠标滚轮移动页面；
（2）在不同屏幕分辨率下，页面居中的设置方法；
应会：（1）实现超长页面高不能超过32000，完成滚动条设置，还需要一组代码和一个模块；
（2）合理设置水平和垂直滚动条的属性，各页面ScaleMode的参数设定要一至（如都选1-Twip）；
实践：请您也完成一个超长页面，上面放一些图和控件，设置一组滚动条，看您设计的工程否正常运行？

[[it] 本帖最后由 jrs123 于 2008-6-15 13:09 编辑 [/it]]

jrs123 发表于 2008-4-18 08:31

七、《奥运邮集》软件的多工程结构

如果将夏季29届，冬季20届所有邮票都集中在一个工程内，会不会设计简单，操作方便呢？偶当初就是这样的思路，结果却行不通。
1、单工程带来的问题——由于超长页面上的控件数量受到限制，所有近万枚的奥运邮票及众多的文字说明就要分布在几百个窗体上。偶进行了实践，在一个工程内的窗体数量几百个可以不受限制制，但软件启动的速度至少在二三分钟以上（这又是VB6的一个致命的弱点！），让人无法接受，所以这一方案很快就放弃了。
此外，启动速度慢的原因，除了“机构”庞大之外，滚动条方案所采用的模块，每个窗体都要配一组代码，占用了大量的资源；加上未采用数据库，图片也占用了大量的空间，导致软件启动速度缓慢。
有关滚动条的模块代码详见
[url]http://bbs.bccn.net/viewthread.php?tid=207347&extra=page%3D1&frombbs=1[/url]

[[it] 本帖最后由 jrs123 于 2008-4-24 18:54 编辑 [/it]]

刨子头 发表于 2008-4-18 20:23

说的也是！

jrs123 发表于 2008-4-19 18:07

网上收集“关于窗体”的几个小程序：

在制作软件时，网上收集了不少小程序，今日整理一下，先将“关于窗体”的选出几个向大家介绍，希望对您有用；
1、打开窗体的各种方式：从左到右、从右到左、从上到下、左上到右下、右上到左下、从下到上、左下到右上以及中间到四周等。
2、窗体定时自动关闭；
3、鼠标滚动轮改变窗体大小；
4、控件大小随窗体变化；
5、右下角弹出小窗口并自动关闭；
6、带圆弧角的窗体（圆弧大小可调）；
7、Realone不可改变大小窗体；
8、Realone可改变大小窗体
9、类同XP导航窗体；
10、百叶窗方式打开窗体；
11、窗体居中（本教材“抛砖引玉之二”的窗体居中代码就是从这里找到的）；
12、漂亮的透明窗体；
13、无边框窗体；
14、窗体分割为左右两边；

刨子头 发表于 2008-4-19 22:38

赠人玫瑰手留余香！！！！！！

jrs123 发表于 2008-4-28 13:44

多工程结构的选用

这几天忙于在软件内增加视频内容,推迟了几天发帖；
2、多工程结构的选用——就是按每一届奥运会邮集作为一个工程。为此,多工程要解决如下几个问题:
(1)每个工程内各页面的转接;
   ***主页面间的转接——在工程内从一个主页面要转到forma2的页面时，就用下面代码:
   Unload forma2 '先关闭再打开,为什么要这样做您知道吗？
   Load forma2
   forma2.Show
   ***主页面向副页面转接——如点击主页面上的奖牌图“image1”，就弹出xj18a01a副页面，用下面代码：
Private Sub Image1_Click()
Load xj18a01a
xj18a01a.Show
End Sub
***主页面与网站的链接——当您点击主页面左上角的《奥运邮集》网站图标时，就会进入IE系统的奥运邮集网站；
有两个链接方案：
第一个方案：Shell "explorer.exe http://www.jrs123.com"——这个方案的优点是代码简单，但不足的是打开的网站网页是处于最小化状态；
第二个方案：需要二段代码和一个属性设置——这个方案的优点是打开网站的网页是处于最大化状态。缺点是代码多，设置稍烦锁。
第一段声明：
Private 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
Private Const SW_SHOW = 5
第二段转接代码：
Dim web As String '链接网站用,网址放在Combo1的属性Text中
  web = Combo1.Text
  ShellExecute 0&, vbNullString, web, vbNullString, vbNullString, 0
提示：被链接的网站网址要放在网址放在Combo1的属性Text中

jrs123 发表于 2008-4-28 13:46

副页面的奖牌榜

副页面的奖牌榜

[[it] 本帖最后由 jrs123 于 2008-4-28 13:51 编辑 [/it]]

nty23 发表于 2008-4-28 15:32

新开VB交流群，渴望大家踊跃加入，互相学习，共同进步，一起解决学习过程中遇到的困难。

新开VB交流群，渴望大家踊跃加入，互相学习，共同进步，一起解决学习过程中遇到的困难。
群名：中国编程论坛VB分坛
公告：在中国编程论坛（BBS.BCCN.NET）平台交流的基础上开设此交流群，以更加方便大家即时有效的进行沟通。
本群号：33393220
创建人：56272782

hjy881212 发表于 2008-4-29 11:47

怎么没有教程呀？

jrs123 发表于 2008-5-3 15:50

(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]]

wangtuan7788 发表于 2008-5-3 18:45

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
呵呵，不知道这样行不？

jrs123 发表于 2008-5-3 20:40

楼上朋友代码可行,已通过验证,
真不错,用此代码该工程至少省了三分之二的代码,
欢迎对奥运邮集软件代码多提宝贵意见!

jrs123 发表于 2008-5-6 18:11

为什么会出现自变量未定义错?

在悬浮窗的软件中采用上述方案,(即多了下面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

wangtuan7788 发表于 2008-5-6 22:14

加一句dim i as integer

jrs123 发表于 2008-5-7 11:09

还不行,请看附件,
还是变量未定义

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

wangtuan7788 发表于 2008-5-7 19:09

Dim i As Integer
Dim strWinName As String
Dim hLong As Long, LpID As Long, Ltem As Long

jrs123 发表于 2008-5-9 09:38

通过了,谢谢wangtuan7788

jrs123 发表于 2008-5-10 08:51

系统退出的两种不同方式

(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

hxfly 发表于 2008-5-10 17:24

这样的原创文章应该加精，BCCN的强大离不开你们......

页: 1 [2] 3 4