www.pudn.com > VB-KAOQINXITONG.zip > modDBPublic.bas

Attribute VB_Name = "modDBPublic" 
Option Explicit 
 
Public gTAixSystemParament As AixSystemParament 
'gTOperRight 包含操作员具备的各种操作权限 
Public gTOperRight     As OpertorRights 
'gclsCommon 包含一些实用程序 
Public gclsCommon      As BNCommonProj.clsBNCommon 
'gclsPntCtrl 可以控制打印机的纸向,弥补VB的报表在对打印机控制方面的不足 
Public gclsPntCtrl     As BNIncludeProj.clsBNPrinterCtrl 
'gTAppLicInfo 包括应用程序的一些基本信息,为全局函数,在程序的任何地方引用 
Public gTAppLicInfo    As AppLicenceInfo 
' gclsInclude 包含所有的常用的函数,某些函数在使用时需要认证 
Public gclsInclude     As BNIncludeProj.clsBNInclude 
 
Public gbSetclsInclude As Boolean '是否使用了gclsInclude的标志 
Public gbErrLog        As Boolean 
Public giDebug         As Integer 
 
'本函数对记录集RS中的字段变量进行自动赋值 
Public Function SetFieldValue(frm As Form, RS As ADODB.Recordset) As Boolean 
  Dim oCtrl As Control 
  'DTPicker,CheckBox,TextBox 
  For Each oCtrl In frm.Controls 
    Select Case TypeName(oCtrl) 
      Case "DTPicker", "CheckBox", "TextBox" 
        If oCtrl.DataField <> "" Then 
          With RS.Fields(oCtrl.DataField) 
            If .Type = eadDate Then 
              If IsDate(oCtrl) Then 
                .Value = oCtrl 
              Else 
                RS.Fields(oCtrl.DataField) = Null 
              End If 
            Else 
              .Value = oCtrl 
            End If 
          End With 
        End If 
    End Select 
  Next 
End Function 
 
'本函数将表单(窗体)中的图标进行统一代换,并且自动按照系统的分辨率调整所有的控件 
'同时,还根据按钮的Ctrl.Tag属性对按钮自动设置风格包括按钮图标 
Public Sub SetIcon(fForm As Object) 
  On Error Resume Next 
  Dim Ctrl As Control 
  If gTAppLicInfo.CtrlNeedResize Then gclsInclude.MyAdjustForm fForm, 1024, 768 
   
  gclsCommon.CBNSetIcon fForm, gTAppLicInfo.SoftIconKey 
  '对于报表不进行按钮处理 
  If Left(TypeName(fForm), 3) = "rpt" Then Exit Sub 
  '按钮处理 
  For Each Ctrl In fForm.Controls 
    If TypeName(Ctrl) = "SuperBtn" Then 
      If Ctrl.Tag <> "" Then 
        gclsCommon.CBNSetSuperButton Ctrl, gTAppLicInfo.CtrlButtonStyle 
      End If 
    ElseIf TypeName(Ctrl) = "BNButton" Then 
      If Ctrl.Tag <> "" Then 
        gclsCommon.CBNSetSuperButton Ctrl, gTAppLicInfo.CtrlButtonStyle 
        DoEvents 
      End If 
    End If 
  Next 
End Sub 
 
'以下函数为帮助函数,能够将表单中的所有自制按钮的TAG提取出来,形成VB的代码 
'输入变量foForm为表单 
Public Sub LoSetButtonTag(foForm) 
  Dim oBton As Control 
  Dim bErr As Boolean 
  Dim i As Integer 
  Dim sTemp As String 
  On Error GoTo ErrLabel 
  sTemp = foForm.Name & vbCrLf 
  sTemp = sTemp & "Private Sub LoSetButtonTag()" & vbCrLf 
  For Each oBton In foForm.Controls 
    If TypeName(oBton) = "SuperBtn" Then 
      bErr = False 
      i = oBton.Index 
      If bErr Then 
        sTemp = sTemp & "  " & oBton.Name & ".Tag = " & Chr(34) & oBton.Tag & Chr(34) & vbCrLf 
      Else 
        sTemp = sTemp & "  " & oBton.Name & "(" & oBton.Index & ").Tag = " & Chr(34) & oBton.Tag & Chr(34) & vbCrLf 
      End If 
    End If 
  Next 
  sTemp = sTemp & "End Sub" 
  Debug.Print sTemp 
Exit Sub 
ErrLabel: 
  If Err = 343 Then 
    bErr = True 
    Err.Clear 
    Resume Next 
  Else 
     MsgBox Error 
  End If 
End Sub 
 
'对打印纸的方向进行设置 
Public Function SetPrintPaple(fiMode As Integer) As Boolean 
  Dim l As Long 
  On Error GoTo ErrLabel 
  '先判断系统是否存在打印机 
  If Not gclsCommon.CBNHavePrinter(True) Then Exit Function 
  If gTAppLicInfo.CtrlPapleCtrl Then 
    If fiMode = 0 Then '将打印纸设置为竖向 
      gclsPntCtrl.PRN_ChngOrientationPortrait 
    ElseIf fiMode = 1 Then '将打印纸设置为横向 
      gclsPntCtrl.PRN_ChngOrientationLandscape 
    End If 
    '给足够的时间让打印机动作 
    For l = 1 To 40 
      DoEvents 
    Next l 
  End If 
  SetPrintPaple = True 
  Exit Function 
ErrLabel: 
End Function