mfrm_select.frm

套打程序

VERSION 5.00
Begin VB.Form mFrm_Select 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "选择单据："
   ClientHeight    =   1515
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4590
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1515
   ScaleWidth      =   4590
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton CmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   375
      Left            =   2910
      TabIndex        =   5
      Top             =   990
      Width           =   1275
   End
   Begin VB.CommandButton CmdOk 
      Caption         =   "确定(&O)"
      Height          =   375
      Left            =   1410
      TabIndex        =   4
      Top             =   990
      Width           =   1275
   End
   Begin VB.ComboBox CmbName 
      Height          =   300
      Left            =   1290
      TabIndex        =   3
      Top             =   540
      Width           =   3105
   End
   Begin VB.ComboBox CmbType 
      Height          =   300
      Left            =   1290
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   120
      Width           =   3105
   End
   Begin VB.Image ImgDelete 
      Height          =   375
      Left            =   570
      Picture         =   "mFrm_Select.frx":0000
      Stretch         =   -1  'True
      ToolTipText     =   "删除些单据"
      Top             =   1005
      Width           =   495
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单据名称(&N)："
      Height          =   180
      Left            =   90
      TabIndex        =   2
      Top             =   570
      Width           =   1170
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单据类别(&T)："
      Height          =   180
      Left            =   90
      TabIndex        =   0
      Top             =   180
      Width           =   1170
   End
End
Attribute VB_Name = "mFrm_Select"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public mScreenID As Integer
Public mID As Integer
Public mName As String

Dim mFlagNew As Boolean

Private Sub CmbType_Click()
    With CmbType
        CmbName.Clear
        If .ListIndex >= 0 Then
            mScreenID = .ItemData(.ListIndex)
        End If
    End With
End Sub

Private Sub CmdCancel_Click()
    mID = -1
    Me.Hide
End Sub

Private Sub CmdOK_Click()
    With CmbName
        If mFlagNew Then
            CmbName.Text = Trim(CmbName.Text)
            If CmbName.Text = "" Then
                MsgBox "请输入单据名称！", vbExclamation, Me.Caption
                CmbName.SetFocus
                Exit Sub
            End If
            mID = 0
            mName = .Text
        Else
            If CmbName.ListIndex = -1 Then
                MsgBox "请选择单据名称！", vbExclamation, Me.Caption
                CmbName.SetFocus
                Exit Sub
            Else
                mID = .ItemData(.ListIndex)
                mName = CmbName.Text
            End If
        End If
    End With
    Me.Hide
End Sub

Public Sub SetFlag(Optional tmpNew As Boolean = True, Optional mOldType As Integer = -1, Optional bOldName As String = "")
    mFlagNew = tmpNew: CmbName.Text = ""
    CmbType.AddItem "演示数据", 0
    If CmbType.ListCount > 0 Then CmbType.ListIndex = 0
    Call CmbType_Click
    Me.Caption = "选择单据：" & " - " & IIf(tmpNew, IIf(mOldType > 0, "另存为", "新建"), "打开")
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If ImgDelete.Visible Then ImgDelete.BorderStyle = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mFrm_Select = Nothing
End Sub

Private Sub ImgDelete_Click()
Dim tmpID As Integer, strsql As String
    On Error GoTo error
    With CmbName
        If .ListIndex = -1 Then
            MsgBox "请选择单据名称！", vbExclamation, Me.Caption
            .SetFocus
            Exit Sub
        End If
        tmpID = .ItemData(.ListIndex)
    End With
    strsql = "Delete From " & g_TableText & " Where FID=" & tmpID & vbCrLf & _
            "Delete From " & g_TableLine & " Where FID=" & tmpID & vbCrLf & _
            "Delete From " & g_Table & " Where FID=" & tmpID
    Call CmbType_Click
    MsgBox "删除成功！"
    Exit Sub

error:
    ErrInfo "删除失败！"
End Sub

Private Sub ImgDelete_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If ImgDelete.Visible Then ImgDelete.BorderStyle = 1
End Sub