frmhousetranout.frm

医院门诊医生工作站,vb6 SqlServer

      Width           =   936
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "调拨出库"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   0
      Left            =   3660
      TabIndex        =   8
      Top             =   75
      Width           =   1320
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "调拨出库"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000C&
      Height          =   315
      Index           =   1
      Left            =   3660
      TabIndex        =   7
      Top             =   90
      Width           =   1320
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000003&
      X1              =   30
      X2              =   9450
      Y1              =   590
      Y2              =   590
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      X1              =   48
      X2              =   9468
      Y1              =   576
      Y2              =   576
   End
   Begin VB.Label lblCMoney 
      AutoSize        =   -1  'True
      Caption         =   "lblCMoney"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   210
      Left            =   3450
      TabIndex        =   6
      Tag             =   "Dyn"
      Top             =   4485
      Width           =   945
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "零售金额:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   2385
      TabIndex        =   5
      Top             =   4485
      Width           =   945
   End
   Begin VB.Label lblGMoney 
      AutoSize        =   -1  'True
      Caption         =   "lblGMoney"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   216
      Left            =   1200
      TabIndex        =   4
      Tag             =   "Dyn"
      Top             =   4488
      Width           =   948
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "批发金额:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   216
      Left            =   120
      TabIndex        =   3
      Top             =   4488
      Width           =   948
   End
   Begin VB.Label lbl 
      AutoSize        =   -1  'True
      Caption         =   "拨出药房:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   216
      Left            =   3036
      TabIndex        =   2
      Top             =   1056
      Width           =   972
   End
End
Attribute VB_Name = "frmHouseTranOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'spd  Col 1 ---> Hide  - 药品编码
'                2 --->         药品名称
'                3 --->         规格      - Lock
'                4 --->         单位（基本）- Lock
'                5 --->         数量
'                6 --->         批发价    - - Float.4
'                7 --->         批发金额    - - Float.2
'                8 --->        零售价    - - Float.4
'                9 --->        零售金额    - - Float.2
'                10 --->        批零差价   - - Float.4

Private WithEvents CmnHlp As frmInputHelp
Attribute CmnHlp.VB_VarHelpID = -1
Public AsksObj As clsDrugItems

Public ItemsObj As clsDrugItems

Private WithEvents QueryObj As frmHouseTranOutQuery
Attribute QueryObj.VB_VarHelpID = -1
Private WithEvents AskFormObj As frmAskList
Attribute AskFormObj.VB_VarHelpID = -1

Private CurUnitObj As clsDrugUnit

Private Sub InitForm()
    Set CmnHlp = New frmInputHelp
    Set CmnHlp.CN = gDbObj.CN
    Set lct.CN = gDbObj.CN
    lct.Visible = False
    fra.Visible = False
    Init
'    hisLockInput Me, False
'    FillDataByAsk
End Sub
Private Sub Init()
    lblDepart.Tag = ""
    lblDepart = ""
    lblAsker = ""
    lblAskSheetID = ""
    hisFormClear Me
    spd.MaxRows = 0
    spd.MaxRows = 1
    If gtydSysConfig.AutoSheetID Then
        txtSheetID = gFnGetSerial(stHouseBusSerial)
        txtSheetID.Locked = True
    End If
    
End Sub
Private Sub PutSpread(ByVal Row As Integer, ByVal ItemCode, ByVal itemname, ByVal Model, _
        ByVal Unit, ByVal Amount, ByVal Gprice, ByVal CPrice, ByVal Factor)
    Dim i As Integer
    
    If CurUnitObj Is Nothing Then
        Set CurUnitObj = New clsDrugUnit
    End If
    CurUnitObj.Add ItemCode

    spd.Redraw = False
    spd.Row = Row
    spd.Col = 1
    spd.Text = ItemCode
    spd.Col = 2
    spd.Text = itemname
    spd.Col = 3
    spd.Text = Model & " * " & Int(Factor)
    spd.Col = 4
    If CurUnitObj(ItemCode).Count = 1 Then
        spd.CellType = SS_CELL_TYPE_EDIT
        spd.Text = Unit
        spd.Lock = True
    Else
        spd.CellType = SS_CELL_TYPE_COMBOBOX
        spd.Lock = False
        For i = 1 To CurUnitObj(ItemCode).Count
            spd.TypeComboBoxIndex = -1
            spd.TypeComboBoxString = CurUnitObj(ItemCode).Item(i).Unit
            If CurUnitObj(ItemCode).Item(i).Unit = Unit Then
                spd.TypeComboBoxCurSel = i - 1
            End If
        Next i
    End If
    spd.Col = 5
    spd.Text = Amount / Factor
    spd.Col = 6
    spd.Text = Gprice * Factor
    spd.Col = 7
    spd.Text = Gprice * Amount
    spd.Col = 8
    spd.Text = CPrice * Factor
    spd.Col = 9
    spd.Text = CPrice * Amount
    spd.Col = 10
    spd.Text = CPrice * Amount - Gprice * Amount
    spd.Col = 11
    spd.Text = Factor
    spd.Redraw = True
End Sub




Private Sub AskFormObj_SelectAsk(TAsksObj As clsDrugItems)
    Set AsksObj = TAsksObj
    FillDataByAsk
End Sub

Private Sub CmnHlp_ResSelect(ByVal SelData As Variant, ByVal STag As String)
    Me.SetFocus
    Select Case STag
        Case "Item"
            If TypeName(SelData) = "Nothing" Then
                If spd.ActiveRow <> spd.MaxRows Then
                    spd.Row = spd.ActiveRow
                    spd.Action = SS_ACTION_DELETE_ROW
                    spd.MaxRows = spd.MaxRows - 1
                End If
            Else
                PutSpread spd.ActiveRow, SelData(0), SelData(2), SelData(3), _
                    SelData(4), 1 * SelData(5), SelData(6), SelData(7), SelData(5)
                If spd.ActiveRow = spd.MaxRows Then
                    spd.MaxRows = spd.MaxRows + 1
                End If
            End If
            Sum

    End Select
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF1
            If mcr.Status = CL_ADD Then
                Set AskFormObj = New frmAskList
                AskFormObj.Show vbModal
            End If
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If Me.ActiveControl.Name = "spd" Then Exit Sub
        hisToActiveCtl(Me).SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub

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

Private Sub Lct_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
    FillData
End Sub


'Private Sub QueryObj_Ack(ByVal Cdt As String)
'    Dim SQL As String
'
'    SQL = "SELECT House_BusMain.BusSerial FROM House_BusMain" _
'        & " INNER JOIN House_BusSub ON House_BusMain.BusSerial = House_BusSub.BusSerial " _
'        & " WHERE DsCode = '" & gtydSysConfig.DepCode & "' AND " & Cdt & " GROUP BY House_BusMain.BusSerial"
'    lct.SQL = SQL
'    lct.Refresh
'    If lct.Count > 0 Then
'        mcr.Status = CL_UPDATE
'        FillData
'    Else
'        mcr.Status = CL_ADD
'        Init
'    End If
'
'
'End Sub



Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    Dim Obj As Object, ErrDes As String, Row As Long, Col As Long
    
    Select Case WhichB
        Case BK_ADD