frmsum.frm

雨点进销存软件,绝对可以用,大家可以拿来使用

         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":002F
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":014F
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":05A3
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":09F7
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":0E4B
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":0F6B
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":108B
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":11AB
            Key             =   ""
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmSum.frx":12BF
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "FrmSum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CbxDefine_Change()
TxtDefine.SetFocus
End Sub

Private Sub CbxTypeCode_Change()
On Error GoTo Err
Dim Type_No As String
Me.MousePointer = 11

Select Case CbxTypeCode.Text
   Case "入库情况"
     Type_No = 1
     Table_Name = "product_in"
'     Call AddViewField(Type_No)
     Call AddQueryField(Type_No)
   Case "出库情况"
     Type_No = 2
     Table_Name = "product_out"
'     Call AddViewField(Type_No)
     Call AddQueryField(Type_No)
   Case "库存情况"
     Type_No = 3
     Table_Name = "product_stock"
'     Call AddViewField(Type_No)
     Call AddQueryField(Type_No)
End Select
Err:
Me.MousePointer = 0
End Sub
'在CbxDefine里添加字段
Private Function AddQueryField(Field_Type As String) As Boolean
On Error GoTo Err
Dim rd As Recordset
Dim sql As String
Dim i As String
Dim n As String

CbxDefine.Clear

sql = "select * from field_name where  field_name_type='" + Field_Type + "'"
 Set rd = gDbFish.OpenRecordset(sql)
 
 i = 1
 '1维字段名，2维字段类型，3维数据字典，重定义数组
' ReDim gQueryField(1 To n, 1 To 3) As String
  Set rd = gDbFish.OpenRecordset(sql)
 While Not rd.EOF
  CbxDefine.AddItem Trim(rd.Fields("field_name_ch"))
  
'  gQueryField(i, 1) = Trim(rd.Fields("field_name_en"))
'  gQueryField(i, 2) = ConvertNull(rd.Fields("data_type"))
'  gQueryField(i, 3) = ConvertNull(rd.Fields("system_dict_type"))
  rd.MoveNext
  i = i + 1
 Wend
 
 
'SBar.Panels(2).Text = "当前记录数:" + ConvertNull(i)
 
If CbxDefine.ListCount > 0 Then CbxDefine.ListIndex = 0
AddQueryField = True
Exit Function
Err:
   AddQueryField = False
End Function

Private Sub CbxTypeCode_Click()
Call CbxTypeCode_Change
End Sub

Private Sub CmdOk_Click()
On Error GoTo Err
Dim rd As Recordset
Dim sql As String
Dim i As String
Dim j As String

If OptionFactory.Value = True Then
  sql = "select * from " + Table_Name + " where pd_factory='" + Trim(CbxFactory.Text) + "'"
  
  Set rd = gDbFish.OpenRecordset(sql)
i = 1
With MSFGrid

    MSFGrid.TextMatrix(0, 0) = "编 ``号"
    While Not rd.EOF
      
      MSFGrid.TextMatrix(i, 0) = Trim(rd.Fields("pd_name"))
      i = i + 1
      .Row = i + 1
      rd.MoveNext
    
    Wend
End With
End If





Err:
End Sub

Private Sub Form_Load()
On Error GoTo Err
If CbxTypeCode.ListCount > 1 Then CbxTypeCode.ListIndex = 0
Err:
End Sub
Private Sub AddPD_TypeView()
Dim rd As Recordset

CbxPD_Type.Clear
Set rd = gDbFish.OpenRecordset("select * from product_kind")

While Not rd.EOF
  CbxPD_Type.AddItem Trim(rd.Fields("pd_kind_name"))
  rd.MoveNext
Wend
If CbxPD_Type.ListCount > 1 Then CbxPD_Type.ListIndex = 0

End Sub

Private Sub AddFieldView()
Dim rd As Recordset

CbxFactory.Clear
Set rd = gDbFish.OpenRecordset("select * from factory_info")

While Not rd.EOF
  CbxFactory.AddItem Trim(rd.Fields("fct_name"))
  rd.MoveNext
Wend
If CbxFactory.ListCount > 1 Then CbxFactory.ListIndex = 0

End Sub
Private Sub AddFactoryView()
Dim rd As Recordset

CbxFactory.Clear
Set rd = gDbFish.OpenRecordset("select * from factory_info")

While Not rd.EOF
  CbxFactory.AddItem Trim(rd.Fields("fct_name"))
  rd.MoveNext
Wend
If CbxFactory.ListCount > 1 Then CbxFactory.ListIndex = 0

End Sub
Private Sub Form_Resize()
On Error GoTo Err
If Me.WindowState = 1 Then Exit Sub
If Me.Width < 8000 Then Me.Width = 8000
If Me.Height < 5000 Then Me.Height = 5000
If gWidthRate = 0 Then gWidthRate = 0.2 '水平控件比例
If gHeightRate = 0 Then gHeightRate = 0.6 '垂直控件比例
PicMain.Move 0, TBar.Height, Me.Width, Me.Height

Err:
End Sub

Private Sub Picture2_Click()

End Sub



Private Sub OptionDate_Click()
If OptionDate.Value = True Then
MaskRQ.Visible = True
MaskRQ.SetFocus
End If
End Sub

Private Sub OptionDefine_Click()
If OptionDefine.Value = True Then
CbxDefine.Visible = True
TxtDefine.Visible = True
Call AddFieldView
CbxDefine.SetFocus
End If

End Sub

Private Sub OptionFactory_Click()

'Dim tablename As String
'Dim fieldname As String
'Dim cbxname As String
If OptionFactory.Value = True Then
CbxFactory.Visible = True
'tablename = "factory_info"
'fieldname = "fct_name"
'cbxname = CbxFactory
Call AddFactoryView
CbxFactory.SetFocus

End If
End Sub

Private Sub OptionPD_Type_Click()
On Error GoTo Err
If OptionPD_Type.Value = True Then
 CbxPD_Type.Visible = True
 Call AddPD_TypeView
 CbxPD_Type.SetFocus
End If



Err:
End Sub

Private Sub PicMain_Resize()
PicSel.Move 50, 50, PicMain.Width - 100, PicMain.Height * 0.2
Label2.Move 50, PicSel.Height + 50
PicList.Move 50, PicSel.Height + Label2.Height + 2 * 50, PicMain.Width - 2 * 50, PicMain.Height * 0.5
MSFGrid.Move 0, 0, PicList.Width, PicList.Height
Label3.Move 50, PicSel.Height + PicList.Height + Label2.Height + 3 * 50
PicResult.Move 50, PicSel.Height + PicList.Height + Label3.Height + Label2.Height + 4 * 50, PicMain.Width, PicMain.Height * 0.28

End Sub

Private Sub PicSel_Resize()
Label1.Move 100, 100
CbxTypeCode.Move 100, Label1.Height + 100
CmdOk.Move 100, Label1.Height + CbxTypeCode.Height + 300
CmdPrint.Move CmdOk.Left + CmdOk.Width + 200, Label1.Height + CbxTypeCode.Height + 300
FrameSet.Move CmdOk.Left + CmdOk.Width + CmdPrint.Width + 800, 50, PicSel.Width
End Sub