⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modpubfun.bas

📁 中专学校的学生操行分管理系统,包含了网络查询的功能
💻 BAS
字号:
Attribute VB_Name = "modPubFun"
'打印数据网格控件   黄敬东
'Api函数及自定义函数
Option Explicit

Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetParent Lib "user32" _
    (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Public Const GWL_STYLE = (-16)
Public Const LVM_FIRST = &H1000
Public Const LVM_GETHEADER = (LVM_FIRST + 31)
Public Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)
Public Const HDS_BUTTONS = &H2


'/*将所有控件的字体置 为"宋体"大小 为9
Public Sub SetFont(x As Form)
    Dim ctrl As Control
    On Error Resume Next
    For Each ctrl In x.Controls
        ctrl.Font.Name = "宋体"
        ctrl.Font.Size = 9
    Next
End Sub

Public Sub InitBrookObject(bo As BrookObject)
    With bo
        .Align = bpLeft
        .backColor = vbWhite
        .borderColor = vbBlack
        .CurX = 0
        .curY = 0
        .Font.Bold = False
        .Font.Italic = False
        .Font.Name = "宋体"
        .Font.Size = 10
        .Font.Strikethrough = False
        .Font.Underline = False
        .ForeColor = vbBlack
        .Height = 0
        .isFun = False
        .style = 1
        .Text = ""
        .Width = 0
    End With
End Sub

Public Sub CopyBrookObject(source As BrookObject, distination As BrookObject)
    With distination
        .Align = source.Align
        .backColor = source.backColor
        .borderColor = source.borderColor
        .CurX = source.CurX
        .curY = source.curY
        CopyFont .Font, source.Font
        .ForeColor = source.ForeColor
        .Height = source.Height
        .isFun = source.isFun
        .style = source.style
        .Text = source.Text
        .Width = source.Width
    End With
End Sub

Public Sub CopyFont(source As StdFont, distination As StdFont)
'/*传递字体
    With distination
        .Size = source.Size
        .Name = source.Name
        .Bold = source.Bold
        .Italic = source.Italic
        .Underline = source.Underline
        .Strikethrough = source.Strikethrough
    End With
End Sub

Public Sub AboutInfo()
    Dim strAbout As String
    
    strAbout = Chr(10) & Chr(13) & Space(8) & "本控件是测试版软件,如果您在使用过程中发现BUG或有什么建议,请与作者联系。" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & "由于是测试版控件,作者对使用本控件所造成的一切后果不付任何责任。" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & Space(8) & "作者  :黄敬东" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & Space(8) & "QQ    :36287066" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & Space(8) & "E_mail:hfamwu@163.com;hfbrook@yahoo.com.cn"
    MsgBox strAbout, , "关于打印控件"
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -