frmtmedit.frm

内容为：驾驶考试管理系统 内含说明书 可直接使用实例 VB+SQL

         Left            =   450
         TabIndex        =   2
         Top             =   315
         Width           =   7485
      End
      Begin VB.Label lblF 
         AutoSize        =   -1  'True
         Caption         =   "F、"
         Height          =   180
         Left            =   225
         TabIndex        =   23
         Top             =   2070
         Width           =   270
      End
      Begin VB.Label lblE 
         AutoSize        =   -1  'True
         Caption         =   "E、"
         Height          =   180
         Left            =   225
         TabIndex        =   22
         Top             =   1755
         Width           =   270
      End
      Begin VB.Label lblD 
         AutoSize        =   -1  'True
         Caption         =   "D、"
         Height          =   180
         Left            =   225
         TabIndex        =   21
         Top             =   1395
         Width           =   270
      End
      Begin VB.Label lblC 
         AutoSize        =   -1  'True
         Caption         =   "C、"
         Height          =   180
         Left            =   225
         TabIndex        =   20
         Top             =   1050
         Width           =   270
      End
      Begin VB.Label lblB 
         AutoSize        =   -1  'True
         Caption         =   "B、"
         Height          =   180
         Left            =   225
         TabIndex        =   19
         Top             =   720
         Width           =   270
      End
      Begin VB.Label lblA 
         AutoSize        =   -1  'True
         Caption         =   "A、"
         Height          =   180
         Left            =   225
         TabIndex        =   18
         Top             =   330
         Width           =   270
      End
   End
   Begin VB.Label lblTp 
      AutoSize        =   -1  'True
      Caption         =   "题目图片："
      Height          =   180
      Left            =   2460
      TabIndex        =   16
      Tag             =   "3330"
      Top             =   3945
      Width           =   900
   End
   Begin VB.Label lblTmda 
      AutoSize        =   -1  'True
      Caption         =   "题目答案："
      Height          =   180
      Left            =   2460
      TabIndex        =   15
      Tag             =   "2460"
      Top             =   3570
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "题目名称："
      Height          =   180
      Left            =   135
      TabIndex        =   14
      Top             =   495
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "题目编号："
      Height          =   180
      Left            =   135
      TabIndex        =   13
      Top             =   165
      Width           =   900
   End
End
Attribute VB_Name = "frmTmEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private miTmlx_id As Integer '题目类型编号
Private miTmlb_id As Integer '题目类别编号

Private rs As ADODB.Recordset '数据源
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

'设置
Public Property Let TmADORecordset(ByRef vNewValue As ADODB.Recordset)
    Set rs = vNewValue
End Property
'设置
Public Property Let Tmlx_id(ByVal vNewValue As Integer)
    miTmlx_id = vNewValue
End Property
'设置
Public Property Let Tmlb_id(ByVal vNewValue As Integer)
    miTmlb_id = vNewValue
End Property
Private Sub cmdBrowse_Click()
    Dim pfn As String '路径及文件名
    Dim fn As String '纯文件名
    '
    On Error GoTo ErrHandler
    
    CommonDialog1.CancelError = True
    CommonDialog1.DialogTitle = "选择图片文件"
    CommonDialog1.Filter = "位图文件(*.bmp)|*.bmp|JPG文件(*.jpg)|*.jpg"
    CommonDialog1.FilterIndex = 1
    'Display the Open dialog box
    CommonDialog1.ShowOpen
    
    pfn = CommonDialog1.FileName
    fn = CommonDialog1.FileTitle
    
    If pfn <> (GetAppPath() & "pic\" & fn) Then '在给定图片路径下不存在
        CopyFile pfn, GetAppPath() & "pic\" & fn, 0
    End If
    '--------------------------------------------------------------
    Text1(9).Text = "pic\" & fn
    
    Picture2.Picture = LoadPicture(GetAppPath() & Text1(9).Text)
    Picture2.AutoSize = True
    PaintImage PictureScaleRatio(Picture2, Picture1) * Picture1.ScaleWidth, PictureScaleRatio(Picture2, Picture1) * Picture1.ScaleHeight, Picture2, Picture1, GL_DISPLAY_CENTER
    
    Exit Sub
ErrHandler:
    '按了"取消"按钮
End Sub
Private Sub cmdCancel_Click()
    rs.CancelUpdate
    Unload Me
End Sub
Private Sub cmdOK_Click()
    On Error GoTo ErrHandler
    
    '保存记录
    Adodc1.Recordset.Move 0
    
    Unload Me
    Exit Sub
ErrHandler:
    Adodc1.Recordset.CancelUpdate
    ErrMessageBox "保存记录cmdOK_Click()", Me.Caption
    Unload Me
End Sub
Private Sub Combo1_Click()
    txtTmda.Text = Combo1.Text
End Sub
Private Sub cmdClear_Click()
    Text1(9).Text = ""
    Picture1.Picture = LoadPicture()
    Picture2.Picture = LoadPicture()
End Sub

Private Sub Form_Load()
    On Error Resume Next
    
    '是选择题还是判断题
    Select Case miTmlx_id
        Case 0 '选择题
            Me.Caption = "修改选择题"
            Combo1.AddItem "A"
            Combo1.AddItem "B"
            Combo1.AddItem "C"
            Combo1.AddItem "D"
            Combo1.AddItem "E"
            Combo1.AddItem "F"
        Case 1 '判断题
            Me.Caption = "修改判断题"
            Combo1.AddItem "对"
            Combo1.AddItem "错"
            
            Call ChangePosition
            
            Frame1.Visible = False
    End Select
    '
    Set Adodc1.Recordset = rs
    
    '
    Combo1.Text = txtTmda.Text
    If Trim(Text1(9).Text) <> "" Then
        Picture2.Picture = LoadPicture(GetAppPath() & Text1(9).Text)
        Picture2.AutoSize = True
        PaintImage PictureScaleRatio(Picture2, Picture1) * Picture1.ScaleWidth, PictureScaleRatio(Picture2, Picture1) * Picture1.ScaleHeight, Picture2, Picture1, GL_DISPLAY_CENTER
    End If
End Sub
Private Sub Text1_Change(Index As Integer)
    If miTmlb_id = 0 Then
        Select Case Index
            Case 1, 2, 3, 4, 5
                If (Text1(1).Text = "") Or (Text1(2).Text = "") Or (Text1(3).Text = "") Or (Text1(4).Text = "") Or (Text1(5).Text = "") Then
                    cmdOK.Enabled = False
                Else
                    cmdOK.Enabled = True
                End If
            Case Else
        End Select
    Else
        Select Case Index
            Case 1, 2
                If (Text1(1).Text = "") Or (Text1(2).Text = "") Then
                    cmdOK.Enabled = False
                Else
                    cmdOK.Enabled = True
                End If
            Case Else
        End Select
    End If
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then '回车键
        If miTmlx_id = 0 Then '选择题
            Select Case Index
                Case 8
                    Combo1.SetFocus
                Case Else
                    Text1(Index + 1).SetFocus
            End Select
        Else '判断题
            SendKeys "{tab}"
        End If
    End If
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then '回车键
        SendKeys "{Tab}"
    End If
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 1 Then '编号
        KeyAscii = AcceptNumber(KeyAscii)
    End If
End Sub
'如果是判断题，则调整各控件的位置
Private Sub ChangePosition()
    Dim offset As Integer
    
    offset = Frame1.Height
        
    Picture1.Top = Picture1.Top - offset
    lblTmda.Top = lblTmda.Top - offset
    Combo1.Top = Combo1.Top - offset
    lblTp.Top = lblTp.Top - offset
    Text1(9).Top = Text1(9).Top - offset
    cmdBrowse.Top = cmdBrowse.Top - offset
    cmdClear.Top = cmdClear.Top - offset
    cmdOK.Top = cmdOK.Top - offset
    cmdCancel.Top = cmdCancel.Top - offset
    
    Me.Height = Me.Height - offset
End Sub