frmoptions.frm

VISUAL BASIC 6 实现的自动化控制系统程序. 里面包含了好几个OCX源代码.我5年前的作品.现在看起来有点垃圾了.

         TabIndex        =   35
         Top             =   1005
         Width           =   375
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "7号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Index           =   6
         Left            =   -73110
         TabIndex        =   34
         Top             =   1440
         Width           =   375
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "8号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Index           =   7
         Left            =   -73110
         TabIndex        =   33
         Top             =   1890
         Width           =   375
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "阀名"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FF00&
         Height          =   345
         Index           =   2
         Left            =   -72300
         TabIndex        =   32
         Top             =   540
         Width           =   615
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "1号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Index           =   0
         Left            =   -71220
         TabIndex        =   31
         Top             =   990
         Width           =   435
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "2号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Index           =   1
         Left            =   -71220
         TabIndex        =   30
         Top             =   1530
         Width           =   435
      End
      Begin VB.Label Label1 
         Caption         =   "宽度"
         Height          =   345
         Index           =   2
         Left            =   3150
         TabIndex        =   18
         Top             =   1560
         Width           =   405
      End
      Begin VB.Label Label1 
         Caption         =   "宽度"
         Height          =   255
         Index           =   1
         Left            =   3150
         TabIndex        =   17
         Top             =   1050
         Width           =   375
      End
      Begin VB.Label Label1 
         Caption         =   "宽度"
         Height          =   225
         Index           =   0
         Left            =   3150
         TabIndex        =   16
         Top             =   600
         Width           =   405
      End
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "应用"
      Height          =   375
      Left            =   4920
      TabIndex        =   2
      Top             =   4410
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3720
      TabIndex        =   1
      Top             =   4410
      Width           =   1095
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   2490
      TabIndex        =   0
      Top             =   4410
      Width           =   1095
   End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdApply_Click()
On Error GoTo ErrH:
Dim I As Integer

    '显示道路，修改宽度
    Call MapLineShow(CheckRoad.Value, CombRoadW.ListIndex + 1)
    
    '显示管路，修改宽度
    Call PipeLineShow(Checkpipe.Value, CombPipeW.ListIndex + 1)
    
    '显示河道，修改宽度
    Call RiveLineShow(CheckRive.Value, CombRiveW.ListIndex + 1)
    
    
    '道路颜色
    For I = 0 To 2
        FrmMain.LineRoadH(I).BorderColor = CommonDialog1.Color
        FrmMain.LineRoadV(I).BorderColor = CommonDialog1.Color
    Next
    FrmMain.LineRoadV(3).BorderColor = CommonDialog1.Color
    FrmMain.LineRoadV(4).BorderColor = CommonDialog1.Color
    FrmMain.LineRoadV(5).BorderColor = CommonDialog1.Color
    
    '管道颜色
    For I = 0 To 11
        FrmMain.PipeLine(I).BorderColor = CommonDialog2.Color
    Next
    
    '河道颜色
    FrmMain.LineRive1.BorderColor = CommonDialog3.Color

    '保存道路设置
SaveSetting "SL_RASCQ", "SETTING", "AppearRoad ", CheckRoad.Value
SaveSetting "SL_RASCQ", "SETTING", "RoadColor ", CommonDialog1.Color
SaveSetting "SL_RASCQ", "SETTING", "RoadWidth ", CombRoadW.ListIndex + 1

'保存管路设置
SaveSetting "SL_RASCQ", "SETTING", "AppearPiPe ", Checkpipe.Value
SaveSetting "SL_RASCQ", "SETTING", "PipeColor ", CommonDialog2.Color
SaveSetting "SL_RASCQ", "SETTING", "PipeWidth ", CombPipeW.ListIndex + 1

'保存河道设置
SaveSetting "SL_RASCQ", "SETTING", "AppearRive ", CheckRive.Value
SaveSetting "SL_RASCQ", "SETTING", "RiveColor ", CommonDialog3.Color
SaveSetting "SL_RASCQ", "SETTING", "RiveWidth ", CombRiveW.ListIndex + 1


'保存操作站是否可见
SaveSetting "SL_RASCQ", "SETTING", "AppearFFO ", CheckFFOShow.Value
For I = 0 To 3
    FrmMain.FFOTitl(I).Visible = CheckFFOShow.Value
Next

'保存流量显示框是否可见
SaveSetting "SL_RASCQ", "SETTING", "AppearFlux", CheckFlux.Value
Call ShowFlux(CheckFlux.Value)

'保存阀名和泵名
For I = 0 To 9
    If MaskEdBox2(I).Text <> "" Then
        SaveSetting "SL_RASCQ", "NAME", "TitlNameValve" & I, MaskEdBox2(I).Text
    Else
        SaveSetting "SL_RASCQ", "NAME", "TitlNameValve" & I, I & "号阀"
    End If
    FrmMain.MyValve(I).TitlName = MaskEdBox2(I).Text
Next
For I = 0 To 1
    If MaskEdBox1(I).Text <> "" Then
        SaveSetting "SL_RASCQ", "NAME", "TitlNamePump" & I + 1, MaskEdBox1(I).Text
    Else
        SaveSetting "SL_RASCQ", "NAME", "TitlNamePump" & I + 1, I + 1 & "号泵"
    End If
    FrmMain.MyPump(I).TitlName = MaskEdBox1(I).Text
Next

'
SaveSetting "SL_RASCQ", "SETTING", "MovieSpeed", Text1.Text
ShowMovieSpeed CInt(Text1.Text)

If Option1.Value = True Then
    IsColorSelect = True
    FrmMain.MainMap.Picture = Nothing
    SaveSetting "SL_RASCQ", "SETTING", "ColorSelect", 1
    '保存背景色
    SaveSetting "SL_RASCQ", "SETTING", "MapBackColor ", CommonDialog4.Color
    '地图颜色
    FrmMain.MainMap.BackColor = CommonDialog4.Color
    
    Mapshow '修改阀、泵控件的颜色（于地图相同）
Else
    IsColorSelect = False
    SaveSetting "SL_RASCQ", "SETTING", "ColorSelect", 0
    '保存背景图片
    SaveSetting "SL_RASCQ", "SETTING", "MapBackImage", CommonDialog5.FileName
    '地图背景图片
    FrmMain.MainMap.Picture = LoadPicture(CommonDialog5.FileName)
End If



Exit Sub
ErrH:
MsgBox "错误" & Err.Number & "  " & Err.Description & "！"
End Sub

Private Sub cmdCancel_Click()
    Unload Me
    FrmMain.Refresh
End Sub

Private Sub cmdOK_Click()
    cmdApply_Click
    Unload Me
    FrmMain.Refresh
End Sub

Private Sub CodColor_Click(Index As Integer)
Select Case Index
    Case 0
        CommonDialog1.ShowColor
    Case 1
         CommonDialog2.ShowColor
    Case 2
        CommonDialog3.ShowColor
End Select
End Sub

Private Sub Form_Load()
Dim I As Integer
'显示图表
MSChart1.RowCount = 8           '&&&阀数改变
For I = 2 To 9
    MSChart1.Row = I - 1
    MSChart1.RowLabel = FrmMain.MyValve(I).TitlName
    MSChart1.Column = 1
    MSChart1.Data = FrmMain.MyValve(I).FluxSpeed
    MSChart1.Row = I - 1
    MSChart1.Column = 2
    MSChart1.Data = FrmMain.MyValve(I).CurAmount
Next

    '置中窗体
 Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    
    '名字显示
For I = 0 To 9
    MaskEdBox2(I).Text = FrmMain.MyValve(I).TitlName
Next
For I = 0 To 1
    MaskEdBox1(I).Text = FrmMain.MyPump(I).TitlName
Next

    '路是否可见
If FrmMain.LineRoadH(0).Visible Then
    CheckRoad.Value = 1
Else
    CheckRoad.Value = 0
End If

    '管是否可见
If FrmMain.PipeLine(0).Visible Then
    Checkpipe.Value = 1
Else
    Checkpipe.Value = 0
End If

    '河是否可见
If FrmMain.LineRive1.Visible Then
    CheckRive.Value = 1
Else
    CheckRive.Value = 0
End If

    '操作站是否可见
If FrmMain.FFOTitl(0).Visible Then
    CheckFFOShow.Value = 1
Else
    CheckFFOShow.Value = 0
End If

    '流量显示框是否可见
If FrmMain.TxtFluxV(0).Visible Then
    CheckFlux.Value = 1
Else
    CheckFlux.Value = 0
End If

    '背景是图片还是单一的颜色
If IsColorSelect = True Then
    Option1.Value = True
    Option2.Value = False
    MapBlackImage.Enabled = False
Else
    Option1.Value = False
    Option2.Value = True
    MapBlackColor.Enabled = False
End If
'读入颜色
CommonDialog1.Color = FrmMain.LineRoadH(0).BorderColor
CommonDialog2.Color = FrmMain.PipeLine(0).BorderColor
CommonDialog3.Color = FrmMain.LineRive1.BorderColor
CommonDialog4.Color = FrmMain.MainMap.BackColor
CommonDialog5.FileName = GetSetting("SL_RASCQ", "SETTING", "MapBackImage", "c:\windows\Internet Explorer 墙纸.bmp")
CommonDialog5.InitDir = App.Path
CommonDialog5.Filter = "JPEG 图象 (*.JPG)|*.JPG|位图文件(*.BMP)|*.BMP|All Files (*.*)|*.*"

'读入线宽
For I = 0 To 6
    CombRoadW.AddItem (I + 1)
    CombPipeW.AddItem (I + 1)
    CombRiveW.AddItem (I + 1)
Next
CombRiveW.AddItem ("7")
CombRiveW.AddItem ("8")
CombRiveW.AddItem ("9")
CombRiveW.AddItem ("10")
CombRiveW.AddItem ("11")
CombRiveW.AddItem ("12")
CombRiveW.AddItem ("13")
CombRiveW.AddItem ("14")
Text1.Text = FrmMain.MyValve(0).Interval    '动画速度
CombRoadW.ListIndex = FrmMain.LineRoadH(0).BorderWidth - 1
CombPipeW.ListIndex = FrmMain.PipeLine(0).BorderWidth - 1
CombRiveW.ListIndex = FrmMain.LineRive1.BorderWidth - 1
End Sub

Private Sub Form_Resize()
'SetWindowPos frmOptions.hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
End Sub

Private Sub MapBlackColor_Click()
    CommonDialog4.ShowColor
End Sub

Private Sub MapBlackImage_Click()
    CommonDialog5.ShowOpen
End Sub

Private Sub MaskEdBox2_GotFocus(Index As Integer)
MaskEdBox2(Index).SelStart = 0
MaskEdBox2(Index).SelLength = 1
End Sub

Private Sub Option1_Click()
If Option1.Value = True Then
    MapBlackColor.Enabled = True
    MapBlackImage.Enabled = False
Else
    MapBlackColor.Enabled = False
    MapBlackImage.Enabled = True
End If
End Sub

Private Sub Option2_Click()
If Option2.Value = False Then
    MapBlackColor.Enabled = True
    MapBlackImage.Enabled = False
Else
    MapBlackColor.Enabled = False
    MapBlackImage.Enabled = True
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
    KeyAscii = 0
End If
End Sub

Private Sub Timer1_Timer()
Dim I As Integer
For I = 2 To 9              '&&&阀数改变
    MSChart1.Row = I - 1
    MSChart1.Column = 1
    MSChart1.RowLabel = FrmMain.MyValve(I).TitlName
    MSChart1.Data = FrmMain.MyValve(I).FluxSpeed
    MSChart1.Row = I - 1
    MSChart1.Column = 2
    MSChart1.Data = FrmMain.MyValve(I).CurAmount
Next
MSChart1.Refresh
End Sub