《奥运邮集》软件代码介绍——VB6初学之友

一开始，《奥运邮集》是选用了编制成“网页”的形式。而且整整用了“一年”的时间完成的《奥运邮集》网站制作。
    遗憾的是，“网页”式的《奥运邮集》浏览起来，效果极不理想（至少偶是这么认为的），于是就决定推翻重来。
    偶是学机械的，对“编程”也是一窍不通。于是花了很长一段时间，在“百度”上寻求，要学哪种编程语言合适......

[[it] 本帖最后由 jrs123 于 2008-6-7 14:27 编辑 [/it]]

我在考虑是不是把这个帖子给转移掉
怎么感觉废话好多。。。

二、选学什么编程软件？
这也是如今在论坛上常遇到的问题。偶为之也大动过脑筋。最终结论如下：
1.VB：是初学者的首选。容易入门和学习速度快，软件界面友好。更重要的是有较好的学习氛围和人气较旺的论坛。
2. PB：是开发大型MIS及各类数据库跨平台应用的首选，属高级编程语言，有关书籍的缺乏，其基础语言也不适合初学者。
3. C++ Builder/Dephi：是唯一一套能够同时适用于开发数据库应用、网络及Web应用、分布式应用、可重用组件、系统软件、驱动程序、多媒体及游戏等所有软件的高效率开发环境。但其基础语言不够通用和开发系统软件功能不足。这也不适宜偶的选用。
4. VC：从功能上讲除了跨平台应用外什么都可开发。基础语言的普及程度高，以及其代码的执行效率高等特性、VC自带强大帮助文档和大量优质教材，VC在数据库开发工具中始终可以稳住阵角。这可以是初学者选用之一。
5. JAVA：由于其开发环境的配置较难，偶不选它。
    虽然微软抛弃了VB6，但作为基本语言的一种可视化编程工具。在中国乃至全世界都有它的身影，它曾是最为流行的编程工具，到现在还占据着非常重要的地位。再往远处说，它好比交通工具中的“自行车”，若干百年后，汽车、摩托车、火车以至飞机都有可能被淘汰，但“自行车”将始终是人类生活和运动的伴侣。
     虽然偶最终是选用了VB6。但在学习中还是遇到了不少困难，不然也不会在这个论坛发二百多个帖子（几乎都是提问）。而且也体会到微软为何要弃儿了。

四、初识VB6
    从VB6系统的初始界面，可以看到有10可见的栏目需要偶去了解的：
    1、菜单条——提供了VB6绝大部分的命令和方法。偶编辑《奥运邮票》软件，只选用了其中一部分内容：
    (1)文件(F)——这里面偶用到的只有二项：（见图中红三角）
    “工程另存为”：一般情况下，完成一个程序编辑存盘时，会形成一个“文件”，这个文件名默认是“工程1”。当您需要将它改为其它的文件名时，如改为“奥运邮集”、“第1届”、“第2届”......等文件名时，就要到这里来改。
    提示：文件名改完之后，但原来的文件，如“工程1”在文件夹中还有，可以将其删除。(实际上是删除二个对应的文件,您知道是哪两个吗?)
    “生成工程1.exe(K)”:点击此栏后，会弹出一个对话框，系统问你要将这个“工程1.exe”文件放在何处。这时，你可以将“工程1”改为你需要用的文件名，如olpk、xj1、xj2......等。
    提示：由此功能生成的exe文件就可以在任何一台电脑上独立运行。如偶完成的“奥运邮集.exe”、“xj1.exe”、“xj2.exe”等各届奥运邮集。

(2)视图(V)——在正常情况下，这一栏是用不到的。但一旦图中红三角各项（即前面的系统界面图中的3-8项）没有了，或不正常时，就要从这个栏目恢复；（在偶然一次用了一个清理电脑垃圾程序后，这几项有的就消失了）
  恢复的方法很简单：点击它们后，就会弹出相应的视图，只是它们的位置需要您自己去摆放；（您不妨自己试试？）

(4)工具(T)——《奥运邮集》软件用的该栏的唯一功能是“菜单编器(M)”（见工具图红三角）。点击此处，弹出“菜单编辑器”的对话框（见菜单编辑器图）。
    编辑举例如下：在(1)框内容输入奥运邮集(Y)，然后在(2)框内输入英文代码“oy”；
                  当输入下一行内容时，要点击(3)位置的“下一个(N)”钮；
                  由于“第1届、第2届......”是“奥运邮集(Y)”菜单下面的子菜单目录，所以要点一下在(5)位置的向右“→”箭头钮（即右移一位），然后再输入第1届和代码xj1；
    灰色失效栏：“第6届”奥运会因第一次世界大战而未举办，所以“第6届”应是灰色，处于“失效”状态，即将(6)位置的“有效(E)”钮前面的勾去掉。
    提示：a)凡窗体菜单栏上的各项（见主页图），如奥运邮集、奥运话史、奥运与中国......等各栏编辑时都要靠最左端（与“奥运邮集(Y)”对齐）；
          b)如果“第1届”的下面还有子菜单，如第1页，第2页等，则通过“→”箭头钮，将它们的位置再右移一位；
    完成“菜单目录”编辑后，就点确定，结果如“主页图”所示。

顶。支持！

六、《奥运邮集》软件窗体页面的结构
    1、邮票图片的载体——考虑到《奥运邮集》邮票的数量大，所以每个页面要尽量多的放置邮票，偶采用了如下操作和页面的结构选择：
    第一步：启动VB6系统，屏幕出现如7楼所示的系统图；
    第二步：点击“工具箱”上的“Frame”控件，见页面结构图中（4）；此时鼠标形成十字，在Form1窗体内拖出一个“Frame1”的控件，见页面结构图中（5）。为了满足奥运邮集软件的需要，偶对“Frame1”控件的属性作如下的设置：(见Frame1属性图)
    控件名称，见(1)：未变更；
    控件底图，见(2)：各页可选不同底色；
    BackColor，见(3):选0-None为边框不可见（若选1-Fixed Single为边框可见）；
    Caption，见(4):为空。经(3)(4)两项属性选定后，页面上就见不到此控件的名称和边框线了（见XJ7图）；
    Enabled，见(5):选True，即表示当鼠标移到该控件上时，鼠标会显示属性ToolTipText，见(7)上面所设置的字体，如“点击邮票放大”的提示；
    Height，见(6)：这可以按需要来确定此控件的高度。应注意的是此高度不能大于32000，否则运行软件时会出现“溢出”错误；
    此外，所有页面的宽度Width，见(8)统一选定为15200；
    提示：关于高、宽的单位将取决于“窗体Form”属性中ScaleMode的参数设定。本软件是选用默认的1-Twip；（偶曾吃过这个亏，各窗体不一致，结果各页高度和宽度都乱套了）

3、窗体的居中——就是处于不同的分辨率的屏幕，窗体都显示在屏幕的中央。看似容易的问题，但在偶的奥运邮集软件始终未能解决,多个论坛上已经发了不少有关的帖子,也有不少高手介入，至今还没有解决。
    在VB6中令窗体的居中常用二种方法：一是从属性StartUpPpsition中选“2-屏幕中心”（或用鼠标将窗体拖至屏幕中心，见屏幕中心属性图的红三角所示）；另一种是用代码：frame.left=(form.width-frame.width)/2等代码;
    在《奥运邮集》软件中这些方法却不能见效。为此，偶再次将这个问题放在《奥运邮集》软件的窗体居中问题——“抛砖引玉篇”（之二），希望能得到解决。详见:
          https://bbs.bccn.net/thread-199571-1-1.html

[[it] 本帖最后由 jrs123 于 2008-4-11 20:41 编辑 [/it]]
已解决窗体居中的解决方案如下
Private Sub form_resize()
        Frame1.Left = (Me.ScaleWidth - Frame1.Width) / 2 '采用这段代码窗体居中问题就解决了,
End Sub

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

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

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

说的也是！

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

副页面的奖牌榜

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

怎么没有教程呀？

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

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

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

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

通过了,谢谢wangtuan7788

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

***软件整体退出——整体退出需要返回到“主页面”，可以通过三个钮来实现，见图。代码如下：
'整体退出声明
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 bQuestion As Boolean
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '从窗体关闭钮用此段
    If UnloadMode = 0 Then bQuestion = True
End Sub
Private Sub Command1_Click() '“退出系统”钮用此段
bQuestion = True
    Unload Me
End Sub
Private Sub cdtc_Click() '菜单栏上“退出系统”钮用此段
bQuestion = True
    Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer) '关闭钮共用部分
     If bQuestion Then
        If MsgBox("您确实要退出《奥林匹克运动会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") <> vbYes Then
            Cancel = True
            Exit Sub
        Else
            hLong = FindWindow(vbNullString, strWinName)
            If hLong Then
                GetWindowThreadProcessId hLong, LpID
                Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
                TerminateProcess Ltem, 0
                hLong = 0
            End If
        End If
    End If
    UnHook Me.Hwnd '鼠标滚轮事件用
    For Each pForm In Forms
        Unload pForm
    Next
     Dim i As Integer '循环关闭各窗体用
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
strWinName = "olp" '关闭“悬浮窗体”用
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

八、悬浮窗体的功能与代码
      奥运邮集有夏季29届、冬季20届，因为需要向用户提供一个友好的、操作方便的换届方式。为此，偶在奥运邮集软件中采用了几种不同的窗体切换方式：
    1、主页上的菜单——即通过主页上的菜单（见图a1-tp3）。打开任一届奥运邮集。该方式的特点是，通过该菜单可以连续打开各届奥运邮集；
    2、各届奥运邮集的换页钮和换届钮——该方式的特点是：
    (1)可以连续打开本届各页邮票或相邻届的奥运邮集的第一页；
    (2)点击窗体右上角的关闭钮，可单独关闭该窗体；
    (3)点击退出本届奥运邮集时，可同时关闭本届所有已打开的窗体；（注：这组代码上面39楼已介绍过了）
    3、采用隐藏在屏幕左边的悬浮窗体切换各届奥运邮集——这一方式的特点是打开一届，即关闭已打开的其余各届（注：此代码上面31楼已介绍过了）；
    下面，向大家介绍一组下拉式悬浮窗的代码：（悬浮窗隐藏在屏幕上方：）
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
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 Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
    ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const HWND_TOPMOST = -1
Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
     End Type
Private Is_Move_B As Boolean
Private Is_Movestar_B As Boolean
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long
Private max As Long
Private Sub Form_Load()
        Timer1.Interval = 50: Timer2.Interval = 1000
        Form1.BackColor = vbBlue
        Get_Windows_Rect
        Picture1.Width = 10700
        Form1.Width = 10770
     End Sub
Sub Get_Windows_Rect()
        Dim dl&
        max = 2200: Form1.Height = max '窗体高度调整
        Form1.Top = 0
        dl& = GetWindowRect(Form1.hwnd, MyRect)
        End Sub
Private Sub Form_Paint()
        If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
             SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
                  Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
                  Form1.Height \ Screen.TwipsPerPixelY, 0
        End If
End Sub
Private Sub Timer1_Timer()
       Dim dl&
       dl& = GetCursorPos(MyPoint)
           If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
                     Form1.Height = max) Or MyPoint.Y <= 30 Then
                         Form1.BackColor = vbBlue
                Form1.Height = max
                         If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
                   Screen.MousePointer = 15
                   Is_Move_B = True
                Else
                   Screen.MousePointer = 0
                   Is_Move_B = False
          End If
                Else
               If Not Is_Movestar_B Then
                  Form1.Height = 30
               End If
            End If
 End Sub

在窗体中有以下几种文字说明：
    1、留言式的奥运问答题——单击文字框，在弹出的文字输入框，在此框内可输入答案（见图）。该方案代码由二部分组成：
    '第一部分：
    Private Sub Form_Load()
    Text1.Text = GetSetting("MyApp101", "保存留言", "内容", "")
    Text2.Text = GetSetting("MyApp102", "保存留言", "内容", "")
    End Sub
    '第二部分：
    Private Sub Text1_Click()
    Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text1.Text = myValue
        SaveSetting "MyApp101", "保存留言", "内容", myValue
    End If
   End Sub
提示:每个留言框有自己的代号,如MyApp101、 MyApp102等，二组代码的代号要一致。

[[it] 本帖最后由 jrs123 于 2008-5-21 07:05 编辑 [/it]]

在制作《奥运邮集》软件过程中采用了几个软件，今将抓图软件介绍如下，因有的软件过大（5.82M）无法上传，需要的请留信箱；
    抓图软件HyperSnap-DX简介： （有注册机）
    HyperSnap-DX 是个有名的屏幕抓图工具（见图），它不仅能抓住标准桌面程序还能抓取 DirectX, 3Dfx Glide 游戏和视频或 DVD 屏幕图。
    本程序能以 20 多种图形格式（包括：BMP, GIF, JPEG, TIFF, PCX 等）保存并阅读图片。可以用热键或自动记时器从屏幕上抓图。
    功能还包括：在所抓的图像中显示鼠标轨迹，收集工具，有调色板功能并能设置分辨率，还能选择从 TWAIN 装置中（扫描仪和数码相机）抓图。
    ---== HyperSnap-DX v5.20.01 汉化注册版安装提示 ==---
    1：解压后运行HS5Setup52001.exe安装原版程序；
    2：再运行HB-HysnapDx52001-NW.exe安装汉化补丁。
    3：内附KeyGen.exe为注册机：
    注册提示：(也可按"注册全攻略"的示图提示进行注册)
    1：要选择“Purchase single licenses”--Next 才可获得您的机器码
    2：复制机器码到注册机，得到注册码后复制注册完成：）wdte

1、软件发布信息——就是在软件上设一个能向用户发送信息的文字框。
    偶在《奥运邮集》的主页面的右下角有个信息发布小窗体（见图1），以及在每一届的第一页上都有一个“最新信息”发布栏（见图2）。
    制作方法如下：
   （1）先添加Mirosoft Internet Transfer Control 6.0 (sp6)控件
   （2）若是固定的文字框，即在窗体上拖出Text1文字框，其属性：
        ScrollBars取2-Vertial（垂直滚动条）；
        MultiLine取True(多行显示)
        Locked取True(锁定文字)
   （3）代码：(放在:Private Sub Form_Load()内)
        Text6.Text = Inet1.OpenURL("http://www.) <!--将各届所有的新信息txt文件都放在XX文件夹内-->
重要提示:在页面上要拖出Inet控件!(见图)

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