mdiform1.frm

煤炭销售管理系统.完成煤炭销售的日常管理工作,和重车计量系统空车计量系统配合使用.

   End
   Begin VB.Menu hlp 
      Caption         =   "帮助"
      Begin VB.Menu about 
         Caption         =   "关于"
      End
      Begin VB.Menu neirong 
         Caption         =   "内容"
      End
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
Private Enum ObjectType
    otNone = 0
    otFactory = 1
    otGroup = 2
    otPerson = 3
    otFactory2 = 4
    otGroup2 = 5
    otPerson2 = 6
End Enum
 Dim sglPos As Single
   
Private SourceNode As Object
Private SourceType As ObjectType
Private TargetNode As Object
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
  Dim Data As ADODB.Connection
  Dim rest As ADODB.Recordset
  Dim rest1 As ADODB.Recordset
Dim mbMoving As Boolean
Const sglSplitLimit = 500



Private Sub about_Click()
'frmAbout.Show:
Dim i   ' Declare variable.
   ' 重新填充列表(当添加或删除一个实例时)。
  ' lstForms.Clear   ' Clear list box.
   For i = 0 To Forms.Count - 1
      'debug.Print Forms(i).Name, i
   Next i

End Sub
Private Sub CurtButton9_Click()
 rtjb.Show:
End Sub

Private Sub Command1_Click()
Set Data = New ADODB.Connection
    Data.ConnectionString = connetstr
    Data.Open
    Set rest = New ADODB.Recordset
      
    rest.Open "select DISTINCT  fhdw from htk where fhdw like '%" & Text1.Text & "%'", Data, adOpenStatic
    
    Call khss
    
    rest.Close
End Sub

Private Sub cpfx_Click()
qx.Show
End Sub

'CODE Manger By BcodeXRose
'##################################################################
'## 过程名称：f_cal_Click
'## 参数： 无
'##################################################################
Private Sub f_cal_Click()
Dim dd
dd = Shell("calc.exe", vbMaximizedFocus)
End Sub
    
'##################################################################
'## 过程名称：f_dhd_Click
'## 参数： 无
'##################################################################
Private Sub f_dhd_Click()
    frmdhdd.Show:
End Sub
    
'##################################################################
'## 过程名称：f_fhrm_Click
'## 参数： 无
'##################################################################
Private Sub f_fhrm_Click()
    frmfhr1.Show:
End Sub
    
    
'##################################################################
'## 过程名称：f_fyd_Click
'## 参数： 无
'##################################################################
Private Sub f_fyd_Click()
    FYGL.Show
    
End Sub
    
'##################################################################
'## 过程名称：f_fyddz_Click
'## 参数： 无
'##################################################################
Private Sub f_fyddz_Click()
    On Error Resume Next
    Form3.Show
   
End Sub
    
'##################################################################
'## 过程名称：f_htqc_Click
'## 参数： 无
'##################################################################
Private Sub f_htqc_Click()
    frmhtk.Show:
End Sub
    
'##################################################################
'## 过程名称：f_hwm_Click
'## 参数： 无
'##################################################################
Private Sub f_hwm_Click()
    frmhwm1.Show:
End Sub
    
'##################################################################
'## 过程名称：f_jsq_Click
'## 参数： 无
'##################################################################
Private Sub f_jsq_Click()
    zxsp.Show
End Sub
    
'##################################################################
'## 过程名称：f_pz_Click
'## 参数： 无
'##################################################################
Private Sub f_pz_Click()
   'cxsyk.Show:
End Sub
    
'##################################################################
'## 过程名称：f_qym_Click
'## 参数： 无
'##################################################################
Private Sub f_qym_Click()
    frmqyxx.Show:
End Sub
    
'##################################################################
'## 过程名称：f_rb_Click
'## 参数： 无
'##################################################################
Private Sub f_rb_Click()
    rtjb.Show:
End Sub
    
'##################################################################
'## 过程名称：f_yb_Click
'## 参数： 无
'##################################################################
Private Sub f_yb_Click()
    tjb.Show:
End Sub
    
'##################################################################
'## 过程名称：f_yhgl_Click
'## 参数： 无
'##################################################################
Private Sub f_yhgl_Click()
 kehu.Show
 'yhgl.Show:
End Sub
    
'##################################################################
'## 过程名称：f_zclu_Click
'## 参数： 无
'##################################################################
Private Sub f_zclu_Click()
frmcx.Show
End Sub
    
Private Sub htdl_Click()
FYGL.Show
End Sub

Private Sub Image1_Click()
Me.Picture1.Visible = False
End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With imgSplitter
       ' Me.Picture1.Width.Move .Left + 50, .Top, .Width \ 2, .Height - 20
    End With
    'picSplitter.Visible = True
    mbMoving = True
End Sub

'##################################################################
'## 过程名称：j_qcd_Click
'## 参数： 无
'##################################################################
Private Sub j_qcd_Click()
    'yuqcd.Show::
    Me.Picture1.Visible = True
End Sub
    
Private Sub jl_htdj_Click()
htdj.Show
End Sub

Private Sub jl_htjd_Click()
MsgBox "测试版，未加该功能"
End Sub

Private Sub jl_tzgl_Click()
gltz.Show
End Sub

Private Sub jl_wltz_Click()
Form1.Show
End Sub

Private Sub lishcp_Click()

End Sub

'##################################################################
'## 过程名称：MDIForm_Load
'## 参数： 无
'##################################################################
Private Sub MDIForm_Load()
    On Error Resume Next
   ' Adodc1.Refresh
   ' jl_qym = Adodc1.Recordset.Fields(0)
    'jl_zg = Adodc1.Recordset.Fields(1)
      Me.Left = GetSetting(App.TITLE, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.TITLE, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.TITLE, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.TITLE, "Settings", "MainHeight", 6500)
    Set Data = New ADODB.Connection
    Data.ConnectionString = connetstr
    Data.Open
    Set rest = New ADODB.Recordset
     rest.Open "select DISTINCT  fhdw from htk where yjs is  null and fhdw>''", Data, adOpenStatic
    
    Call khss
    
    rest.Close

End Sub
    Private Sub khss()
        On Error Resume Next
  Dim jj As Integer
    Dim recc As Integer
     Dim recc1 As Integer
  Set rest1 = New ADODB.Recordset
    Dim ii As Integer
    Dim i As Integer
    Dim factory As Node
    Dim group1 As Node
    Dim person1 As Node
    Dim img As Integer
    recc = rest.RecordCount
    Me.tvTreeView.Nodes.Clear
      Set factory = Me.tvTreeView.Nodes.add(, , "发货单位", "发货单位", otFactory, 1)
  
    For ii = 1 To recc
     
      Set group1 = Me.tvTreeView.Nodes.add(factory, tvwChild, , rest.Fields(0), otGroup, 1)
        group1.EnsureVisible
         rest1.Open "select DISTINCT  hth from htk where  fhdw='" & group1 & "' and wfl >0", Data, adOpenStatic
           recc1 = rest1.RecordCount
        'If recc1 >= 1 Then
          For jj = 1 To recc1
         Set person1 = Me.tvTreeView.Nodes.add(group1, tvwChild, , rest1.Fields(0).Value, 3, 4)
          rest1.MoveNext
            'person1.EnsureVisible
         Next jj
        ' End If
          rest1.Close
    rest.MoveNext
'  person.EnsureVisible

    Next ii
       End Sub
'##################################################################
'## 过程名称：MDIForm_Resize
'## 参数： 无
'##################################################################
Private Sub MDIForm_Resize()
    On Error Resume Next
   ' Picture1.Height = Me.Height
    'Image2.Width = Me.Picture1.Width - 2 * Image2.Left
    
   ' Label1.Left = (Me.Picture1.Width - Label1.Width) / 2
    
    Me.imgSplitter.Height = Me.Picture1.Height
End Sub
    
'##################################################################
'## 过程名称：MDIForm_Unload
'## 参数：Cancel 为Integer型
'##################################################################
Private Sub MDIForm_Unload(Cancel As Integer)
    End
End Sub
    
'##################################################################
'## 过程名称：qbqk_Click
'## 参数： 无
'##################################################################

    
Private Sub openjs_Click()
zxsp.Show
End Sub

'##################################################################
'## 过程名称：quit_Click
'## 参数： 无
'##################################################################
Private Sub quit_Click()
    End
End Sub
    
'##################################################################
'## 过程名称：xsqk_Click
'## 参数： 无
'##################################################################
Private Sub xsqk_Click()
    
End Sub

Private Sub shycp_Click()
cxsyk.Show
End Sub

Private Sub tchgl_Click()
clgl.Show
End Sub

Private Sub tvTreeView_DblClick()
'On Error Resume Next
Me.lblTitle(2).Caption = tvTreeView.SelectedItem.FullPath
Dim fff As Integer
Dim frm As flxs
  Dim forfrm As Form2
fff = Me.tvTreeView.SelectedItem.Children
'Me.tvTreeView.SelectedItem.Previous
Select Case fff
  Case 0
  
''  If frm.hwnd > 0 Then
 ' Unload frm
 ' End If
  
  Set forfrm = New Form2
      jl_hth = Me.tvTreeView.SelectedItem.Text
      forfrm.Adodc1.ConnectionString = connetstr
      
   forfrm.Adodc1.RecordSource = "select * from htk where hth='" & Trim(jl_hth) & "'"
   forfrm.Adodc1.refresh
     forfrm.Label1.Caption = jl_fhdw & jl_hth & "合同执行情况"
   
   forfrm.Show
  Call KeepOnTop(forfrm)

   'MsgBox forfrm.hDC
   Case Is >= 1
        Set frm = New flxs
    jl_fhdw = Me.tvTreeView.SelectedItem.Text
     frm.Label1.Caption = jl_fhdw & "合同执行情况"
     
      Me.Text1.Text = jl_fhdw
    frm.Caption = jl_fhdw & "合同执行情况"
     frm.Show
      Call KeepOnTop(frm)

  End Select

End Sub

Private Sub txsfx_Click()
xsfx.Show
End Sub

Private Sub xtcx_Click()
frmhtk.Show
End Sub
Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
   '

    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            imgSplitter.Left = sglSplitLimit
            Me.Picture1.Width = X - imgSplitter.Left
            Me.lblTitle(2).Width = X
            Me.tvTreeView.Width = X
            
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            Me.Picture1.Width = Me.Width - sglSplitLimit
            Me.lblTitle(2).Width = X
            Me.tvTreeView.Width = X
            
        Else
            Me.Picture1.Width = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'SizeControls picSplitter.Left
    imgSplitter.Left = Me.Picture1.Width - imgSplitter.Width
    Me.lblTitle(2).Width = Me.Picture1.Width - imgSplitter.Width
            Me.tvTreeView.Width = Me.Picture1.Width - imgSplitter.Width
            
   ' picSplitter.Visible = False
    mbMoving = False
End Sub

Private Sub yhgll_Click()
yhgl.Show
End Sub