公司快递管理.frm

从网上搜集的快递管理软件VB源码,还未仔细研究.

IMG_CMD1(Index).BorderStyle = 0
End Sub

Private Sub img_cmd1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
IMG_CMD1(1).Move IMG_CMD1(0).Left, IMG_CMD1(0).Top
End Sub



Private Sub IMG_CMD2_Click(Index As Integer)
'更新操作完成

    If Check1(0).Value = 1 Then
        lx = "货样"
    Else
        lx = "物品"
    End If

    If Check2(0).Value = 1 Then
        fkfs = "现款"
    Else
        fkfs = "月结"
    End If

sqltext = "update 待打印表 set 速递单ID='" & TXT(0) & "',类型='" & lx & "',数量='" & TXT(1) & "',重量='" & TXT(2)
sqltext = sqltext + "',付款方式='" & fkfs & "',备注='" & TXT(3) & "' where 速递单ID='" & id & "'"

Set rs = ExecuteSQL(sqltext, MsgString)

sqltext = "update 快递表 set 速递单ID='" & TXT(0) & "',类型='" & lx & "',数量='" & TXT(1) & "',重量='" & TXT(2)
sqltext = sqltext + "',付款方式='" & fkfs & "',备注='" & TXT(3) & "' where 速递单ID='" & id & "'"

Debug.Print sqltext

Set rs = ExecuteSQL(sqltext, MsgString)


Call ClearMessage
Call ShowTreeView

    For i = 0 To 3
        TXT(i).locked = True
    Next i

IMG_CMD1(0).Visible = True
IMG_CMD1(2).Move IMG_CMD1(0).Left, IMG_CMD1(0).Top
IMG_CMD2(0).Visible = False
IMG_CMD2(1).Move -2000, -2000
End Sub

Private Sub img_cmd2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0, 1
IMG_CMD2(Index).BorderStyle = 1
End Select
End Sub

Private Sub img_cmd2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
IMG_CMD2(Index).BorderStyle = 0
End Sub

Private Sub img_cmd2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
IMG_CMD2(1).Move IMG_CMD2(0).Left, IMG_CMD2(0).Top
End Sub






Private Sub CMD_IMG3_Click(Index As Integer)
Call menu_order_add_Click
End Sub

Private Sub CMD_IMG4_Click(Index As Integer)
Unload Me
End Sub

Private Sub Cmd_IMG4_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG4(1).Move CMD_IMG4(0).Left, CMD_IMG4(0).Top
End Sub
Private Sub CMD_IMG4_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0, 1
CMD_IMG4(Index).BorderStyle = 1
End Select
End Sub
Private Sub CMD_IMG4_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG4(Index).BorderStyle = 0
End Sub

Private Sub Form_Load()
flag = "normal"

menu_order_modify.Enabled = False
menu_order_del.Enabled = False

Call TXTState(flag)

Call ShowTreeView


IMG_CMD1(2).Move IMG_CMD1(0).Left, IMG_CMD1(0).Top

IMG_CMD2(0).Visible = False

DTPicker1.Value = Format(Now() - 1, "yyyy-mm-dd")

Call Showlist(DTPicker1.Value)

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG1(1).Move -2000, -2000
CMD_IMG2(1).Move -2000, -2000
CMD_IMG4(1).Move -2000, -2000
CMD_IMG3(1).Move -2000, -2000
CMD_IMG5(1).Move -2000, -2000
CMD_IMG6(1).Move -2000, -2000
CMD_IMG7(1).Move -2000, -2000
End Sub

Private Sub TXTState(ByVal flag As String)
If flag = "normal" Then
    For i = 0 To 4
        TXT(i).locked = True
    Next
End If

End Sub



Private Sub Label2_Click(Index As Integer)
If flag = "modify" Then
Select Case Index
    Case 0
        Check1(0).Value = 1
        Check1(1).Value = 0
    Case 1
        Check1(0).Value = 0
        Check1(1).Value = 1
End Select
End If
End Sub
Private Sub Label3_Click(Index As Integer)
If flag = "modify" Then
Select Case Index
    Case 0
        Check2(0).Value = 1
        Check2(1).Value = 0
    Case 1
        Check2(0).Value = 0
        Check2(1).Value = 1
End Select
End If
End Sub

Private Sub List1_Click()
Call ShowMessage(Left(List1.Text, 10))


End Sub

Private Sub menu_exit_Click()
Unload Me
End Sub

Private Sub menu_order_add_Click()
xjkdd.Show 1
End Sub

Private Sub menu_order_del_Click()
'删除快递单操作
If TXT(0) = "" Then
Exit Sub
End If
ret = MsgBox("是否删除快递单" & vbCrLf & Current_node.Text, vbInformation + vbYesNo, "提示")
If ret = vbYes Then
    sqltext = "delete from 待打印表 where 速递单ID='" & Left(Current_node.Text, 10) & "'"
    Set rs = ExecuteSQL(sqltext, MsgString)
    sqltext = "delete from 快递表 where 速递单ID='" & Left(Current_node.Text, 10) & "'"
    Set rs = ExecuteSQL(sqltext, MsgString)
    Call ClearMessage
    Call ShowTreeView
    
Else
    Exit Sub
End If
End Sub

Private Sub menu_order_modify_Click()

flag = "modify"
For i = 0 To 3
    TXT(i).locked = False
Next

IMG_CMD2(0).Visible = True
IMG_CMD1(0).Visible = False
IMG_CMD2(0).Move IMG_CMD1(0).Left, IMG_CMD1(0).Top
    
id = Left(Current_node.Text, 10)

End Sub

Private Sub menu_set_company_Click()
qyjbzl.Show 1
End Sub

Private Sub menu_set_custom_Click()
khjbzl.Show 1
End Sub
Private Sub Cmd_IMG3_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG3(1).Move CMD_IMG3(0).Left, CMD_IMG3(0).Top
End Sub
Private Sub Cmd_IMG5_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG5(1).Move CMD_IMG5(0).Left, CMD_IMG5(0).Top
End Sub
Private Sub Cmd_IMG6_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG6(1).Move CMD_IMG6(0).Left, CMD_IMG6(0).Top
End Sub
Private Sub Cmd_IMG7_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG7(1).Move CMD_IMG7(0).Left, CMD_IMG7(0).Top
End Sub

Private Sub Cmd_IMG2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG2(1).Move CMD_IMG2(0).Left, CMD_IMG2(0).Top
End Sub

Private Sub Cmd_IMG1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG1(1).Move CMD_IMG1(0).Left, CMD_IMG1(0).Top
End Sub

Private Sub CMD_IMG1_Click(Index As Integer)
Select Case Index
Case 0, 1
    Call menu_set_company_Click
End Select
End Sub

Private Sub CMD_IMG2_Click(Index As Integer)
Select Case Index
Case 0, 1
    Call menu_set_custom_Click
End Select
End Sub

Private Sub CMD_IMG1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0, 1
CMD_IMG1(Index).BorderStyle = 1
End Select
End Sub

Private Sub CMD_IMG1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG1(Index).BorderStyle = 0
End Sub

Private Sub CMD_IMG2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0, 1
CMD_IMG2(Index).BorderStyle = 1
End Select
End Sub
Private Sub CMD_IMG2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG2(Index).BorderStyle = 0
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
CMD_IMG1(1).Move -2000, -2000
CMD_IMG2(1).Move -2000, -2000
CMD_IMG4(1).Move -2000, -2000
CMD_IMG3(1).Move -2000, -2000
CMD_IMG5(1).Move -2000, -2000
CMD_IMG6(1).Move -2000, -2000
CMD_IMG7(1).Move -2000, -2000
End Sub

Public Sub ShowTreeView()
On Error Resume Next
'清除内容
TreeView1.Nodes.Clear

'生成主结点1
Set Nd = TreeView1.Nodes.Add(, , "root1", "未打印快递单")
sqltext = "select 速递单ID,客户单位名称 from 待打印表"


Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then

    Do
        Set Nd = TreeView1.Nodes.Add("root1", tvwChild, "a" & rs(0), rs(0) + Space(1) + rs(1))
        rs.MoveNext
        If rs.EOF Then
            Exit Do
        End If
    Loop Until rs.EOF
End If
TreeView1.Nodes(TreeView1.Nodes.Count).EnsureVisible

'生成主结点2
Set Nd = TreeView1.Nodes.Add(, , "root2", "已打印快递单")

sqltext = "select 速递单ID,客户单位名称 from 打印表完成表"

Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
    Do
        Set Nd = TreeView1.Nodes.Add("root2", tvwChild, "a" & rs(0), rs(0) + Space(1) + rs(1))
        rs.MoveNext
        If rs.EOF Then
            Exit Do
        End If
    Loop Until rs.EOF
End If
TreeView1.Nodes(TreeView1.Nodes.Count).EnsureVisible
End Sub
Private Sub ClearMessage()
'清除已有数据
    For i = 0 To 14
        TXT(i) = ""
    Next
    
    For i = 0 To 1
        Check1(i) = 0
        Check2(i) = 0
    Next
    menu_order_del.Enabled = False
    menu_order_modify.Enabled = False
    
End Sub


Private Sub ShowMessage(ByVal id As String)
On Error Resume Next
sqltext = "select * from 待打印表 where 速递单id='" & id & "'"
Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
        Call ClearMessage
        TXT(0) = rs(0)
        If Trim(rs(1)) = "货样" Then
            Check1(0).Value = 1
        Else
            Check1(1).Value = 1
        End If
        TXT(1) = rs(2)
        TXT(2) = rs(3)
        If Trim(rs(4)) = "月结" Then
            Check2(1).Value = 1
        Else
            Check2(0).Value = 1
        End If
        TXT(3) = rs(5)
        TXT(4) = rs(6)
        TXT(6) = rs(7)
        TXT(7) = rs(8)
        TXT(5) = rs(9)
        TXT(8) = rs(10)
        TXT(9) = rs(11)
        TXT(10) = rs(12)
        TXT(11) = rs(13)
        TXT(12) = rs(14)
        TXT(13) = rs(15)
        TXT(14) = rs(16)
        IMG_CMD1(2).Move -2000, -2000
        menu_order_del.Enabled = True
        menu_order_modify.Enabled = True

Else
        sqltext = "select * from 打印表完成表 where 速递单id='" & id & "'"
        Set rs = ExecuteSQL(sqltext, MsgString)
        Call ClearMessage
        TXT(0) = rs(0)
        If Trim(rs(1)) = "货样" Then
            Check1(0).Value = 1
        Else
            Check1(1).Value = 1
        End If
        TXT(1) = rs(2)
        TXT(2) = rs(3)
        If Trim(rs(4)) = "月结" Then
            Check2(1).Value = 1
        Else
            Check2(0).Value = 1
        End If
        TXT(3) = rs(5)
        TXT(4) = rs(6)
        TXT(7) = rs(7)
        TXT(6) = rs(8)
        TXT(5) = rs(9)
        TXT(8) = rs(10)
        TXT(9) = rs(11)
        TXT(10) = rs(12)
        TXT(11) = rs(13)
        TXT(12) = rs(14)
        TXT(13) = rs(15)
        TXT(14) = rs(16)
        IMG_CMD1(2).Move IMG_CMD1(0).Left, IMG_CMD1(0).Top
        menu_order_del.Enabled = False
        menu_order_modify.Enabled = False

End If

End Sub
Private Sub Showlist(ByVal dt As Date)
On Error Resume Next
Dim rs1 As ADODB.Recordset

List1.Clear
dt = Format(DTPicker1.Value, "yyyy-mm-dd")

sqltext = "select 速递单ID,客户ID from 快递表 where 日期 between #" & dt & "# and #" & Format(dt + 1, "yyyy-mm-dd") & "#"

Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.BOF And rs.BOF) Then
    Do
        sqltext = "select 单位名称 from 客户资料 where 客户ID='" & rs(1) & "'"
        Set rs1 = ExecuteSQL(sqltext, MsgString)
        List1.AddItem rs(0) + Space(3) + rs1(0)
        rs.MoveNext
        If rs.EOF Then
            Exit Do
        End If
    Loop Until rs.EOF
End If

End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
IMG_CMD1(1).Move -2000, -2000
IMG_CMD2(1).Move -2000, -2000

End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
If Node.Key <> "root1" And Node.Key <> "root2" Then
    Set Current_node = Node
    
    id = Left(Node.Text, 10)
    Call ShowMessage(id)
End If
End Sub

Private Sub TXT_GotFocus(Index As Integer)
If flag = "modify" Then
Select Case Index
    Case 0, 1, 2, 3
        TXT(Index).SelStart = 0
        TXT(Index).SelLength = Len(TXT(Index))
        TXT(Index).SetFocus
End Select
End If
End Sub