frmsplash.frm

一个vb编写的程序

VERSION 5.00
Begin VB.Form frmSplash 
   BorderStyle     =   0  'None
   ClientHeight    =   3750
   ClientLeft      =   210
   ClientTop       =   1380
   ClientWidth     =   3240
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "frmSplash.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3750
   ScaleWidth      =   3240
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   3756
      Left            =   0
      Picture         =   "frmSplash.frx":030A
      ScaleHeight     =   3750
      ScaleWidth      =   3270
      TabIndex        =   0
      Top             =   0
      Width           =   3276
      Begin VB.Timer Timer1 
         Interval        =   4000
         Left            =   600
         Top             =   1920
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "主页:cehome.yeah.net"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   7.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   156
         Left            =   1440
         TabIndex        =   4
         Top             =   3360
         Width           =   1656
      End
      Begin VB.Label Label3 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "1999年10月10日"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   7.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C00000&
         Height          =   204
         Left            =   1872
         TabIndex        =   3
         Top             =   3168
         Width           =   1212
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "程序设计"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   7.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   150
         Left            =   1860
         TabIndex        =   2
         Top             =   2925
         Width           =   600
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "程序收集1.0"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000C0&
         Height          =   252
         Left            =   816
         TabIndex        =   1
         Top             =   240
         Width           =   1788
      End
   End
End
Attribute VB_Name = "frmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
  Call PutWindowOnTop(Me)
  If Right$(App.Path, 1) <> "\" Then
     MyStr$ = App.Path + "\MySelect.mdb"
   Else
     MyStr$ = App.Path + "MySelect.mdb"
 End If
If Not FileExist(MyStr$) Then
'如当前目录下不存在，则创建数据库
 Dim DefaultWorkspace As Workspace
 Dim MyDatabase As Database, FldVal1 As String, FldVal2 As String
 Set DefaultWorkspace = DBEngine.Workspaces(0)
 Set MyDatabase = DefaultWorkspace.CreateDatabase(MyStr$, dbLangGeneral)
 Set MyTableDef = MyDatabase.CreateTableDef("程序收集")
 Set MyField = MyTableDef.CreateField("程序名称", dbText, 100)
 Set MyField1 = MyTableDef.CreateField("附注", dbMemo)
 MyTableDef.Fields.Append MyField
 MyTableDef.Fields.Append MyField1
 MyDatabase.TableDefs.Append MyTableDef
 Set MyTable = MyDatabase.OpenRecordset("程序收集", dbOpenDynaset)
 MyTable.AddNew
 FldVal1 = "关于本软件"
    HH0$ = Chr$(13) + Chr$(10)
    SM$ = "     程序收集 1.0属免费软件。您是否为了找寻一篇下" + _
    "载的文章或程序不知放在那里而着急，是否对太多有价值的文章" + _
    "无法管理而头疼，作者在这方面有太多感触，由此，“程序收集”" + _
    "诞生了。这是作者编写的第一个真正意义上的自由软件，其余编写" + _
    "的大多为专业软件，现正主要参与开发“十三陵大坝安全监测管理" + _
    "系统”，此为忙里偷闲之作品，希望您能够喜欢。使用方法见帮助。" + _
    "如果您想要作者收集的VB程序，请到作者的主页：cehome.yeah.net" + _
    "下载；如果您想要该软件的源代码，也请来访问。希望您能够留言，" + _
    "提出宝贵意见，以便我改进该作品，也希望您能在此基础上写出更" + _
    "好的软件。您如是VB爱好者，请来信交流，我必尽己所能。作者" + _
    "自学VB一年有余，有时为某一功能的实现要花费许多时间，深知" + _
    "编程之苦、之乐。此为抛砖引玉，目的是希望更多的程序员公布" + _
    "自己的源代码，促进中" + _
    "国软件事业的发展。若您有疑问，可E-mail:[e-mail]" + HH0$
    SM$ = SM$ + "     " + HH0$
    SM$ = SM$ + "              海军最后修改于99年11月" + HH0$
 FldVal2 = SM$
 MyTable("程序名称") = FldVal1
 MyTable("附注") = FldVal2
 MyTable.Update
 MyDatabase.Close
End If
End Sub

Private Sub Picture1_Click()
 Unload frmSplash
End Sub

Private Sub Timer1_Timer()
 Unload Me
 Timer1.Enabled = False
End Sub