mdiform1.frm

用户MODBUS规约通信编程,起参考作用.

    frmlocation.Top = 2500
frmlocation.Show
End Sub

Private Sub lblEdit_Click()
PlaySound 61
frmperson.Left = 4000
frmperson.Top = 2500
   
frmperson.Show

End Sub

Private Sub lblExplore_Click()
PlaySound 61
frmshowtimes.Show
End Sub

Private Sub lblFind_Click()
PlaySound 61
frmbang.Left = 4000
    frmbang.Top = 2500
frmbang.Show
End Sub

Private Sub lblHelp_Click()
PlaySound 61
frmplan.Show
End Sub

Private Sub lblShowAll_Click()
PlaySound 61
frmthing.Left = 4000

    frmthing.Top = 2500
frmthing.Show
End Sub

Private Sub MDIForm_Load()
On Error Resume Next
Dim str1 As String
Dim str2 As String
InSound = True '有声音

ply2.Open (App.Path & "\mfc2.avi")
 ply2.Play
sql.Visible = False

str1 = GetSetting(appname:="MyApp", Section:="Text3", Key:="Value", Default:="show")

str2 = GetSetting(appname:="MyApp", Section:="text2", Key:="Value", Default:="可以自己设定的")
 
 frmmain.Caption = str2
 
If str1 = "show" Then
Picture1.Visible = True
noshow.Caption = "隐藏导航栏"
Else
Picture1.Visible = False
noshow.Caption = "显示导航栏"
End If


 Dim newdate As Date
    newdate = Now
     StatusBar1.Panels(4).Text = Year(newdate) & "-" & Month(newdate) & "-" & Day(newdate)
     Me.WindowState = 2
    Dim strtxt As String
   Open App.Path & "\save.txt" For Input As #1
     
     Input #1, strtxt
      Close 1
      frmmain.Picture = LoadPicture(strtxt)
      If UserPow <> "管理员" Then
      menu_date.Enabled = False
      user_man.Enabled = False
       If UserPow <> "操作员" Then
       menu_sys.Enabled = False
       menu_sysman.Enabled = False
       add_data.Enabled = False
       Picture1.Enabled = False
       
       
       date_an.Enabled = False
add_per.Enabled = False
up_per.Enabled = False
       End If
       End If
       Command11.Enabled = False
       
        StatusBar1.Panels(3).Text = UserPow
         StatusBar1.Panels(2).Text = userID
         
         
         
       
        Open App.Path & "\savecom.txt" For Input As #1
     fp

    Input #1, strfile

 Close (1)
 strfile = Trim(strfile)
 
       
      
      
      
      
     
     
     
End Sub


Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
zip
End Sub

Private Sub modify_Click()
frmchangepwd.Show
End Sub

Private Sub noshow_Click()
Dim str2 As String
If noshow.Caption = "隐藏导航栏" Then
noshow.Caption = "显示导航栏"
str2 = "hide"

Picture1.Visible = False
Else
noshow.Caption = "隐藏导航栏"
Picture1.Visible = True
str2 = "show"

End If
SaveSetting "MyApp", "text3", "Value", str2

End Sub

Private Sub person_Click()
frmperson.Left = 4000
frmperson.Top = 2500
   
frmperson.Show

End Sub

Private Sub se_table_Click()
frmdeltab.Show

End Sub

Private Sub sql_Click()
frmsql.Show

End Sub

Private Sub thing_Click()
frmthing.Left = 4000

    frmthing.Top = 2500
frmthing.Show

End Sub

Private Sub restore_Click()
restore1

End Sub

Private Sub table_backup_Click()
frmtableb.Show

End Sub

Private Sub table_restore_Click()
frmtabler.Show

End Sub



Private Sub time_plan_Click()
frmplan.Show
End Sub

Private Sub timeplan_Click()
frmplan_ex.Left = 4000
frmplan_ex.Top = 2500

frmplan_ex.Show
End Sub

Private Sub timers_plan_Click()
frmshowtimes.Show

End Sub

Private Sub times__plan_Click()
frmplan_times.Show
End Sub

Private Sub up_per_Click()
test.Show
End Sub

Private Sub user_man_Click()
frmadduser.Show

End Sub

Private Sub where_Click()
frmlocation.Left = 4000
    frmlocation.Top = 2500
frmlocation.Show

End Sub
Private Sub backupsub()
 Dim i As String
    On Error Resume Next
    With cdlog1
        .DialogTitle = "数据备份"
        .InitDir = App.Path & "\backup"
        
        .filename = "backup.mdb"
        .Filter = "(数据库)*.mdb|*.mdb"
        .CancelError = True
        .ShowSave
        i = .filename
    End With
    If Right$(App.Path, 1) <> "\" Then spath = App.Path & "\"
    ssource = spath & "jk.mdb"
    sdest = i
    If Err.number <> cdlCancel Then
      On Error GoTo sjbf_error
      If Dir$(i) <> "" Then
        s = MsgBox("文件已存在,确认替换它！", vbYesNo + vbQuestion)
        If s = vbYes Then
          FileCopy ssource, sdest
           frmmsg.msg.MsgChar = "备份成功"
          frmmsg.Show
      
          
        Else
         backupsub
         
          
        End If
      Else
          FileCopy ssource, sdest
          frmmsg.msg.MsgChar = "备份成功"
          frmmsg.Show
      
      End If
    End If
    Exit Sub
sjbf_error:
    If Err = 70 Then
   frmmsg.msg.MsgChar = "数据库正在使用，请关闭所有数据窗口，从新开始备份"
   frmmsg.Show
    Else
    frmmsg.msg.MsgChar = Err.Description
    frmmsg.Show
    End If
End Sub
Private Sub restore1()
Dim i As String
    On Error Resume Next
        With cdlog1
        .DialogTitle = "数据恢复"
        .InitDir = App.Path & "\backup"
        .Filter = "(数据库)*.mdb|*.mdb"
        .CancelError = True
        .Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
        .ShowOpen
        i = .filename
    End With
    ssource = i
    If Right$(App.Path, 1) <> "\" Then spath = App.Path & "\"
    sdest = spath & "jk.mdb"
         If Err.number <> cdlCancel Then
        On Error GoTo sjh_error
         s = MsgBox("系统数据将全部丢失，确认要从数据文件" & i & "中恢复系统数据吗？", vbYesNo + vbQuestion)
         If s = vbYes Then
          FileCopy ssource, sdest
          frmmsg.msg.MsgChar = "恢复成功"
          frmmsg.Show
          End If
          
         End If
         
    Exit Sub
    
sjh_error:
    If Err = 70 Then
     frmmsg.msg.MsgChar = "数据库正在使用，请关闭所有数据窗口，从新开始恢复"
   frmmsg.Show
    Else
    
  frmmsg.msg.MsgChar = Err.Description
  frmmsg.Show
  
    End If
End Sub



Private Sub del()
On Error GoTo my_error:
 s = MsgBox("确认清空以前的数据记录！", vbYesNo + vbQuestion, "确认")
 If s = vbYes Then
 Dim db2 As Connection
 Set db2 = New Connection
 db2.CursorLocation = adUseClient
 db2.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("jk.mdb")
 string1 = "delete from 棒号设置表"
 db2.Execute string1
 string1 = "delete from 地点设置表"
 db2.Execute string1
 string1 = "delete from 读入表"
 db2.Execute string1
 string1 = "delete from 巡检结果表"
 db2.Execute string1
 string1 = "delete from 密码表"
 db2.Execute string1
 string1 = "delete from 人员设置表"
 db2.Execute string1
 
 string1 = "delete from 事件设置表"
 db2.Execute string1
 string1 = "delete from 计划设置表"
 db2.Execute string1
 string1 = "delete from 计划次数表"
 db2.Execute string1
 string1 = "delete from 人员信息表"
 db2.Execute string1
 frmmsg.msg.MsgChar = "数据记录清空成功!"
 frmmsg.Show
 
End If
Exit Sub
my_error:
   frmmsg.msg.MsgChar = Err.Description
  frmmsg.Show
End Sub
Private Sub CommandFallSnow_Click()






End Sub
Sub SetInitialSnowPositions(Optional DrawInitialParticles As Boolean = False)



End Sub

Sub SetSpeed()

Dim vx As Single, vy As Single, R As Single
vx = 3
vy = 5
R = 3.5
Timer1.Interval = 20

'Vx,yMin,MaxSnow: determine Min,Max value of absolute speed
'VxMinSnow = -1.5: VxMaxSnow = 1.5
'VyMinSnow = -1: VyMaxSnow = 2

'Vx,yAddMin,Max: determine Min,Max of rate of change in speed (i.e. acceleration)
VxAddMin = -0.1: VxAddMax = 0.1
VyAddMin = -0.1: VyAddMax = 0.1


VxMinSnow = vx - R / 2: VxMaxSnow = vx + R / 2
VyMinSnow = vy - R / 2: VyMaxSnow = vy + R / 2

End Sub

Sub AnimateSnow(Optional DrawParticles As Boolean = -1)


End Sub



Sub SetValueInRange(v As Variant, ByVal RangeMin As Variant, ByVal RangeMax As Variant, Optional SwapMaxMin As Boolean = False)
 If SwapMaxMin Then 'swapMaxMin=True:
  If v < RangeMin Then v = RangeMax Else If v > RangeMax Then v = RangeMin
 Else 'default (swapmaxmin=false)
  If v < RangeMin Then v = RangeMin Else If v > RangeMax Then v = RangeMax
 End If
End Sub







Private Sub windows_Click()
frmchangewin.Show

End Sub