module1.bas

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

Attribute VB_Name = "Module1"
Option Explicit
Public jl_qym As String
 Public jl_hth As String
 Public jl_hwm As String
 Public jl_qyr As String
 Public jl_shdw As String
 Public jl_ch
 Public jl_fhr As String
 Public jl_shr As String
 Public jl_sby As String
 Public jl_jby As String
 Public jl_zg As String
 Public jl_sj As String
 Public jl_dhdd As String
Public jl_bz As Variant
Public jl_mz As Long
Public jl_pz As Long
Public jl_pz1 As Long
Public jl_jz As Long
Public jl_htl As Long
Public jl_yfsl As Long
Public jl_wfsl As Long
Public jl_lsh As Long
Public jl_dj As Long
Public jl_je As Double
Public jl_jcje As Double
Public jl_no
Public jl_zgdw As String
Public jl_fhdw As String
Public pr_p, jl_ye, mou As Boolean
Public frmm As Form
Public obj As DataGrid
Public dsnn As String 'dsn name
Public uidd As String 'uid
Public pwdd  As String 'password
'***************************************************
Public connetstr As String '数据库连接字符串
'***************************************************
#If Win16 Then
    Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
#Else
    Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
'定义字体
Type tfont
tBold As Boolean
    tCharset As Integer   '设置或者返回字体中所用字符集。
     tItalic  As Boolean  '返回或设置 Font 对象的字形为斜体或非斜体。
      tName As String '返回或设置字体对象的名字。
       tSize  As Integer '返回或设置 Font 对象中使用字体的大小
        tStrikethrough As Boolean  '返回或设置 Font 对象的字形为删除线或无删除
         tUnderline As Boolean  '返回或设置 Font 对象的字形为带下划线或不带下划线
         tWeight  As Integer '返回或设置组成 Font 对象的字符的权重
End Type
Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Type Ththk

  hth As String
  htl As Long
  yfl As Long
  wfl As Long
  hwm As String
  fhr As String
  fhdw As String
  qydw As String
  dj As Long
  je As Long
  sj As String
  bz As String
  htldx As String
  jedx As String
  ysfs As String
  jsfs As String
  fphm As Long
  tbr As String
  fzr As String
  sj1 As String
  djj As Boolean
   jcje As Long

End Type

Public sqlstrl As String
Public ttfont() As tfont
Public jl_sqlstr As String
Public jl_dwm As String
Public jl_wyl As Long '本合同未发量
Public jl_jrfyl As Long '安排今日发运量
Public jl_sqlwfl
Public jl_tzsy As String

Sub KeepOnTop(F As Form)
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

    SetWindowPos F.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE

End Sub



'##################################################################
'## 过程名称：Main
'## 参数： 无
'##################################################################
Public Sub Main()
    Dim i As Integer
    Call OnlyOne
    frmLogin.Show
    '    Call InitSystem
    '    SysLoad (False)
    
End Sub
    

Function Up(Dxs As String) As String
'检测为空时
 If Trim(Dxs) = "" Then
    MsgBox "没有数字，不能转换!", vbOKOnly + 32
    Exit Function
End If
  Dim Sw As Integer, SzP As Integer, SzUp As Integer, TempStr As String, DXStr As String
    Sw = Len(Trim(Dxs))
    SzP = InStr(1, Trim(Dxs), ".")
    If SzP = 0 Then
    Dxs = Dxs + ".00"
     SzP = InStr(1, Trim(Dxs), ".")
     End If
If SzP = 0 Then
   Dim i As Integer
     For i = 1 To Sw
         TempStr = Right(Trim(Dxs), i)
         TempStr = Left(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
               If TempStr = "零" Then
                  TempStr = "元"
                   Else
                  TempStr = TempStr + "元"
               End If
           Case 2
               If TempStr = "零" Then
                  TempStr = "零"
                Else
                  TempStr = TempStr + "拾"
               End If
           Case 3
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "佰"
               End If
            Case 4
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "仟"
               End If
            Case 5
               If TempStr = "零" Then
                  TempStr = "万"
                   Else
                  TempStr = TempStr + "万"
               End If
            Case 6
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "拾"
               End If
            Case 7
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "佰"
               End If
            Case 8
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "仟"
               End If
            Case 9
               If TempStr = "零" Then
                  TempStr = "亿"
                   Else
                  TempStr = TempStr + "亿"
               End If
         End Select
    Dim TempA As String
        TempA = Left(Trim(DXStr), 1)
    If TempStr = "零" Then
      Select Case TempA
       Case "零"
            DXStr = DXStr
       Case "元"
            DXStr = DXStr
       Case "万"
            DXStr = DXStr
       Case "亿"
            DXStr = DXStr
       Case Else
            DXStr = TempStr + DXStr
      End Select
      Else
       DXStr = TempStr + DXStr
    End If
     Next
  Else
    For i = 1 To SzP - 1
         TempStr = Right(Trim(Dxs), i + (Sw - SzP + 1))
         TempStr = Left(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
               If TempStr = "零" Then
                  TempStr = "元"
                   Else
                  TempStr = TempStr + "元"
               End If
           Case 2
               If TempStr = "零" Then
                  TempStr = "零"
                Else
                  TempStr = TempStr + "拾"
               End If
           Case 3
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "佰"
               End If
            Case 4
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "仟"
               End If
            Case 5
               If TempStr = "零" Then
                  TempStr = "万"
                   Else
                  TempStr = TempStr + "万"
               End If
            Case 6
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "拾"
               End If
            Case 7
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "佰"
               End If
            Case 8
               If TempStr = "零" Then
                  TempStr = "零"
                   Else
                  TempStr = TempStr + "仟"
               End If
            Case 9
               If TempStr = "零" Then
                  TempStr = "亿"
                   Else
                  TempStr = TempStr + "亿"
               End If
            Case Else
              '超过999999999时自动删除
              TempStr = ""
         End Select
        TempA = Left(Trim(DXStr), 1)
    If TempStr = "零" Then
      Select Case TempA
       Case "零"
            DXStr = DXStr
       Case "元"
            DXStr = DXStr
       Case "万"
            DXStr = DXStr
       Case "亿"
            DXStr = DXStr
       Case Else
            DXStr = TempStr + DXStr
      End Select
      Else
       DXStr = TempStr + DXStr
    End If
     Next
'计算小数
   Dim DxstrX As String, XStr As String
      XStr = Right(Trim(Dxs), Sw - SzP)
        For i = 1 To Sw - SzP
         TempStr = Left(XStr, i)
         TempStr = Right(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
            If TempStr = "零" Then
               TempStr = ""
               Else
               TempStr = TempStr + "角"
            End If
           Case 2
            If TempStr = "零" Then
               TempStr = ""
               Else
               TempStr = TempStr + "分"
               End If
            Case Else
              '超过两位小数时，自动删除
              TempStr = ""
         End Select
        DxstrX = DxstrX + TempStr
     Next
     DXStr = DXStr + DxstrX
End If
    Up = DXStr
End Function
Function Converts(NumStr As String) As String
    Select Case Val(NumStr)
      Case 0
        Converts = "零"
      Case 1
        Converts = "壹"
      Case 2
        Converts = "贰"
      Case 3
        Converts = "叁"
      Case 4
        Converts = "肆"
      Case 5
        Converts = "伍"
      Case 6
         Converts = "陆"
      Case 7
         Converts = "柒"
      Case 8
         Converts = "捌"
      Case 9
         Converts = "玖"
    End Select
End Function
Function NumberTrue(keyNumber As Integer, NumberStr As TextBox) As Boolean
   '转入退格键时
   If keyNumber = 8 Then
      If Len(NumberStr.Text) > 0 Then
      NumberStr.Text = Left(NumberStr.Text, Len(NumberStr.Text) - 1)
      NumberStr.SelStart = Len(NumberStr.Text)
      NumberStr.SelLength = 0
      NumberTrue = True
      Exit Function
      End If
      End If
   If keyNumber >= 46 And keyNumber <= 57 And keyNumber <> 47 Then
       NumberTrue = True
        Else
       NumberTrue = False
   End If
End Function
Function connet() As Boolean
   Dim filen As String
   Dim freefeilen As Integer
   Dim stree As String
   freefeilen = FreeFile
   filen = App.Path & "\config.cfg"
  If Dir(filen) > "" Then
    Open filen For Input As #freefeilen
   
   Do
   Line Input #freefeilen, stree
   connetstr = connetstr & stree
   Loop Until EOF(freefeilen)
   Close #freefeilen
   connet = True
    Else
    connet = False
   MsgBox "数据库配置文件不存在", , "数据库配置文件检测"
   frmODBCLogon.Show
   End If
   
End Function
Function month1(mu As Integer) As String
 If mu < 9 Then
  month1 = "0" & Trim(Str(mu))
 Else
 month1 = Trim(Str(mu))
 End If
End Function