query_out.frm

这是一个医院管理系统中的院长查询模块

    lsh_up.SelLength = Len(lsh_up.Text)
    lsh_up.BackColor = &HFFFFFF
End Sub

Private Sub lsh_up_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        If Trim(lsh_up) <> "" Then
            If Trim(spell_head.Text) = "" Then
                spell_head_Change
            Else
                spell_head = ""
            End If
        End If
        stuff_section.SetFocus
    End If
End Sub

Private Sub lsh_up_KeyPress(KeyAscii As Integer)
    If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If

End Sub

Private Sub lsh_up_LostFocus()
    lsh_up.BackColor = &HE0E0E0

End Sub

Private Sub money_down_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        spell_head_Change
        money_up.SetFocus
    End If
End Sub

Private Sub money_down_KeyPress(KeyAscii As Integer)
    If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If

End Sub

Private Sub money_up_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        spell_head_Change
        show_great.SetFocus
    End If

End Sub

Private Sub money_up_KeyPress(KeyAscii As Integer)
    If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If

End Sub

Private Sub print_com_Click()
  '打印模块
    Dim db As Database
    Dim dy As Recordset
    Dim mline As Integer
    Dim mnumber As Integer
    Dim mpage As Integer
    Dim mlast As Integer
    '判断数据库是否为空
    If select_data.SQL = "" Then
        MsgBox "没有数据", , "提示"
        Exit Sub
    End If
   
    
    If select_data.Resultset.EOF And select_data.Resultset.BOF Then
        MsgBox "没有数据", , "提示"
        Exit Sub
    End If
    If select_data.Resultset.RowCount = 1 Then
        MsgBox "没有数据", , "提示"
        print_com.Enabled = False
        Exit Sub
    End If
        '设置打印纸张型号,高度,宽度
    Printer.PaperSize = 39
    
    'Printer.Height = 8000
    'Printer.Width = 24000
    '计算记录数
    select_data.Resultset.MoveLast
    mnumber = select_data.Resultset.RowCount
    select_data.Resultset.MoveFirst
  '分页
    mline = 30
    mpage = mnumber \ mline
    mlast = mnumber Mod mline
    If mlast <> 0 Then
        mpage = mpage + 1
    End If
  '分页打印
    For i = 1 To mpage
      '打印名头
        Printer.FontSize = 16
        Printer.Font = "宋体"
         Printer.Print " "
        Printer.Print "                           出  (返)  库  流  水  账  "
        Printer.FontSize = 5
        Printer.Print " "
        Printer.FontSize = 9
        Printer.Print Space(50) + "(" + yuanming + ")"
       Printer.FontSize = 9.5
        Printer.Print "                                                                              第" + Left(Str(i), 4) + "页  共" + Left(Str(mpage), 4) + "页"
        Printer.Print "┌─────┬───┬───────────────┬──────────┬──┬────┬──────┬───────┬──────┬──────────┬────┬────┬─────┐"
        Printer.Print "│单  据  号│编  码│     物    品    名    称     │  规   格   型   号 │单位│ 数  量 │ 单      价 │ 合       计  │  请领科室  │  制     造     商  │经 办 人│操 作 员│ 操作日期 │"
      '打印记录
        For j = 1 To mline
            If select_data.Resultset.EOF Then
               Exit For
            End If
        Printer.Print "├─────┼───┼───────────────┼──────────┼──┼────┼──────┼───────┼──────┼──────────┼────┼────┼─────┤"
        Printer.Print "│" + printstr(NoNull(select_data.Resultset!res_work_lsh), 10, 1) + printstr(NoNull(select_data.Resultset!res_code), 6) + printstr(NoNull(select_data.Resultset!res_name), 30) + printstr(NoNull(select_data.Resultset!res_standards), 20) _
                           + printstr(NoNull(select_data.Resultset!res_unit), 4) + printstr(CStr(NoNull(select_data.Resultset!res_amount)), 8, 1) _
                            + printmoney(CStr(Val(NoNull(select_data.Resultset!res_unit_price))), 12, 1) + printmoney(CStr(select_data.Resultset!res_total), 14) + printstr(NoNull(select_data.Resultset!res_department_name), 12) _
                            + printstr(NoNull(select_data.Resultset!res_factory), 20) + printstr(NoNull(select_data.Resultset!res_keeping_man), 8) _
                            + printstr(NoNull(select_data.Resultset!res_op_name), 8) + printstr(NoNull(select_data.Resultset!res_work_date), 10)
            select_data.Resultset.MoveNext
        Next j
        Printer.Print "└─────┴───┴───────────────┴──────────┴──┴────┴──────┴───────┴──────┴──────────┴────┴────┴─────┘"
        Printer.Print "保管员: "
        If select_data.Resultset.EOF Then
           Exit For
        Else
           Printer.NewPage
        End If
    Next i
    Printer.EndDoc
    MsgBox "打印结束", , "退出"
End Sub

Private Sub quit_com_Click()
    Unload Me
End Sub

Private Sub reprint_com_Click()
    If Trim(lsh_up.Text) <> "" Then
        printerdb Trim(lsh_up.Text), mkind_code, "2"
        MsgBox "打印结束", , "提示"
    End If
End Sub

Private Sub show_great_Change()
    great_id = "%"
    If Not (show_great.Text = "") Then
        Dim db As Database
        Dim rs As Recordset
        opendb db, rs, "select * from stuff_greatkind where G_NAME like '" + show_great.Text + "'", False
        great_id = rs!G_id
        rs.Close
        db.Close
        show_little = ""
        data_little.DatabaseName = dbfname
        data_little.Connect = dbfstr
        data_little.RecordSource = "select * from stuff_littlekind WHERE G_id='" + great_id + "'"
        data_little.Refresh
        show_little.ListField = "L_NAME"
        little_id = great_id + "%"
        spell_head.Text = ""
        spell_head_Change
    Else
        opendb db, rs, "select * from stuff_greatkind where G_NAME like ' '", False
        rs.Close
        db.Close
    End If
End Sub

Private Sub show_great_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        show_little.SetFocus
    End If
End Sub

Private Sub show_little_Change()
    Dim db As Database
    Dim rs As Recordset
    If show_great <> "" And show_little <> "" Then
        opendb db, rs, "select * from stuff_littlekind where G_id='" + great_id + "'and L_NAME like '" + show_little.Text + "'", False
        little_id = rs!L_id
        rs.Close
        db.Close
    spell_head.Text = ""
    spell_head_Change
    End If

End Sub

Private Sub show_little_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        browse_com.SetFocus
    End If

End Sub

Private Sub spell_head_Change()
    Dim db As Database
    Dim rs As Recordset
    Dim this_section As String
    Dim this_option As String
    Dim this_down As String
    Dim this_buyer As String
    Dim this_up As String
    Dim spell_on As String
    Dim now_lsh1 As String
    Dim now_lsh2 As String
'''日期
    If Not IsDate(begin_date) Or begin_date.Text < "2000-01-01" Or begin_date.Text > Date Then
        MsgBox "起始日期错误", 32, "提示"
        begin_date.Text = "2000-01-01"
        begin_date.SetFocus
    End If
    If Not IsDate(end_date) Or end_date.Text < "2000-01-01" Or end_date.Text > Date Then
        MsgBox "终止日期错误", 32, "提示"
        end_date.Text = Date
        end_date.SetFocus
    End If
'''流水号
    If Trim(lsh_down.Text) = "" Then
        now_lsh1 = 0
    Else
        now_lsh1 = Val(lsh_down.Text)
    End If
    If Trim(lsh_up.Text) = "" Then
        now_lsh2 = 99999999
    Else
        now_lsh2 = Val(lsh_up.Text)
    End If
'''单价
    If Trim(money_down.Text) = "" Then
        this_down = 0
    Else
        this_down = Val(money_down.Text)
    End If
    If Trim(money_up.Text) = "" Then
        this_up = 999999999
    Else
        this_up = Val(money_up.Text)
    End If
'''拼音头
    If Trim(spell_head.Text) = "" Then
        spell_on = "1"
        this_code = "%"
    Else
        If Asc(Left(spell_head.Text, 2)) < 0 Then
            this_code = "%" + Trim(spell_head.Text) + "%"
            spell_on = "3"
        Else
            If Val(spell_head.Text) > 0 And Val(spell_head.Text) < 99999 Then
                this_code = Left(Trim(spell_head.Text), 5)
                spell_on = "1"
            Else
                this_code = "%" + Trim(spell_head.Text) + "%"
                spell_on = "2"
            End If
        End If
    End If
'''科室
    If Trim(stuff_section.Text) = "" Then
        this_section = "%"
    Else
        opendb db, rs, "select * from ks_table where ks_name='" + stuff_section.Text + "'"
        this_section = rs!ks_id
        rs.Close
        db.Close
    End If
    
 '''经办人
    If Trim(buyer.Text) = "" Then
        this_buyer = "%"
    Else
        this_buyer = Trim(buyer.Text)
    End If
    
''入出库
    this_option = 0
    If Check_in.Value Then this_option = this_option + 1
    If Check_inback.Value Then this_option = this_option + 10
    
    this_option = Format(this_option, "00")
    select_data.SQL = "stuff_query_inout '" + CStr(begin_date.Text) + "','" + CStr(CDate(CDate(end_date.Text) + 1)) + "','" + mkind_code + "','%','" + this_section + "','" + this_option + "','" + now_lsh1 + "','" + now_lsh2 + "','" + this_code + "','" + spell_on + "','2'," + CStr(this_down) + "," + CStr(this_up) + ",'" + this_buyer + "','" + great_id + "','" + little_id + "'"
    select_data.Refresh
End Sub

Private Sub spell_head_GotFocus()
    spell_head.SelStart = 0
    spell_head.SelLength = Len(spell_head.Text)
    spell_head.BackColor = &HFFFFFF

End Sub

Private Sub spell_head_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then money_down.SetFocus
End Sub

Private Sub spell_head_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc("'") Then
        KeyAscii = 0
    End If

End Sub

Private Sub spell_head_LostFocus()
    spell_head.BackColor = &HE0E0E0

End Sub

Private Sub stuff_kind_Click()
    If stuff_kind.Text = "卫生材料" Then mkind_code = "H"
    If stuff_kind.Text = "卫杂材料" Then mkind_code = "I"
    If stuff_kind.Text = "其他材料" Then mkind_code = "J"
    data_great.RecordSource = "select * from stuff_greatkind where g_kind='" + mkind_code + "' order by G_id"
    data_great.Refresh
    show_great.ListField = "G_NAME"
    show_little.Text = ""
    show_great.Text = ""
    great_id = "%"
    little_id = "%"
    stuff_section.Text = ""
    lsh_down.Text = ""
    lsh_up.Text = ""
    spell_head.Text = ""
    money_down.Text = ""
    money_up.Text = ""
    buyer.Text = ""
End Sub

Private Sub stuff_kind_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        lsh_down.SetFocus
    End If
End Sub

Private Sub stuff_section_Change()
    lsh_up = ""
    lsh_down = ""
    spell_head_Change

End Sub

Private Sub stuff_section_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        spell_head.SetFocus
    End If
End Sub
Private Sub lsh_down_GotFocus()
    lsh_down.SelStart = 0
    lsh_down.SelLength = Len(lsh_down.Text)
    lsh_down.BackColor = &HFFFFFF
End Sub

Private Sub lsh_down_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        If Trim(lsh_down) <> "" Then
            If Trim(spell_head.Text) = "" Then
                spell_head_Change
            Else
                spell_head = ""
            End If
        End If
        lsh_up.SetFocus
    End If
End Sub

Private Sub lsh_down_KeyPress(KeyAscii As Integer)
    If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Private Sub lsh_down_LostFocus()
    lsh_down.BackColor = &HE0E0E0

End Sub

Private Sub UpDown_begin_DownClick()
    If IsDate(begin_date) Then
        begin_date.Text = CStr(CDate(begin_date.Text) - 1)
        If begin_date.Text < "2000-01-01" Then begin_date = "2000-01-01"
        If begin_date.Text > Date Then begin_date = Date
        spell_head_Change
    End If
End Sub
Private Sub UpDown_begin_UpClick()
    If IsDate(begin_date) Then
        begin_date.Text = CStr(CDate(begin_date.Text) + 1)
        If begin_date.Text < "2000-01-01" Then begin_date = "2000-01-01"
        If begin_date.Text > Date Then begin_date = Date
        spell_head_Change
    End If
End Sub
Private Sub UpDown_end_DownClick()
    If IsDate(end_date) Then
        end_date.Text = CStr(CDate(end_date.Text) - 1)
        If end_date.Text < "2000-01-01" Then end_date = "2000-01-01"
        If end_date.Text > Date Then end_date = Date
        spell_head_Change
    End If
End Sub
Private Sub UpDown_end_UpClick()
    If IsDate(end_date) Then
        end_date.Text = CStr(CDate(end_date.Text) + 1)
        If end_date.Text < "2000-01-01" Then end_date = "2000-01-01"
        If end_date.Text > Date Then end_date = Date
        spell_head_Change
    End If
End Sub