moddeclare.bas

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

Attribute VB_Name = "ModDeclare"

Option Explicit
'**************************************************************
'*模块名称：ModDeclare
'*模块功能：全局常量的声明
'*说明：
'*
'*备注：
'*
'*作者：chlf78
'*日期：2002-03-27 15:01:28
'***************************************************************

Private Const ModalName = "ModDeclare"

'Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
'    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    
Public Const MAXROWS        As Integer = 10         '*正文最大的分行数

Public Const UNIT = 0.03937 * 1440                  '*毫米和缇的换算

Public Const MYSPACE = 1 * UNIT                     '*打印的边界间隔

Public Const LEASTWIDTH = 200                       '*最小的列宽


Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = -16
Private Const LVM_FIRST = &H1000
Private Const LVM_GETHEADER = LVM_FIRST + 31
Private Const HDS_BUTTONS = &H2

'**************************************************************
'*名称：FlatLv
'*功能：平滑listview的列头
'*传入参数：
'*      lvhwnd      --listview的句柄
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-03-11 10:22:13
'***************************************************************
Public Sub FlatLv(lvhwnd As Long)
Dim l As Long
Dim Style As Long
Dim nHeader As Long
    nHeader = SendMessage(lvhwnd, LVM_GETHEADER, 0, ByVal 0&)
    Style = GetWindowLong(nHeader, GWL_STYLE)
    Style = Style Xor HDS_BUTTONS
    If Style Then
        l = SetWindowLong(nHeader, GWL_STYLE, Style)
    End If
End Sub


Public Sub SelAllTxt(text As Object)

    On Error Resume Next
    
    text.SetFocus
    text.SelStart = 0
    text.SelLength = Len(text.text)
    
End Sub

'**************************************************************
'*名称：rplStr
'*功能：
'*传入参数：
'*
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-6-29 15:08:41
'**************************************************************
Public Function rplStr(ByVal str As String, _
                        pages As Integer, cutpages As Integer, _
                        page As Integer, cutpage As Integer _
                        ) As String
'*替换宏

    '*先将"&&"替换成不可见的字符
    str = Replace(str, "&&", Chr(1))
    '*替换日期
    str = Replace(str, "&D", Date)
    str = Replace(str, "&d", Date)
    '*替换时间
    str = Replace(str, "&T", Time)
    str = Replace(str, "&t", Time)
    '*替换页数
    str = Replace(str, "&P", page)
    str = Replace(str, "&p", page)
    '*替换分页数
    str = Replace(str, "&C", cutpage)
    str = Replace(str, "&c", cutpage)
    '*替换总页数
    str = Replace(str, "&S", pages)
    str = Replace(str, "&s", pages)
    '*替换总分页数
    str = Replace(str, "&A", cutpages)
    str = Replace(str, "&a", cutpages)
    '*将"&&"换回成"&"
    rplStr = Replace(str, Chr(1), "&")
    
End Function

'**************************************************************
'*名称：SplitStr
'*功能：分离字符串为左中右三段
'*传入参数：
'*
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-6-29 15:08:56
'**************************************************************
Public Sub SplitStr(ByVal str As String, _
                     ByRef strLeft As String, _
                     ByRef strMiddle As String, _
                     ByRef strRight As String)
Dim i           As Integer
Dim j           As Integer
    str = Replace(str, "||", Chr(1))
    strLeft = str
    strMiddle = ""
    strRight = ""
    '*从左开始查找"|"
    i = InStr(1, str, "|", vbTextCompare)
    If i > 0 Then
        strLeft = left(str, i - 1)
        '*再找"|"
        j = InStr(i + 1, str, "|", vbTextCompare)
        If j > 0 Then
            strMiddle = Mid(str, i + 1, j - i - 1)
            strRight = Right(str, Len(str) - j)
        Else
            strRight = Right(str, Len(str) - i)
        End If
    End If
    '*将"|"换回
    strLeft = Replace(strLeft, Chr(1), "|")
    strMiddle = Replace(strMiddle, Chr(1), "|")
    strRight = Replace(strRight, Chr(1), "|")
End Sub

Public Function CenterForm(frm As Form)
'*窗体居中对齐
    frm.left = (Screen.width - frm.width) / 2
    frm.Top = (Screen.height - frm.height) / 2
End Function