frmmain.frm

本系统是给大庆油田做的一个示例程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmMain 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "检泵时机优选软件"
   ClientHeight    =   8835
   ClientLeft      =   -15
   ClientTop       =   615
   ClientWidth     =   14805
   ControlBox      =   0   'False
   Icon            =   "FrmMain.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   8835
   ScaleWidth      =   14805
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog cm1 
      Left            =   2160
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog CmdClr 
      Left            =   2040
      Top             =   1440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog CmdLoad 
      Left            =   2925
      Top             =   1470
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   60
      Left            =   3960
      Top             =   1380
   End
   Begin VB.Image Image1 
      Height          =   8430
      Left            =   1965
      Stretch         =   -1  'True
      Top             =   135
      Width           =   12030
   End
   Begin VB.Menu MenuS 
      Caption         =   "管理设置(&S)"
      WindowList      =   -1  'True
      Begin VB.Menu MenuS_PrintSet 
         Caption         =   "打印设置"
         Begin VB.Menu MenuS_PrintSet_PrinterSet 
            Caption         =   "打印机设置"
         End
         Begin VB.Menu H21 
            Caption         =   "-"
         End
         Begin VB.Menu MenuS_PrintSet_PaperSet 
            Caption         =   "打印页面设置"
         End
      End
      Begin VB.Menu MenuS_ChangPassword 
         Caption         =   "更改密码"
      End
      Begin VB.Menu MenuS_Background 
         Caption         =   "背景设置"
         Begin VB.Menu MenuS_Background_Backcolor 
            Caption         =   "设置背景颜色"
         End
         Begin VB.Menu H22 
            Caption         =   "-"
         End
         Begin VB.Menu MenuS_Background_Patern 
            Caption         =   "设置背景图案"
         End
         Begin VB.Menu H23 
            Caption         =   "-"
         End
         Begin VB.Menu MenuS_Background_Wave 
            Caption         =   "设置背景音乐"
            Begin VB.Menu MenuS_Background_WaveOpen 
               Caption         =   "打  开"
            End
            Begin VB.Menu H31 
               Caption         =   "-"
            End
            Begin VB.Menu MenuS_Background_Wave_Close 
               Caption         =   "关  闭"
            End
         End
      End
   End
   Begin VB.Menu MenuR_Data 
      Caption         =   "参数录入(&R)"
   End
   Begin VB.Menu MenuR_Simulation 
      Caption         =   "漏失量分析(&P)"
   End
   Begin VB.Menu MenuR_SimulationMoreDates 
      Caption         =   "检泵时机优选(&O)"
   End
   Begin VB.Menu MenuR_CyjMoving 
      Caption         =   "抽油机机构示意"
   End
   Begin VB.Menu MenuH 
      Caption         =   "帮助版权(&H)"
      Begin VB.Menu MenuH_Use 
         Caption         =   "软件使用 "
      End
      Begin VB.Menu H19 
         Caption         =   "-"
      End
      Begin VB.Menu MenuH_About 
         Caption         =   "关于…"
      End
   End
   Begin VB.Menu MenuX 
      Caption         =   "退出系统(&X)"
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Rem 装入主窗体时的事件过程
Private Sub Form_Load()

  MainFormHeigh = Me.Height
  MainFormWidth = Me.Width
  Me.Left = 0
  Me.Top = 0
  Me.Height = Screen.Height
  Me.Width = Screen.Width
  Image1.Top = 0
  Image1.Left = 0
  Image1.Width = Me.Width
  Image1.Height = Me.Height
  On Error GoTo eedd '设置错误陷阱
  Open CurPath & "roddatazy.ini" For Input As #1
  Input #1, Mbackcolor
  Input #1, MBackpatern
  Input #1, MBackwave
  Input #1, PutPath
  Input #1, GetPath_ZHK
  Input #1, GetPath_ZYK
  Input #1, DSN
  Input #1, UID
  Input #1, PWD
  Input #1, DBF_SLCT
  Input #1, BJ_Left
  Input #1, BJ_Top
  Input #1, XK_Line
  Close #1

  If MBackpatern = "" Then
    FrmMain.BackColor = Mbackcolor
   Else
    Image1.Picture = LoadPicture(MBackpatern) '装入主背景图片
  End If
  
  Exit Sub
eedd:
  Close #1
  On Error Resume Next
  Mbackcolor = 6
  MBackpatern = CurPath & "rodback.jpg"
  MBackwave = 100
  Image1.Picture = LoadPicture(App.Path & "\rodback.jpg") '装入主背景图片
  
  BJ_Left = 10
  BJ_Top = 10
  XK_Line = 6
  Debug.Print CurPath & "roddatazy.ini"
  Open CurPath & "roddatazy.ini" For Output As #1
  Print #1, Mbackcolor
  Print #1, MBackpatern
  Print #1, MBackwave
  Print #1, PutPath
  Print #1, GetPath_ZHK
  Print #1, GetPath_ZYK
  Print #1, DSN
  Print #1, UID
  Print #1, PWD
  Print #1, DBF_SLCT
  Print #1, BJ_Left
  Print #1, BJ_Top
  Print #1, XK_Line
  Close #1
End Sub
Private Sub Form_Activate()
   Timer1.Enabled = True
End Sub

Private Sub Form_Deactivate()
  Timer1.Enabled = False
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then MenuX_Click 'Unload Me
    If KeyCode = vbKeyF1 Then PopupMenu MenuH
End Sub

Private Sub MenuR_CyjMoving_Click()
    CyjMoving.Show 1
End Sub

Rem 系统数据管理
Private Sub MenuR_Data_Click()
     DatasInput.Show 1
End Sub

Rem 动态仿真
Private Sub MenuR_Simulation_Click()
    Simulator.Show 1
End Sub

Private Sub MenuR_SimulationMoreDates_Click()
    MoreDatesSimulator.Show 1
End Sub

Rem  设置\打印设置\打印机设置菜单 单击事件过程
Private Sub MenuS_PrintSet_PrinterSet_Click()
    cm1.CancelError = True
    cm1.PrinterDefault = -1
    On Error GoTo eedd
    cm1.Orientation = Print_Director
    cm1.Action = 5
    Print_Director = cm1.Orientation
    PrintSet False, Print_XLeftPercent, Print_YTopPercent, Print_Director
    Exit Sub
eedd:
End Sub
Rem 设置\打印设置\打印页面设置菜单 单击事件过程
Private Sub MenuS_PrintSet_PaperSet_Click()
   FrmYeMian.Show 1
End Sub

Rem 设置\更改密码菜单 单击事件过程
Private Sub MenuS_ChangPassword_Click()
    FrmMiMa.Show 1
End Sub
Rem 设置\设置背景\设置背景颜色菜单 单击事件过程
Private Sub MenuS_Background_Backcolor_Click()
  On Error GoTo likl '设置错误陷阱
  CmdClr.CancelError = True
  CmdClr.Flags = &H1& '初始化“颜色设置对话框”
  CmdClr.Action = 3   '激活“颜色设置对话框”
  Image1.Picture = LoadPicture()   '清除主界面的背景图案
  FrmMain.BackColor = CmdClr.Color '设置主界面的背景颜色
  Mbackcolor = FrmMain.BackColor   '保存主界面的背景颜色
  MBackpatern = ""                 '清除背景图案文件名
likl: '错误处理子程序（不用处理）
End Sub
Rem 设置\设置背景\设置背景图案菜单 单击事件过程
Private Sub MenuS_Background_Patern_Click()
  Dim x As Integer
rr:
  '初始化“打开文件对话框”
  CmdLoad.Flags = &H400& Or &H800& Or &H1000&
  CmdLoad.InitDir = CurPath
  CmdLoad.Filter = "Pictures (*.bmp;*.jpg)|*.bmp;*.jpg"  '"text(*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
  CmdLoad.DefaultExt = "jpg"
  CmdLoad.CancelError = True
  
  On Error GoTo ed   '设置错误陷阱
  CmdLoad.Action = 1 '激活“打开文件对话框”
  Image1.Picture = LoadPicture(CmdLoad.FileName) '调入所选的图片文件（改变主界面的背景图案）
  MBackpatern = CmdLoad.FileName '保存所选的图片文件名
  Exit Sub
ed:
  If Err.Number = 32755 Then '在“打开文件对话框”中选定了“取消”按钮
    Exit Sub
  Else '其它错误
    Sound
    x = MsgBox("不是图形文件,请重新选择", 48, "    文件核对框 ")
    Close
    GoTo rr '返回的rr 处重新运行
  End If

End Sub
Rem 设置\设置背景\设置背景音乐\打开菜单 单击事件过程
Private Sub MenuS_Background_WaveOpen_Click()
  MainStart.MMControl1.Command = "play"
  MBackwave = 100
  MainStart.Timer2.Interval = MBackwave
End Sub
Rem 设置\设置背景\设置背景音乐\关闭菜单 单击事件过程
Private Sub MenuS_Background_Wave_Close_Click()
    Dim i As Integer
    MBackwave = 0
    MainStart.MMControl1.Command = "pause"
    MainStart.Timer2.Interval = MBackwave
    If Len(Dir(App.Path & "\Pic\*.*")) > 0 Then Kill App.Path & "\Pic\*.*"
End Sub

Rem 帮助\软件使用菜单 单击事件过程
Private Sub MenuH_Use_Click()
  FrmHelpw.Show 1
End Sub
Rem 帮助\关于…菜单 单击事件过程
Private Sub MenuH_About_Click()
    FrmAbout.Show 1
End Sub
Rem 退出菜单菜单 单击事件过程
Private Sub MenuX_Click()
  Dim filenum As Integer
  filenum = FreeFile()
    Open CurPath & "roddatazy.ini" For Output As #filenum
    Print #filenum, Mbackcolor
    Print #filenum, MBackpatern
    Print #filenum, MBackwave
    Print #filenum, PutPath
    Print #filenum, GetPath_ZHK
    Print #filenum, GetPath_ZYK
    Print #filenum, DSN
    Print #filenum, UID
    Print #filenum, PWD
    Print #filenum, DBF_SLCT
    Print #filenum, BJ_Left
    Print #filenum, BJ_Top
    Print #filenum, XK_Line
    Close #filenum
  End
End Sub
Private Sub Timer1_Timer()
  Static Y As Integer
  Y = Y + 1                             '图片计数器累加
  If Y = 18 Then Y = 0                  '如果图片计数器为18，则图片计数器清零
  Me.Icon = MainStart.Image1(Y).Picture  '在图片框（Picture1)中调入（显示）第Y个图片
End Sub