2004年11月30日

Option Explicit
Dim CURRENTROW As Integer
Private Sub Form_Load()
Dim i As Integer, j As Integer
With MSHFlexGrid1
.Rows = 10
.Cols = 4
For i = 1 To 9
.TextMatrix(i, 0) = “第 ” & i & ” 行”
For j = 1 To 3
.TextMatrix(0, j) = “第 ” & j & ” 列”
.TextMatrix(i, j) = i & “,” & j
Next
Next
End With
End Sub
Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With MSHFlexGrid1
     .Row = .MouseRow
          CURRENTROW = .Row
      .Col = 0
        .ColSel = .Cols – 1
    End With
End Sub
Private Sub MSHFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
With MSHFlexGrid1
.RowSel = CURRENTROW
.ColSel = .Cols – 1
End With
End Sub

2004年11月23日

问题背景:


前几天在论坛中看到有一个提问的问题,内容是:


模块中的代码:


Option Explicit


 


Public Declare Function GetComputerName Lib “kernel32″ Alias “GetComputerNameA” (ByVal lpBuffer As String, nSize As Long) As Long’声明获取计算机名的API函数


 


窗体中的代码:


Option Explicit


 


Private Sub Command1_Click()


   Dim computername As String


   Dim length As Long


   length = 255


   str = String(length, 0)


  


   GetComputerName computername, length


  


   Debug.Print computername,


End Sub


以上程序的功能是获取计算机名。


大家看上面API中的lpBuffer这个形参被声明为Byval(传值)方式。那么在调用之后API函数却可以通过computername这个实参传回计算机名,那么形参不是被声明为传值调用方式吗?即形参值的改变不会影响到实参,可是这里调用API函数后却可以通过实参返回值,这是到底是什么原因呢?


相关知识:


大家都知道,VB中没有C语言中的指针类型。C语言中只有字符数据类型,即字符变量只能存放一个字符,而没有字符串变量,它操作字符串是通过字符型指针来实现的,它的特点是通过’\0’来判断字符是否结束的。而VB有字符串变量类型,一种变长,一种是定长的。并且VB字符串具体自动保护功能。


例如:dim str as string * 6


      str=”abcdef”


      debug.print str’那么将显示abcdef


      str=”abcdefghijklmnopq”


      debug.print str’还显示abcdef,说明它具有保护功能,将超过的字符截掉


VB中使用的字符是一种叫做BSTR格式的字符串指针类型。









6   a    b    d    e     f    chr(0)


字符个数描述符由VB来使用,BSTR指针直接指向第一个字符。


因为大多数API函数是用CC++来编写的,在C/C++(API)中使用叫做LPSTR类型的指针。


  


VB中字符串变量在内存中的存储状态图:





从上图可知:字符串变量X的地址与实际字符串的地址不同,也就是说字符X变量中实际上是存放的字符串的首地址这一点是和C/C++相同的。其实图中descriptor这个描述符就是C中的字符串指针地址。当BSTR指针在忽略字符个数描述前缀的情况下是与LPSTR指针是相同的,在调用API时可以将BSTR以传值方式传递给API采用传值方式传递时实际上传递的是实参中所存放的字符串的首地址,当调用过API后,可以通过它来返回数据,API修改传送给它的那个地址所指向的字符串数据,而没有修改实参字符变量内的内容,所以可以返回数据。即并没有与高级语言中所规定的传值方式调用方式的形参改变不影响实参的规则相冲突。


 


实例:


模块中的代码:


Option Explicit


 


Public Declare Function GetComputerName Lib “kernel32″ Alias “GetComputerNameA” (ByVal lpBuffer As String, nSize As Long) As Long


窗体中的代码:


 


Option Explicit


 


Private Sub Command1_Click()


   Dim str As String


   Dim str1 as String


   Dim length As Long


   length = 255


 


   str = String(length, 0)


   str1=str


   Debug.Print VarPtr(str),”     “,varptr(str1)


   Debug.Print StrPtr(str),”      ”,strptr(str1)


   Debug.Print


 


   GetComputerName str, length


 


   Debug.Print str


   Debug.Print VarPtr(str)


   Debug.Print StrPtr(str), Len(str), length


End Sub


 


在立即窗口中可以看到运行结果。字符串变量的地址与字符串的地址不同。


还可以看到字符串变量strstr1的地址不同,而且字符串地址也不同,这说明在进行赋值操作,并不是将字符的首地址赋给str1而是在内存中另开一空间用来存放字符串。而在C语言内则可以使多个字符型指针变量指向同一个字符串的首地址。


当将API中的ByVal lpBuffer As String传值方式改为:ByRef lpBuffer As String传址方式时,运行程序中出错,VB编程环境将崩溃。


出错图:





因为传址时将变量本身的地址传给了API,并没有将字符串的首地址传给API,所以API在修改数据时造成访问错误。


总结


不能用传址方式来调用API,如果用传址方式的话那么传递的是指向指针的指针,API将不能返回数据,并且造成访问数据出错,所以需要用ByVal传递字符串指针。


定义一个类模块,方法:工程->添加类模块。代码如下:


Option Explicit


Private Type POINTAPI
    x As Long
    y As Long
End Type


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


Private Type PRINTDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hdc As Long
    Flags As Long
    nFromPage As Integer
    nToPage As Integer
    nMinPage As Integer
    nMaxPage As Integer
    nCopies As Integer
    hInstance As Long
    lCustData As Long
    lpfnPrintHook As Long
    lpfnSetupHook As Long
    lpPrintTemplateName As String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type


Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    Flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 31
End Type


Private Type CHOOSEFONT
    lStructSize As Long
    hwndOwner As Long          ‘  caller’s window handle
    hdc As Long                ‘  printer DC/IC or NULL
    lpLogFont As Long
    iPointSize As Long         ‘  10 * size in points of selected font
    Flags As Long              ‘  enum. type flags
    rgbColors As Long          ‘  returned text color
    lCustData As Long          ‘  data passed to hook fn.
    lpfnHook As Long           ‘  ptr. to hook function
    lpTemplateName As String     ‘  custom template name
    hInstance As Long          ‘  instance handle of.EXE that
                                   ‘    contains cust. dlg. template
    lpszStyle As String          ‘  return the style field here
                                   ‘  must be LF_FACESIZE or bigger
    nFontType As Integer          ‘  same value reported to the EnumFonts
                                   ‘    call back with the extra FONTTYPE_
                                   ‘    bits added
    MISSING_ALIGNMENT As Integer
    nSizeMin As Long           ‘  minimum pt size allowed &
    nSizeMax As Long           ‘  max pt size allowed if
                                       ‘    CF_LIMITSIZE is used
End Type


Private Type FINDREPLACE
    lStructSize As Long        ‘  size of this struct 0×20
    hwndOwner As Long          ‘  handle to owner’s window
    hInstance As Long          ‘  instance handle of.EXE that
                                ‘    contains cust. dlg. template
    Flags As Long              ‘  one or more of the FR_??
    lpstrFindWhat As String      ‘  ptr. to search string
    lpstrReplaceWith As String   ‘  ptr. to replace string
    wFindWhatLen As Integer       ‘  size of find buffer
    wReplaceWithLen As Integer    ‘  size of replace buffer
    lCustData As Long          ‘  data passed to hook fn.
    lpfnHook As Long            ‘  ptr. to hook fn. or NULL
    lpTemplateName As String     ‘  custom template name
End Type


Private Type PAGESETUPDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    Flags As Long
    ptPaperSize As POINTAPI
    rtMinMargin As RECT
    rtMargin As RECT
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End Type


Public Enum FileFlags
    OFN_ALLOWMULTISELECT = &H200
    OFN_CREATEPROMPT = &H2000
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATE = &H40
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_EXPLORER = &H80000                         ‘  new look commdlg
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_FILEMUSTEXIST = &H1000
    OFN_HIDEREADONLY = &H4
    OFN_LONGNAMES = &H200000                       ‘  force long names for 3.x modules
    OFN_NOCHANGEDIR = &H8
    OFN_NODEREFERENCELINKS = &H100000
    OFN_NOLONGNAMES = &H40000                      ‘  force no long names for 4.x modules
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOREADONLYRETURN = &H8000
    OFN_NOTESTFILECREATE = &H10000
    OFN_NOVALIDATE = &H100
    OFN_OVERWRITEPROMPT = &H2
    OFN_PATHMUSTEXIST = &H800
    OFN_READONLY = &H1
    OFN_SHAREAWARE = &H4000
    OFN_SHAREFALLTHROUGH = 2
    OFN_SHARENOWARN = 1
    OFN_SHAREWARN = 0
    OFN_SHOWHELP = &H10
   
    PD_ALLPAGES = &H0
    PD_COLLATE = &H10
    PD_DISABLEPRINTTOFILE = &H80000
    PD_ENABLEPRINTHOOK = &H1000
    PD_ENABLEPRINTTEMPLATE = &H4000
    PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
    PD_ENABLESETUPHOOK = &H2000
    PD_ENABLESETUPTEMPLATE = &H8000
    PD_ENABLESETUPTEMPLATEHANDLE = &H20000
    PD_HIDEPRINTTOFILE = &H100000
    PD_NONETWORKBUTTON = &H200000
    PD_NOPAGENUMS = &H8
    PD_NOSELECTION = &H4
    PD_NOWARNING = &H80
    PD_PAGENUMS = &H2
    PD_PRINTSETUP = &H40
    PD_PRINTTOFILE = &H20
    PD_RETURNDC = &H100
    PD_RETURNDEFAULT = &H400
    PD_RETURNIC = &H200
    PD_SELECTION = &H1
    PD_SHOWHELP = &H800
    PD_USEDEVMODECOPIES = &H40000
    PD_USEDEVMODECOPIESANDCOLLATE = &H40000
End Enum


Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400


Private Declare Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib “comdlg32.dll” Alias “GetSaveFileNameA” (pOpenfilename As OPENFILENAME) As Long
Private Declare Function PrintDialog Lib “comdlg32.dll” Alias “PrintDlgA” (pPrintdlg As PRINTDLG) As Long
Private Declare Function ChooseColorDialog Lib “comdlg32.dll” Alias “ChooseColorA” (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function CHOOSEFONT Lib “comdlg32.dll” Alias “ChooseFontA” (pChoosefont As CHOOSEFONT) As Long
Private Declare Function FindText Lib “comdlg32.dll” Alias “FindTextA ” (pFindreplace As FINDREPLACE) As Long
Private Declare Function PAGESETUPDLG Lib “comdlg32.dll” Alias “PageSetupDlgA” (pPagesetupdlg As PAGESETUPDLG) As Long
Private Declare Function ReplaceText Lib “comdlg32.dll” Alias “ReplaceTextA” (pFindreplace As FINDREPLACE) As Long


Private Declare Function GlobalAlloc Lib “kernel32″ (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib “kernel32″ (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib “kernel32″ (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib “kernel32″ (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib “kernel32″ Alias “RtlMoveMemory” (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


‘ FileOpen 类成员变量 =====================================================
Private m_lngHwnd As Long
Private m_lngInstance As Long
Private m_strFileName As String
Private m_strFileTitle As String
Private m_strInitDir As String
Private m_strDialogTitle As String
Private m_strFilter As String
Private m_lngFlags As Long


‘ Print 类成员变量 =====================================================
Private m_lngCopies As Long
Private m_lngFromPage As Long
Private m_lngToPage As Long
Private m_lngMaxPage As Long
Private m_lngMinPage As Long


‘ Print 类成员变量 =====================================================
Private m_lngColor As Long


‘ Font 类成员变量 =====================================================
Private m_strFontName As String
Private m_lngFontColor As Long
Private m_lngFontSize As Long
Private m_lngCharSet As Long
Private m_bolItalic As Boolean
Private m_bolStrikeOut As Boolean
Private m_bolUnderline As Boolean
Private m_bolBlob As Boolean


‘ PageSetup 类成员变量 =====================================================
Private m_lngPaperWidth As Long
Private m_lngPaperHeight As Long
Private m_lngMarginLeft As Long
Private m_lngMarginTop As Long
Private m_lngMarginRight As Long
Private m_lngMarginBottom As Long


‘ FileOpen 类实现 =========================================================
Public Function ShowOpen() As Boolean
    Dim fName As String, sName As String, OfName As OPENFILENAME
   
    OfName.lStructSize = Len(OfName)
    OfName.hwndOwner = m_lngHwnd
    OfName.hInstance = m_lngInstance
    OfName.lpstrInitialDir = m_strInitDir
    OfName.lpstrFilter = m_strFilter
    OfName.lpstrFile = Space(255) & Chr(0)
    OfName.nMaxFile = 256
    OfName.lpstrFileTitle = Space(255) & Chr(0)
    OfName.nMaxFileTitle = 256
    OfName.lpstrTitle = m_strDialogTitle
    OfName.Flags = m_lngFlags
   
    If GetOpenFileName(OfName) Then
        m_strFileName = OfName.lpstrFile
        m_strFileTitle = OfName.lpstrFileTitle


        ShowOpen = True
    Else
        ShowOpen = False
    End If
End Function


Public Property Get Filter() As String
    Filter = m_strFilter
End Property


Public Property Let Filter(ByVal vNewValue As String)
    m_strFilter = Replace(vNewValue, “|”, Chr(0)) & Chr(0)
End Property


Public Property Get Flags() As FileFlags
    Flags = m_lngFlags
End Property


Public Property Let Flags(ByVal vNewValue As FileFlags)
    m_lngFlags = vNewValue
End Property


Public Property Get DialogTitle() As String
    DialogTitle = m_strDialogTitle
End Property


Public Property Let DialogTitle(ByVal vNewValue As String)
    m_strDialogTitle = vNewValue
End Property


Public Property Get InitDir() As String
    InitDir = m_strInitDir
End Property


Public Property Let InitDir(ByVal vNewValue As String)
    m_strInitDir = vNewValue
End Property


Public Property Get FileTitle() As String
    FileTitle = m_strFileTitle
End Property


Public Property Let FileTitle(ByVal vNewValue As String)
    m_strFileTitle = vNewValue
End Property


Public Property Get FileName() As String
    FileName = m_strFileName
End Property


Public Property Let FileName(ByVal vNewValue As String)
    m_strFileName = vNewValue
End Property


Public Property Get Hwnd() As Long
    Hwnd = m_lngHwnd
End Property


Public Property Let Hwnd(ByVal vNewValue As Long)
    m_lngHwnd = vNewValue
End Property


Public Property Get Instance() As Long
    Instance = m_lngInstance
End Property


Public Property Let Instance(ByVal vNewValue As Long)
    m_lngInstance = vNewValue
End Property


‘ FileSave 类实现 =========================================================
Public Function ShowSave() As Boolean
    Dim fName As String, sName As String, OfName As OPENFILENAME
   
    OfName.lStructSize = Len(OfName)
    OfName.hwndOwner = m_lngHwnd
    OfName.hInstance = m_lngInstance
    OfName.lpstrInitialDir = m_strInitDir
    OfName.lpstrFilter = m_strFilter
    OfName.lpstrFile = Space(255) & Chr(0)
    OfName.nMaxFile = 256
    OfName.lpstrFileTitle = Space(255) & Chr(0)
    OfName.nMaxFileTitle = 256
    OfName.lpstrTitle = m_strDialogTitle
    OfName.Flags = m_lngFlags
   
    If GetSaveFileName(OfName) Then
        m_strFileName = OfName.lpstrFile
        m_strFileTitle = OfName.lpstrFileTitle


        ShowSave = True
    Else
        ShowSave = False
    End If
End Function


‘ Print 类实现 =========================================================
Public Function ShowPrint() As Boolean
    Dim PrtDlg As PRINTDLG
   
    PrtDlg.lStructSize = Len(PrtDlg)
    PrtDlg.hwndOwner = m_lngHwnd
    PrtDlg.hInstance = m_lngInstance
    PrtDlg.nCopies = m_lngCopies
    PrtDlg.nFromPage = m_lngFromPage
    PrtDlg.nMaxPage = m_lngMaxPage
    PrtDlg.nMinPage = m_lngMinPage
    PrtDlg.nToPage = m_lngToPage
    PrtDlg.Flags = m_lngFlags
       
    If PrintDialog(PrtDlg) Then
        m_lngCopies = PrtDlg.nCopies
        m_lngFromPage = PrtDlg.nFromPage
        m_lngMaxPage = PrtDlg.nMaxPage
        m_lngMinPage = PrtDlg.nMinPage
        m_lngToPage = PrtDlg.nToPage


        ShowPrint = True
    Else
        ShowPrint = False
    End If
End Function


Public Property Get Copies() As Long
    Copies = m_lngCopies
End Property


Public Property Let Copies(ByVal vNewValue As Long)
    m_lngCopies = vNewValue
End Property


Public Property Get FromPage() As Long
    FromPage = m_lngFromPage
End Property


Public Property Let FromPage(ByVal vNewValue As Long)
    m_lngFromPage = vNewValue
End Property


Public Property Get ToPage() As Long
    ToPage = m_lngToPage
End Property


Public Property Let ToPage(ByVal vNewValue As Long)
    m_lngToPage = vNewValue
End Property


Public Property Get MaxPage() As Long
    MaxPage = m_lngMaxPage
End Property


Public Property Let MaxPage(ByVal vNewValue As Long)
    m_lngMaxPage = vNewValue
End Property


Public Property Get MinPage() As Long
    MinPage = m_lngMinPage
End Property


Public Property Let MinPage(ByVal vNewValue As Long)
    m_lngMinPage = vNewValue
End Property


‘ ChooseColorDialog 类实现 =========================================================
Public Function ShowColor() As Boolean
    Dim i As Integer
    Dim ClrDlg As CHOOSECOLOR, CustomColors() As Byte


    ReDim CustomColors(0 To 63) As Byte
    For i = LBound(CustomColors) To UBound(CustomColors)
        CustomColors(i) = 0
    Next i


    ClrDlg.lStructSize = Len(ClrDlg)
    ClrDlg.hwndOwner = m_lngHwnd
    ClrDlg.hInstance = m_lngInstance
    ClrDlg.lpCustColors = StrConv(CustomColors, vbUnicode)
 
    If ChooseColorDialog(ClrDlg) Then
        m_lngColor = ClrDlg.rgbResult
        CustomColors = StrConv(ClrDlg.lpCustColors, vbFromUnicode)


        ShowColor = True
    Else
        ShowColor = False
    End If
End Function


Public Property Get Color() As Long
    Color = m_lngColor
End Property


Public Property Let Color(ByVal vNewValue As Long)
    m_lngColor = vNewValue
End Property


‘ Font 类实现 =========================================================
Public Function ShowFont() As Boolean
    Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
    Dim FontName As String, retval As Long
   
    lfont.lfHeight = 0  ‘ determine default height
    lfont.lfWidth = 0  ‘ determine default width
    lfont.lfEscapement = 0  ‘ angle between baseline and escapement vector
    lfont.lfOrientation = 0  ‘ angle between baseline and orientation vector
    lfont.lfWeight = FW_NORMAL  ‘ normal weight I.e. Not bold
    lfont.lfCharSet = DEFAULT_CHARSET  ‘ use default character set
    lfont.lfOutPrecision = OUT_DEFAULT_PRECIS  ‘ default precision mapping
    lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS  ‘ default clipping precision
    lfont.lfQuality = DEFAULT_QUALITY  ‘ default quality setting
    lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN  ‘ default pitch, proportional with serifs
    lfont.lfFaceName = “Times New Roman” & vbNullChar  ‘ string must be null-terminated
    ‘ Create the memory block which will act as the LOGFONT structure buffer.
    hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
    pMem = GlobalLock(hMem)  ‘ lock and get pointer
    CopyMemory ByVal pMem, lfont, Len(lfont)  ‘ copy structure’s contents into block
   
    ‘ Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
    cf.lStructSize = Len(cf)  ‘ size of structure
    cf.hwndOwner = m_lngHwnd  ‘ window Form1 is opening this dialog box
    cf.hdc = Printer.hdc  ‘ device context of default printer (using VB’s mechanism)
    cf.lpLogFont = pMem   ‘ pointer to LOGFONT memory block buffer
    cf.iPointSize = 120  ‘ 12 point font (in units of 1/10 point)
    cf.Flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
    cf.rgbColors = RGB(0, 0, 0)  ‘ black
    cf.nFontType = REGULAR_FONTTYPE  ‘ regular font type I.e. Not bold or anything
    cf.nSizeMin = 1  ‘ minimum point size
    cf.nSizeMax = 72  ‘ maximum point size
    ‘ Now, call the function.  If successful, copy the LOGFONT structure back into the structure
    ‘ and then print out the attributes we mentioned earlier that the user selected.
   
    If CHOOSEFONT(cf) Then  ‘ success
        CopyMemory lfont, ByVal pMem, Len(lfont)  ‘ copy memory back
        ‘ Now make the fixed-length string holding the font name into a “normal” string.
        m_strFontName = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) – 1)
        m_lngFontColor = cf.rgbColors
        m_lngFontSize = cf.iPointSize / 10
        m_lngCharSet = lfont.lfCharSet
        m_bolItalic = lfont.lfItalic = 255
        m_bolStrikeOut = lfont.lfStrikeOut = 1
        m_bolUnderline = lfont.lfUnderline = 1
        m_bolBlob = lfont.lfWeight >= 700
        ShowFont = True
    Else
        ShowFont = False
    End If
    ‘ Deallocate the memory block we created earlier.  Note that this must
    ‘ be done whether the function succeeded or not.
    retval = GlobalUnlock(hMem)  ‘ destroy pointer, unlock block
    retval = GlobalFree(hMem)  ‘ free the allocated memory
End Function


Public Property Get FontName() As String
    FontName = m_strFontName
End Property


Public Property Let FontName(ByVal vNewValue As String)
    m_strFontName = vNewValue
End Property


Public Property Get FontColor() As Long
    FontColor = m_lngFontColor
End Property


Public Property Let FontColor(ByVal vNewValue As Long)
    m_lngFontColor = vNewValue
End Property


Public Property Get FontSize() As Long
    FontSize = m_lngFontSize
End Property


Public Property Let FontSize(ByVal vNewValue As Long)
    m_lngFontSize = vNewValue
End Property


Public Property Get CharSet() As Long
    CharSet = m_lngCharSet
End Property


Public Property Let CharSet(ByVal vNewValue As Long)
    m_lngCharSet = vNewValue
End Property


Public Property Get Italic() As Boolean
    Italic = m_bolItalic
End Property


Public Property Let Italic(ByVal vNewValue As Boolean)
    m_bolItalic = vNewValue
End Property


Public Property Get StrikeOut() As Boolean
    StrikeOut = m_bolStrikeOut
End Property


Public Property Let StrikeOut(ByVal vNewValue As Boolean)
    m_bolStrikeOut = vNewValue
End Property


Public Property Get Underline() As Boolean
    Underline = m_bolUnderline
End Property


Public Property Let Underline(ByVal vNewValue As Boolean)
    m_bolUnderline = vNewValue
End Property


Public Property Get FontBlob() As Boolean
    FontBlob = m_bolBlob
End Property


Public Property Let FontBlob(ByVal vNewValue As Boolean)
    m_bolBlob = vNewValue
End Property


‘ Find 类实现 =========================================================
Public Function ShowFind() As Boolean
    Dim lFind As FINDREPLACE


    lFind.lStructSize = Len(lFind)
    lFind.hwndOwner = m_lngHwnd
    lFind.hInstance = m_lngInstance
    lFind.wFindWhatLen = 255
   
‘    If FindText(lFind) Then
‘        ShowFind = True
‘    Else
‘        ShowFind = False
‘    End If
End Function


‘ Replace 类实现 =========================================================
Public Function ShowReplace() As Boolean
    Dim lFind As FINDREPLACE


    lFind.lStructSize = Len(lFind)
    lFind.hwndOwner = m_lngHwnd
    lFind.hInstance = m_lngInstance
    lFind.wFindWhatLen = 255
   
    If ReplaceText(lFind) Then
        ShowReplace = True
    Else
        ShowReplace = False
    End If
End Function


‘ Replace 类实现 =========================================================
Public Function ShowPageSetup() As Boolean
    Dim lPageSetup As PAGESETUPDLG


    lPageSetup.lStructSize = Len(lPageSetup)
    lPageSetup.hwndOwner = m_lngHwnd
    lPageSetup.hInstance = m_lngInstance


    If PAGESETUPDLG(lPageSetup) Then
        m_lngPaperWidth = lPageSetup.ptPaperSize.x
        m_lngPaperHeight = lPageSetup.ptPaperSize.y
        m_lngMarginLeft = lPageSetup.rtMargin.Left
        m_lngMarginTop = lPageSetup.rtMargin.Top
        m_lngMarginRight = lPageSetup.rtMargin.Right
        m_lngMarginBottom = lPageSetup.rtMargin.Bottom
       
        ShowPageSetup = True
    Else
        ShowPageSetup = False
    End If
End Function


Public Property Get PaperWidth() As Long
    PaperWidth = m_lngPaperWidth
End Property


Public Property Let PaperWidth(ByVal vNewValue As Long)
    m_lngPaperWidth = vNewValue
End Property


Public Property Get PaperHeight() As Long
    PaperHeight = m_lngPaperHeight
End Property


Public Property Let PaperHeight(ByVal vNewValue As Long)
    m_lngPaperHeight = vNewValue
End Property


Public Property Get MarginLeft() As Long
    MarginLeft = m_lngMarginLeft
End Property


Public Property Let MarginLeft(ByVal vNewValue As Long)
    m_lngMarginLeft = vNewValue
End Property


Public Property Get MarginTop() As Long
    MarginTop = m_lngMarginTop
End Property


Public Property Let MarginTop(ByVal vNewValue As Long)
    m_lngMarginTop = vNewValue
End Property


Public Property Get MarginRight() As Long
    MarginRight = m_lngMarginRight
End Property


Public Property Let MarginRight(ByVal vNewValue As Long)
    m_lngMarginRight = vNewValue
End Property


Public Property Get MarginBottom() As Long
    MarginBottom = m_lngMarginBottom
End Property


Public Property Let MarginBottom(ByVal vNewValue As Long)
    m_lngMarginBottom = vNewValue
End Property


在窗口中添加六个按钮,分别用来实现调用这几个通用对话框,代码如下:


Option Explicit


Dim dlg As CDialog


Private Sub Command1_Click()
    dlg.Hwnd = Hwnd
    dlg.Filter = “WORD文档|*.doc;*.html”
    dlg.Flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER + OFN_PATHMUSTEXIST
    dlg.InitDir = “D:\”
    dlg.DialogTitle = “(昱豪)打开文件…”
   
    If dlg.ShowOpen Then
        MsgBox dlg.FileName
        MsgBox dlg.FileTitle
    End If
End Sub


Private Sub Command2_Click()
    dlg.Hwnd = Hwnd
    dlg.Filter = “WORD文档|*.doc;*.html”
    dlg.Flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER + OFN_PATHMUSTEXIST
    dlg.InitDir = “D:\”
    dlg.DialogTitle = “(昱豪)保存文件…”
   
    If dlg.ShowSave Then
        MsgBox dlg.FileName
        MsgBox dlg.FileTitle
    End If
End Sub


Private Sub Command3_Click()
    dlg.Hwnd = Hwnd
    dlg.Flags = PD_SELECTION + PD_USEDEVMODECOPIES
   
    If dlg.ShowPrint Then
        MsgBox “Copies:” & dlg.Copies & vbCrLf & _
            “FromPage:” & dlg.FromPage & vbCrLf & _
            “ToPage:” & dlg.ToPage & vbCrLf & _
            “MaxPage:” & dlg.MaxPage & vbCrLf & _
            “MinPage:” & dlg.MinPage
    End If
End Sub


Private Sub Command4_Click()
    dlg.Hwnd = Hwnd
   
    If dlg.ShowColor Then
        BackColor = dlg.Color
    End If
End Sub


Private Sub Command5_Click()
    dlg.Hwnd = Hwnd
   
    If dlg.ShowFont Then
        MsgBox “FontName:” & dlg.FontName & vbCrLf & _
            “FontColor:” & dlg.FontColor & vbCrLf & _
            “FontSize:” & dlg.FontSize & vbCrLf & _
            “CharSet:” & dlg.CharSet & vbCrLf & _
            “Italic:” & dlg.Italic & vbCrLf & _
            “StrikeOut:” & dlg.StrikeOut & vbCrLf & _
            “Underline:” & dlg.Underline & vbCrLf & _
            “Blob:” & dlg.FontBlob
    End If
End Sub


Private Sub Command6_Click()
    dlg.Hwnd = Hwnd
    If dlg.ShowFind Then
       
    End If
End Sub


Private Sub Command7_Click()
    dlg.Hwnd = Hwnd
   
    If dlg.ShowPageSetup Then
        MsgBox “PageWeight:” & dlg.PaperWidth & vbCrLf & _
            “PageHeight:” & dlg.PaperHeight & vbCrLf & _
            “MarginLeft:” & dlg.MarginLeft & vbCrLf & _
            “MarginTop:” & dlg.MarginTop & vbCrLf & _
            “MarginRight:” & dlg.MarginRight & vbCrLf & _
            “MarginBottom:” & dlg.MarginBottom
    End If
End Sub


Private Sub Command8_Click()
    dlg.Hwnd = Hwnd
   
    If dlg.ShowReplace Then
       
    End If
End Sub


Private Sub Form_Load()
    Set dlg = New CDialog
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Set dlg = Nothing
End Sub


  只要在工程中把这前面介绍的类文件加进去就可以使用了,不用外部的控件,安装的时候也省了一些控件,结省了空间!!

2004年11月17日

水晶报表(Crystal Report 4.6)只支持Access97格式的数据库, 所以,先在Access2000格式中设置好表与表的关


系,再把表转换到97格式,
在水晶报表中调入97数据库后,在Links中自动会找出表间的关系.


水晶报表在VB的安装盘中已自带了. 路径:  COMMON\TOOLS\VB\CRYSREPT\CRYSTL32.EXE
系列号: 1231467890
安装后,运行路径: \Program Files\Microsoft Visual Studio\Common\crw32.exe


VB6中运用晶报表的理由是: 它支持图相(Binary型)字段(BLOB二进制大型对象)
运用水晶报表的步骤:
先进入VB的菜单栏: 外接程序–报表设计器  自动进入水晶报表, 设计好报表,存成报表文件,


如SQL.rpt
再在VB工程中引入部件Crystal Report Control 4.6


如果是Access数据库, 激活代码:
  CrystalReport1.DiscardSavedData = True ‘自动从数据库中刷新数据
  CrystalReport1.ReportFileName = App.Path & “\mdb.rpt”
  CrystalReport1.WindowState = crptMaximized
  CrystalReport1.Action = 1
如果是SQL Server 2000数据库,激活代码:
  CrystalReport1.Connect = “ODBC;DNS=SQL_db1;UID=” & Text4.Text & “;PWD=” & Text5.Text &


“;DSQ=db1″ ‘连接SQL Server服务器的ODBC
  CrystalReport1.DiscardSavedData = True ‘自动从数据库中刷新数据
  CrystalReport1.ReportFileName = App.Path & “\sql.rpt”
  CrystalReport1.WindowState = crptMaximized
  CrystalReport1.Action = 1


重要:
a.如果需要报表预览时最大化纸张显示, 需在水晶报表设计器中设置: File–Report Options-Preview


Pages Start With –Full Size
b.如果只需要显示Detail部分,则在报表设计器的Design界面下的其它部分的左边按右键,在弹出的快捷


菜单内选定:
   Hide Section
c.如果要一页打印一条记录,则在报表设计器的Design界面下的Detail字样上按右键,在Format Section


中选择
   New Page After
d.如果Detail部分需要字符型字段自动折行显示, 则双击该字段,选择:
   Print on multiple lines
e.Detail部分数值型的显示格式,双击该字段,可弹出显示格式选项
f.目前还没有发现水晶报表具有分栏打印的功能,BCB的QuickReport则有.正文 

2004年11月11日

对!!!就是说你呢。怎么着啊,出息了你,学会离家出走了?我这才出了几天差,回
家一看连大衣柜都清空了!可以啊你,怎么没想着把咱们家的组合音响电脑电视什么的
也都搬走啊?喔,不想过了,就留一纸条儿撒丫子飞奔。你哭着喊着追寻自由去了,那
他妈我成什么人了?到时候你妈你爸问起来,我怎么知应他们?告诉说我媳妇跟着网友
私奔了?要是他们信也行,问题是头天还好好儿的,这一转脸连人影都没了,我信街坊
邻居也不信啊。你丫到底想怎么着,明说吧,想离婚也行,我也不拦着你,可你也得事
先给我一准谱儿啊,起草一份离婚协议书什么的啊。喔,怕我不肯离?

你也不想想,在外面腥风血雨折腾了小半辈子我他妈怵过谁啊我?平时说你任性,不懂
事,耍小孩子脾气我那是疼你,为你好,希望你能进步,你丫怎么就听不出个好赖话呢
?平时我亏待过你么?我是不给你吃了还是不给你穿了我?我们同事老李他媳妇难得穿
件深圳产的AZONA就美出大鼻涕泡儿来了,你丫一礼拜换一身秀水街范思哲还老不乐意,
对门小刘他们家一个月才吃一顿红烧肉,咱们家有事没事就满大街溜小馆子,生活都小
康成这样了,你丫还想怎么着啊?

如你所述:“我觉得,和你一起的日子已经没有了激情,变得平淡如水……”这话又是
从哪儿说起的?非得是身上绑着TNT满世界搞恐怖活动或者兜里揣把小刀劫持国航飞机那
才算是有激情了?

我知道我不是个富有生活情趣的人,可是临结婚那点儿,同时追你的那个在迪厅放唱片
的孙子,他有情趣他有激情,你那时候怎么不跟他走啊?喔,还是觉得我这样的人有安
全感吧?按你的话说了,鱼你所鱼,熊掌亦你所欲,那合着你欲到后来,我他妈是鱼啊
还是熊掌啊?什么好儿都让你一人落了,那满大街的超龄未婚男女都是干吗吃的啊?别
以为我追你的时候,多夸了你几句即漂亮又有气质你就把自己当七仙女儿了,明告诉你
吧,我还真不是董永那号大言不惭吃软饭的面主儿。

当初把你丫娶进门的时候,我曾经发过誓要使你过上让你们系全体女同学把眼珠子都羡
慕红了的好日子,而且扪心自问,我也一直在为这个目标努力着,虽然还没完全做到,
但至少迄今为止你们班那帮傻闺女肯定是羡慕不已,你丫也别不承认,上回校庆的时候
,那时候我还挺得意,没成想,这还没冲出班级,走向系里呢,你就跑了,早知道,就
不该让你丫上这破网。上网你就好好上吧,查点资料看点信息就行了,没事你进什么聊
天室啊?喔,觉得电影里寂寞男女网上相遇之后就恋到一块堆儿去挺浪漫的吧?可是!
何盼盼同志,别忘了你丫已经是嫁了人的主儿了,这么大年纪去跟那帮小雏儿含情脉脉
谈情说爱你也不嫌臊得慌?人家都是风华正茂,青春活力的大好青少年,可你呢?除了
这张长得还算顺眼的老白脸,你还能拿出什么来跟人家腻咕?前些日子瞧见你偷偷摸摸
上网还死挡着屏幕不让我看,我就有点起疑心,没成想,这还没等我开始调查呢,你丫
就先行一步。刚才我顺着你的BOOKMARK到网上瞧了一眼,那都是什么人呐?那叫邢什么
的,自己活得都不像人样,你还指望他能让你活出个样儿来?别听丫撺掇你说什么“我
们要好好相爱”,就那小瘦身板儿往那一戳就知道不是个能拖付终身的主儿。还有个叫
什么白眉毛的,那一看就是个白血病患者,而且还是一盲流,你瞧丫写那东西,什么四
大才子打麻将,搓麻就能搓出才子来?要真这样,社科院那帮人还不都成麻仙了!就这
样还好意思往外发呢。就这么一帮人,你也能死心塌地笑逐颜开地跟他们呲起来没完没
了,你丫真让我失望透了。

我该对你说些什么好呢?我深爱了17年的女同志。继续埋怨你吗?那会让你气上加气,
一鼓作气忘却我们曾经一起拥有过的美好年华,然后死心塌地地跟着你那网上的小哥们
儿吃饱了混天黑。或者,我苦苦哀求你回来?答应说以后不再忙着工作,天天陪你谈心
?我没法答应那种要求,我们要生存。

盼盼,你也这么大人了难道就不能有点责任心吗?任性一辈子?逮谁跟谁撒泼打滚?那
你要是能长成宫雪花那CAO形也行,坚持到五张多还能冒充纯情少女,可你毕竟不是宫雪
花,你的右眼旁边已经出现了鱼尾纹了,这你自己都没发现?不说了,好不容易平静下
来,我怕我又要生气。等会儿三儿过来找我喝酒,我大概会比较晚回家,你要是看见我
的贴子,也别回,今天晚上别给家打电话了,明天再打。现在北京特冷,外面刚下完雪
,街上的人都穿上了棉褂子了。我不知道你在哪个城市,刚才收拾了一下,发现你没有
带棉袄,要是冷的话,就让那哥们儿帮你买几件暖和衣裳,他要是没现钱,你就给我打
手机,我给你寄去,千万别病了,到时候弄得面黄肌瘦病病秧秧的,我没法跟你妈交代






红楼中动武之处有不少,场面上却只有柳湘莲痛打薛蟠。柳湘莲真是练家子,红楼中武艺他应该是最高,路数上看主要以剑法为主,拳脚也不错,因为后来出家做了道士,所以判定他是武当一派。
  另一位真行家应该是冯紫英,他是家传武功,考不了路数,从他和薛蟠所言打坏了人看,主要是拳法。
    
  贾政读书出身,擅使一根大竹板,家传贾家竹板功,由史太君道数说的“当年你老子……,他学武时怕也着实挨了不少。
  贾赦所用武器不详,只出手一次(打贾琏),大约是软兵器,如皮鞭类。
    
  贾珍练习过骑射,但由焦大言,他长于用铲(扒灰)。
  贾琏用剑(要杀凤姐),是摧花剑法。
  贾蓉这四品龙禁卫,却让贾珍令人打嘴巴,所练应该刀枪不入的铁布衫一类。
    
  贾环不争气,学是的妙手空空的,专攻偷。
  宝玉武功现在时兴,是黄飞鸿的“无影脚”,脚踢袭人,后来晴雯点出是窝心腿法,后来出家为僧,应该归入少林派。
  王夫人、凤姐是王家的掌法,凤姐打小道童一掌打翻,功力非凡。王夫人信佛,曾无意说出金刚丸,漏了底细,且后来也打金钏一掌,看来王家是佛门大力金刚掌。
  探春积极向王夫人靠拢,武功也是金刚掌,打王善保家一下真是大快人心。
    
  宝钗是道家功夫,讲守拙,平时绝少显露,唯扑蝶一回,小试扇子功和身法,我们知道她是蝴蝶门。
  黛玉用手帕直打宝玉眼角,准确无误,是流云飞袖一类功夫。
  迎春打的是软绵绵的太极拳,功力弱,伤不了人。
  晴雯武功较杂,撕扇子是鹰爪功,打坠儿却是用的东方不败绣花针法。
  惜春尚小,由画而悟而武,当是用判官笔类兵器。
  贾兰本家武功,骑射。
  妙玉折梅手相当厉害,
  史湘云擅醉拳,却比醉金刚倪二的醉拳好,醉金刚要打贾芸却被人抓牢,可知功力不足。
  宝琴多游历,文学外国诗,武也应该是西洋拳击。
  尤三姐学剑不成,但最后一招“同归于尽”让天地变色


    Ping MM:Request timed out;
    Ping money:Destination unreachable;
    Ping Love:Unkown host name;
    Ping Future:Reply from hell: bytes=32 time=99year TTL=1。

2004年11月03日

DREAMWEAVER MX :   DWW600-54622-26755-01760

FREEHAND 10 中文版:WSW600-59791-91721-99978

FIREWORKS MX :           WSW600-51379-11260-77923

FLASH MX :                       FLW600-59737-74640-92989