📄 modpubfun.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 + -