巴顿专贴：（第七号）这里回答你的问题，不要你的分！！！

经典问题：
编写多语种的界面，
即同时显示不同的语种以下是有关思路的代码
请讨论：
Option Explicit'PROBLEM: International AND LANGUAGE SUPPORT?'FROM MSDN:'INFO: Microsoft Visual Basic 6.0 International Package and Deployment Kit
'
'--------------------------------------------------------------------------
'The information in this article applies to:
'
'Microsoft Visual Basic Learning, Professional, and Enterprise Editions for
'Windows, version 6.0
'--------------------------------------------------------------------------
'
'
'SUMMARY
'This article contains the information from the Microsoft Visual Basic 6.0
'International Package and Deployment Kit readme.
'
'
'
'Contents
'IPDK Overview
'
'Supported Languages
'
'included Files
'
'System requirements
'
'Download and Installation Instructions
'
'Visual Studio 6.0 Service Pack 3 Required
'
'Incompatibility with Microsoft Office Developer Wizards
'
'Using the IPDK
'
'Deploying and Packaging a Localized Application
'
'Table of Installed Files with End-user Install Paths
'
'Terms of Use
'
'
'
'more Information
'
'IPDK Overview
'The International Package and Deployment Kit (IPDK) is a collection of
'resources and tools that allows developers to produce and distribute
'localized applications using any language version of Visual Basic. It
'includes a set of localized, redistributable files for each supported
'language, localized files for use with the Package and Deployment Wizard
'(PDWizard), and some tools to automatically repackage your application
'into another language and change the Locale ID (LCID) of compiled Visual
'Basic .exe, .dll and .ocx files. See IPDKTool.htm for more information.
'
'The IPDK is designed to solve some of the problems encountered by
'developers who create programs in multiple languages. Even if a program
'is localized, certain error messages and setup dialogs may still appear
'in the same language as the language version of Visual Basic that the
'program was compiled in. One reason is that each language version of
'Visual Basic doesn't ship all the language versions of the Visual Basic
'resources. The second reason is that if you compile any localized
'application on a given language version of Visual Basic, the application
'.exe, .dll, and .ocx files will still call the run-time resources
'corresponding to the language of the compiler. The set of redistributable
'files included in the IPDK provides a solution to fix these issues.
'Supported Languages
'The IPDK supports the following languages:
'English (en)
'German (de)
'French (fr)
'Italian (it)
'Spanish (es)
'Japanese (jp)
'Korean (ko)
'Simplified Chinese(chs)
'Traditional Chinese(cht)
'included Files
'The IPDK consists of:
'Localized satellite .dll files for the VB run-time file.
'Localized Packaging and Deployment Wizard setup files.
'Satellite .dll files for all .ocx controls.
'PdWizloc.exe, a tool to automatically repackage your standard application
'package into another language after localization.
'VBLocal.exe, to view and change the language settings of a compiled
'Visual Basic .exe, .dll and .ocx files.
'System requirements
'The system requirements for the IPDK are:
'
'
'At least 60 MB free disk space for the IPDK files (Visual Basic 6.0
'requires a minimum of 400MB free disk space) if you install core IPDK
'files and all language versions of mdac_typ.exe.
'Visual Studio 6.0 Service Pack 3.
'NOTE: For all other Visual Basic system requirements, see the Before You
'Run Setup section of the Visual Basic Programmer's Guide.
'Download and Installation Instructions
'To install the core IPDK files, download "Ipdk.exe" and follow the
'prompts. Unless otherwise specified, the IPDK files will be installed
'into a new folder called IPDK under the root of the Windows system drive
'(for example, C:\IPDK, if C: is the Windows system drive). Language
'subfolders contain the resources and localized documentation for each
'language. If your application is using mdac_typ.exe, you need to run the
'separate mdac_typ.exe setup programs in order to install any language
'versions of this file you would need at the same location of the core
'IPDK files.
'
'
'Download the IPDK package and any language version of mdac_typ.exe at:
'http://msdn.microsoft.com/vbasic/downloads/ipdk.asp
'Visual Studio 6.0 Service Pack 3 Required
'Visual Studio 6.0 Service Pack 3 must be installed on your computer
'before the IPDK files can be installed. To determine if you have Visual
'Studio 6.0 Service Pack 3 installed on your system, consult the following
'Microsoft Knowledge Base article:
'
'
'Q194295 How To Tell That Visual Studio 6.0 Service Packs Are Installed
'To download the service pack and get more information about Visual Studio,
'see the Microsoft Visual Studio Home Page.
'Incompatibility with Microsoft Office 2000 Developer Wizards
'The Package and Deployment Wizard that ships with Visual Basic cannot be
'used with Microsoft Office 2000 Developer and vice versa. To avoid
'damaging projects created with either environment, only use the version
'of the wizard that came with that product. For example, if you're
'packaging a program in Microsoft Office 2000 Developer, only use the
'wizard that shipped with Microsoft Office 2000 Developer. The IPDK is
'intended for use only with Visual Basic 6.0.
'Using the IPDK
'Using the IPDK involves replacing some Packaging and Deployment Wizard
'setup files, and changing the Locale ID of the .exe, .dll, and .ocx files
'of the compiled Visual Basic application you are localizing. The tools
'delivered with the IPDK automatically perform all these tasks. This
'section describes each step you must take.
'Deploying and Packaging a Localized Application
'Deploying and packaging a localized Visual Basic application with the
'IPDK involves the following steps:
'Localize the user interface portions of the application (contained in the
'.res file) in one or multiple languages and compile these versions using
'your language version of VB. For more information about localization and
'related issues, see the MSDN topic Designing International Software.
'
'
'Run your language version of Package and Deployment Wizard to create
'initial standard package(s) of your localized application(s).
'
'
'Use PDWizLoc.exe to finalize the standard package of each localized
'versions of your application. PDWizloc will automatically add the
'localized satellite files and localized files listed in the table of
'installed files to your package, and change the LCID of the compiled
'Visual Basic application .exe, .dll, and .ocx files to the target
'language LCID (see the LCID list in IPDKTool.htm). PDWizloc can also be
'used to add files that are not part of the IPDK package. For more
'information about using the PDWizloc utility, see IPDKTool.htm (located
'in your IPDK language directory).
'
'NOTE: You don 't need to run PDWizLoc to package your application into
'your own language version of Visual Basic 6.0. PDWizLoc only works on
'Standard packages. PDWizLoc does not support Internet packages.
'For more information about localizing Visual Basic applications, and
'using the Package and Deployment Wizard, consult the following MSDN
'topics:
'Distributing Your Applications
'International issues
'Using Resource Files for Localization
'The Package and Deployment Wizard
'Table of Installed Files with End-user Install Paths
'Please refer to the same section of the downloaded version of this readme
'to obtain this information.
'Terms of Use
'The accompanying software ("Update Software") is provided to you by
'Microsoft to update, supplement, or replace existing functionality of
'Visual Studio or Visual Basic. The Update Software is licensed under the
'same terms and conditions contained in the End User License Agreement
'(EULA) you acquired with Visual Studio or Visual Basic. If you do not
'agree to be bound by the terms of the EULA, you are not authorized to use
'the Update Software. You may have additional rights to distribute certain
'files identified in a "redist.txt" file included with the Update Software.
'By exercising a right, you agree to be bound by the terms described in
'the EULA for "REDISTRIBUTABLE CODE." If you do not agree to the terms
'described in the EULA, you are not authorized to use or redistribute any
'of the files. ? 1999 Microsoft Corporation. All rights reserved. Terms of
'Use.
'
'? 1999 Microsoft Corporation. All rights reserved. Other product and
'company names herein may be the trades of their respective owners.
'
'Additional query words:
'
'Keywords : kbreadme kbsetup kbwizard kbDeployment kbIntl kbVBp600
'kbLocalization kbGrpVB kbDSupport
'Version : WINDOWS:6.0
'Platform:  Windows
'Issue type : kbinfo
'Technology:
'Primary Language   Locale Name                 LCID        Win CP  DOS CP
'Albanian           Albania                     (041c; SQI)
'Basque             Basque                      (042D; EUQ) 1252    850
'Byelorussian       Byelorussia                 (0423, BEL) 1251    866
'Bulgarian          Bulgaria                    (0402, BGR) 1251    866
'Catalan            Catalan                     (0403; CAT) 1252    850
'Croatian           Croatian                    (041a, SHL) 1250    852
'Czech              Czech                       (0405; CSY) 1250    852
'Danish             Danish                      (0406; DAN) 1252    865
'Dutch (2):         Dutch (Standard)            (0413; NLD) 1252    850
'Dutch (2):         Belgian (Flemish)           (0813; NLB) 1252    850
'English (6):       American                    (0409; ENU) 1252    437
'English (6):       British                     (0809; ENG) 1252    850
'English (6):       Australian                  (0c09; ENA) 1252    850
'English (6):       Canadian                    (1009; ENC) 1252    850
'English (6):       New Zealand                 (1409; ENZ) 1252    850
'English (6):       Ireland                     (1809; ENI) 1252    850
'Estonian           Estonia                     (0425, ETI) 1257    775
'Finnish            Finnish                     (040b; FIN) 1252    850
'French             French (Standard)           (040c; FRA) 1252    850
'French             Belgian                     (080c; FRB) 1252    850
'French             Canadian                    (0c0c; FRC) 1252    850
'French             Swiss                       (100c; FRS) 1252    850
'French             Luxembourg                  (140c; FRL) 1252    850
'German             German (Standard)           (0407; DEU) 1252    850
'German             Swiss                       (0807; DES) 1252    850
'German             Austrian                    (0c07; DEA) 1252    850
'German             Luxembourg                  (1007; DEL) 1252    850
'German             Liechtenstein               (1407; DEC) 1252    850
'Greek              Greek                       (0408; ELL) 1253    737 or 8694
'Hungarian          Hungarian                   (040e; HUN) 1250    852
'Icelandic          Icelandic                   (040F; ISL) 1252    850
'Italian (2):       Italian (Standard)          (0410; ITA) 1252    850
'Italian (2):       Swiss                       (0810; ITS) 1252    850
'Latvian            Latvia                      (0426, LVI) 1257    775
'Lithuanian         Lithuania                   (0427, LTH) 1257    775
'Norwegian (2):     Norwegian (Bokmal)          (0414; NOR) 1252    850
'Norwegian (2):     Norwegian (Nynorsk)         (0814; NON) 1252    850
'Polish             Polish                      (0415; PLK) 1250    852
'Portuguese (2):    Portuguese (Brazilian)      (0416; PTB) 1252    850
'Portuguese (2):    Portuguese (Standard)       (0816; PTG) 1252    850
'Romanian (2):      Romania                     (0418, ROM) 1250    852
'Russian            Russian                     (0419; RUS) 1251    866
'Slovak             Slovak                      (041b; SKY) 1250    852
'Slovenian          Slovenia                    (0424, SLV) 1250    852
'Spanish (3):       Spanish (Traditional Sort)  (040a; ESP) 1252    850
'Spanish (3):       Mexican                     (080a; ESM) 1252    850
'Spanish (3):       Spanish (Modern Sort)       (0c0a; ESN) 1252    850
'Swedish            Swedish                     (041D; SVE) 1252    850
'Turkish            Turkish                     (041f; TRK) 1254    857
'Ukrainian          Ukraine                     (0422, UKR) 1251    866'Charset Name       Charset Value(hex)  Codepage number
'------------------------------------------------------
'
'DEFAULT_CHARSET           1 (x01)
'SYMBOL_CHARSET            2 (x02)
'OEM_CHARSET             255 (xFF)
'ANSI_CHARSET              0 (x00)            1252
'RUSSIAN_CHARSET         204 (xCC)            1251
'EE_CHARSET              238 (xEE)            1250
'GREEK_CHARSET           161 (xA1)            1253
'TURKISH_CHARSET         162 (xA2)            1254
'BALTIC_CHARSET          186 (xBA)            1257
'HEBREW_CHARSET          177 (xB1)            1255
'ARABIC _CHARSET         178 (xB2)            1256
'SHIFTJIS_CHARSET        128 (x80)             932
'HANGEUL_CHARSET         129 (x81)             949
'GB2313_CHARSET          134 (x86)             936
'CHINESEBIG5_CHARSET     136 (x88)             950'In Office there is a property of LanguageID, for example:'Sub SetStyleLanguage()
'   Dim oStyle As Style
'   If Documents.Count = 0 Then Exit Sub      ' A document must be open.
'   Application.CheckLanguage = False         ' Turn off LAD.
'   For Each oStyle In ActiveDocument.Styles  ' Change the language for all
'      With oStyle                            ' styles used in the document.
'         .LanguageID = wdFrench
'         .NoProofing = False
'      End With
'   Next
'End Sub'but how we can do in the Visual Basic?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 * 32
End TypePrivate Type DOCINFO
      cbSize As Long
      lpszDocName As String
      lpszOutput As String
      lpszDatatype As String
      fwType As Long
End TypePrivate Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const SYMBOL_CHARSET = 2
Private Const MAC_CHARSET = 77
Private Const SHIFTJIS_CHARSET = 128
Private Const HANGEUL_CHARSET = 129
Private Const HANGUL_CHARSET = 129
Private Const JOHAB_CHARSET = 130
Private Const GB2312_CHARSET = 134
Private Const CHINESEBIG5_CHARSET = 136
Private Const GREEK_CHARSET = 161
Private Const TURKISH_CHARSET = 162
Private Const VIETNAMESE_CHARSET = 163
Private Const HEBREW_CHARSET = 177
Private Const ARABIC_CHARSET = 178
Private Const BALTIC_CHARSET = 186
Private Const RUSSIAN_CHARSET = 204
Private Const THAI_CHARSET = 222
Private Const EASTEUROPE_CHARSET = 238
Private Const OEM_CHARSET = 255'Values to be used with GetSysColor:
Private Const COLOR_BTNFACE = 15
Private Const COLOR_ACTIVEBORDER = 10
Private Const COLOR_ACTIVECAPTION = 2
Private Const COLOR_ADJ_MAX = 100
Private Const COLOR_ADJ_MIN = -100 'shorts
Private Const COLOR_APPWORKSPACE = 12
Private Const COLOR_BACKGROUND = 1
Private Const COLOR_BTNHIGHLIGHT = 20
Private Const COLOR_BTNSHADOW = 16
Private Const COLOR_BTNTEXT = 18
Private Const COLOR_CAPTIONTEXT = 9
Private Const COLOR_GRAYTEXT = 17
Private Const COLOR_HIGHLIGHT = 13
Private Const COLOR_HIGHLIGHTTEXT = 14
Private Const COLOR_INACTIVEBORDER = 11
Private Const COLOR_INACTIVECAPTION = 3
Private Const COLOR_INACTIVECAPTIONTEXT = 19
Private Const COLOR_MENUTEXT = 7
Private Const COLOR_SCROLLBAR = 0
Private Const COLOR_WINDOW = 5
Private Const COLOR_WINDOWFRAME = 6
Private Const COLOR_WINDOWTEXT = 8
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As LongPrivate Declare Function GetThreadLocale Lib "kernel32" () As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
   (ByVal lpLibFileName As String) As Long
Private Declare Function LoadString Lib "user32" Alias "LoadStringA" _
   (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, _
    ByVal nBufferMax As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
   (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _
    ByVal cchData As Long) As Long
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As _
   Long, ByVal x As Long, ByVal y As Long, lpString As Any, _
   ByVal nCount As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) _
   As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
   "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
   ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _
   ByVal crColor As Long) As Long
Private Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) _
   As Long
Private Const LOCALE_IDEFAULTANSICODEPAGE = &H1004&
Private Const LOCALE_SENGCOUNTRY = &H1002
Private Const LOCALE_SNATIVECTRYNAME = &H8
Private Const LOCALE_SCOUNTRY = &H6Private Const THIS_LOCALID = &H408Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
   (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
   ByVal lpOutput As Long, ByVal lpInitData As Long) As Long   Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) _
   As Long      Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" _
   (ByVal hdc As Long, lpdi As DOCINFO) As Long   Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) _
   As Long   Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) _
   As Long   Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) _
   As Long   Const DESIREDFONTSIZE = 12     ' Could use variable, TextBox, etc.   Private Sub Command1_Click()
   ' Combine API Calls with the Printer object
      Dim OutString As String
      Dim lf As LOGFONT
      Dim result As Long
      Dim hOldfont As Long
      Dim hPrintDc As Long
      Dim hFont As Long      Printer.Print "Printer Object"
      hPrintDc = Printer.hdc
      OutString = "Hello World"      lf.lfEscapement = 1800
      lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
      hFont = CreateFontIndirect(lf)
      hOldfont = SelectObject(hPrintDc, hFont)
      result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))
      result = SelectObject(hPrintDc, hOldfont)
      result = DeleteObject(hFont)      Printer.Print "xyz"
      Printer.EndDoc
   End Sub   Private Sub Command2_Click()
   ' Print using API calls only
      Dim OutString As String  'String to be rotated
      Dim lf As LOGFONT        'Structure for setting up rotated font
      Dim temp As String       'Temp string var
      Dim result As Long       'Return value for calling API functions
      Dim hOldfont As Long     'Hold old font information
      Dim hPrintDc As Long     'Handle to printer dc
      Dim hFont As Long        'Handle to new Font
      Dim di As DOCINFO        'Structure for Print Document info      OutString = "Hello World"   'Set string to be rotated   ' Set rotation in tenths of a degree, i.e., 1800 = 180 degrees
      lf.lfEscapement = 1800
      lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
      hFont = CreateFontIndirect(lf)  'Create the rotated font
      di.cbSize = 20                  ' Size of DOCINFO structure
      di.lpszDocName = "My Document" ' Set name of print job (Optional)   ' Create a printer device context
      hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)      result = StartDoc(hPrintDc, di) 'Start a new print document
      result = StartPage(hPrintDc)    'Start a new page   ' Select our rotated font structure and save previous font info
      hOldfont = SelectObject(hPrintDc, hFont)   ' Send rotated text to printer, starting at location 1000, 1000
      result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))   ' Reset font back to original, non-rotated
      result = SelectObject(hPrintDc, hOldfont)   ' Send non-rotated text to printer at same page location
      result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))      result = EndPage(hPrintDc)      'End the page
      result = EndDoc(hPrintDc)       'End the print job
      result = DeleteDC(hPrintDc)     'Delete the printer device context
      result = DeleteObject(hFont)    'Delete the font object
   End Sub   Function GetCharSet(sCdpg As String) As Integer
   Select Case sCdpg
      Case "932" ' Japanese
         GetCharSet = SHIFTJIS_CHARSET
      Case "936" ' Simplified Chinese
         GetCharSet = GB2312_CHARSET
      Case "949" ' Korean
         GetCharSet = HANGEUL_CHARSET
      Case "950" ' Traditional Chinese
         GetCharSet = CHINESEBIG5_CHARSET
      Case "1250" ' Eastern Europe
         GetCharSet = EASTEUROPE_CHARSET
      Case "1251" ' Russian
         GetCharSet = RUSSIAN_CHARSET
      Case "1252" ' Western European Languages
         GetCharSet = ANSI_CHARSET
      Case "1253" ' Greek
         GetCharSet = GREEK_CHARSET
      Case "1254" ' Turkish
         GetCharSet = TURKISH_CHARSET
      Case "1255" ' Hebrew
         GetCharSet = HEBREW_CHARSET
      Case "1256" ' Arabic
         GetCharSet = ARABIC_CHARSET
      Case "1257" ' Baltic
         GetCharSet = BALTIC_CHARSET
      Case Else
         GetCharSet = 0
   End Select
End Function
Function StripNullTerminator(sCP As String)
   Dim posNull As Long
   posNull = InStr(sCP, Chr$(0))
   StripNullTerminator = Left$(sCP, posNull - 1)
End Function
Private Sub Form_Load()
    Command1.Caption = "API with Printer object"
    Command2.Caption = "Pure API"


   Dim hInst As Long, lResult As Long, x As Long
   Dim LCID As Long, sLcid As String
   Dim resString As String * 255
   Dim sCodePage As String   sCodePage = String$(16, " ")
   Label1.AutoSize = True
   Label1.Caption = ""   LCID = GetThreadLocale() 'Get Current locale

   Dim lLocalID As Long

   ' Find the LocalID.
   lLocalID = GetUserDefaultLCID

   '实际上，这两个函数返回是一样的！！！！
   Debug.Assert LCID = lLocalID

   sLcid = Hex$(Trim$(CStr(LCID))) 'Convert to Hex
   ' Display decimal value of the LCID (Hex in Parentheses)
   Form1.Caption = "LCID " & LCID & " (" & sLcid & ")"
   x = GetLocaleInfo(LCID, LOCALE_IDEFAULTANSICODEPAGE, _
       sCodePage, Len(sCodePage))  'Get code page
   sCodePage = StripNullTerminator(sCodePage)
   ' Load dll with string table resource.
   ' Might need to change path for the resdll.
   hInst = LoadLibrary("resdll" & sLcid & ".dll")   ' Get string with ID 101.
   lResult = LoadString(hInst, 101, resString, 255)
   With Label1.font
      .Name = "Lucida Sans Unicode"
      .Size = 14
      .Charset = GetCharSet(sCodePage)  'Convert code page to charset
   End With
   ' Display the localized string.
   Label1.Caption = resString

   With Text1.font
    .Name = "Windings"
    .Charset = SYMBOL_CHARSET
    .Size = 14
   End With

   Dim strShow As String

   strShow = StrConv(Chr(264) & Chr(265) & Chr(284) & Chr(285) & Chr(292) & Chr(293) & Chr(308) & Chr(309) & Chr(348) & Chr(349) & Chr(364) & Chr(365), vbFromUnicode, lLocalID)

   Text1.Text = strShow


    Dim lf As LOGFONT
    Dim chars(257) As Byte
    Dim sysColor As Long
    Dim DispChar As Integer
    Dim NumDispchar As Integer
    Dim prevBkCol As Long
    Dim hFont As Long
    Dim StartASCII As Integer
    Dim StopASCII As Integer
    Dim StartRow As Integer
    Dim NumOfChars As Integer
    Dim i As Integer
    Dim j As Integer
    Dim EndRow As Integer
    Dim NewStart As Integer
    Dim tmp As Integer
    Dim xd As Long
    Dim xt As Long
    Dim xs As Long

    'These are the important settings: lfCharSet and lfFaceName
    lf.lfCharSet = SYMBOL_CHARSET
    lf.lfFaceName = "WingDings" & Chr$(0)    lf.lfClipPrecision = 64
    lf.lfOutPrecision = 0
    lf.lfEscapement = 0
    lf.lfItalic = 0
    lf.lfWidth = 16
    lf.lfHeight = 32
    lf.lfOrientation = 0    Form1.Caption = lf.lfFaceName
    Form1.Refresh
    sysColor = GetSysColor(COLOR_BTNFACE) 'Gets button system color
    prevBkCol = SetBkColor(Pict.hdc, sysColor) 'Set background color
    hFont = CreateFontIndirect(lf)
    xs = SelectObject(Pict.hdc, hFont)    DispChar = 32 'Number of characters to display in a row
    StartASCII = 32 'Starting with character having this ASCII value
    StopASCII = 255 'Ending with this ASCII character
    StartRow = 1    If StartASCII < 0 Then StartASCII = 32
    If StopASCII > 255 Then StopASCII = 255
    If StartASCII > StopASCII Then 'If StartASCII is larger than
                                   'StopASCII swap
       tmp = StartASCII
       StartASCII = StopASCII
       StopASCII = tmp
    End If    NumOfChars = StopASCII - StartASCII + 1    If Int(NumOfChars / DispChar) = (NumOfChars) / DispChar Then
       EndRow = Int(NumOfChars / DispChar)
    Else
       EndRow = Int(NumOfChars / DispChar) + 1
    End If    For i = StartASCII To StopASCII
       chars(i) = i
    Next i    'Display characters on the form in rows containing 32 characters
    For j = StartRow To EndRow
       NewStart = StartASCII + (j - 1) * DispChar       If NumOfChars < DispChar And NumOfChars > 0 Then
          NumDispchar = NumOfChars
       Else
          NumDispchar = DispChar
       End If       xt = TextOut(Pict.hdc, 0, j * lf.lfHeight + 2, _
          chars(NewStart), NumDispchar)
       NumOfChars = NumOfChars - NumDispchar
    Next j    xd = DeleteObject(hFont)
    Form1.Caption = Form1.Caption & "   From " & _
                    StartASCII & " to " & StopASCII


     Dim font As LOGFONT
     Dim prevFont As Long
     'Dim hFont As Long
     Dim ret As Long
     Const FONTSIZE = 10 ' Desired point size of font
     font.lfEscapement = 1800    ' 180-degree rotation
     font.lfFaceName = "Arial" & Chr$(0) 'Null character at end
    ' Windows expects the font size to be in pixels and to
     ' be negative if you are specifying the character height
     ' you want.
     font.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
     hFont = CreateFontIndirect(font)
     prevFont = SelectObject(Pict.hdc, hFont)
     Pict.CurrentX = Pict.ScaleWidth
     Pict.CurrentY = Pict.ScaleHeight / 2
     Pict.Print "Rotated Text"
     ' Clean up by restoring original font.
     ret = SelectObject(Pict.hdc, prevFont)
     ret = DeleteObject(hFont)
     Pict.CurrentY = Pict.ScaleHeight / 2
     Pict.Print StrConv(Chr(264) & Chr(265) & Chr(284) & Chr(285) & Chr(292) & Chr(293) & Chr(308) & Chr(309) & Chr(348) & Chr(349) & Chr(364) & Chr(365), vbFromUnicode, lLocalID)


End Sub
Private Sub SetProperFont(ByVal LCID As Long, obj As Object)
    On Error GoTo ErrorSetProperFont
    Select Case LCID
    Case &H404 ' Traditional Chinese
        obj.Charset = CHINESEBIG5_CHARSET
        obj.Name = ChrW(&H65B0) + ChrW(&H7D30) + ChrW(&H660E) _
         + ChrW(&H9AD4) 'New Ming-Li
        obj.Size = 9
    Case &H411 ' Japan
        obj.Charset = SHIFTJIS_CHARSET
        obj.Name = ChrW(&HFF2D) + ChrW(&HFF33) + ChrW(&H20) + _
         ChrW(&HFF30) + ChrW(&H30B4) + ChrW(&H30B7) + ChrW(&H30C3) + _
         ChrW(&H30AF)
        obj.Size = 9
    Case &H412 'Korea UserLCID
        obj.Charset = HANGEUL_CHARSET
        obj.Name = ChrW(&HAD74) + ChrW(&HB9BC)
        obj.Size = 9
    Case &H804 ' Simplified Chinese
        obj.Charset = CHINESESIMPLIFIED_CHARSET
        obj.Name = ChrW(&H5B8B) + ChrW(&H4F53)
        obj.Size = 9
    Case Else ' The other countries
        obj.Charset = DEFAULT_CHARSET
        obj.Name = "" ' Get the default UI font.
        obj.Size = 8
    End Select
    Exit Sub

ErrorSetProperFont:    Err.Number = Err

End Sub

haisuifeng(海随风)　回复于2002-1-25 18:20:29    得0分
我在用RealAudio打开了一个文件，并且播放了这个文件，
点击一个按钮的同时关闭RealAudio，并且把这个文件copy 到另一个目录下
我用 .dostop 来关闭，但是copy 文件的时候提示：拒绝的权限。
我怀疑是我没有把它个关闭掉，怎样才能把她关闭掉呢？？？？？
我也用过：'RealAudio1.Source = ""
'RealAudio2.Source = ""
'RealAudio1.Console = "close"
'RealAudio2.Console = "close"都还是不行
谢谢！  代码：On error resume next
Do while true
filecopy SrcFile, TagetFile
   if err<>0 then
      Do while Timer()-Ltimer<2
      loop
   else
      exit do
   end if
loop

haisuifeng(海随风)　回复于2002-1-25 18:20:29    得0分
我在用RealAudio打开了一个文件，并且播放了这个文件，
点击一个按钮的同时关闭RealAudio，并且把这个文件copy 到另一个目录下
我用 .dostop 来关闭，但是copy 文件的时候提示：拒绝的权限。
我怀疑是我没有把它个关闭掉，怎样才能把她关闭掉呢？？？？？
我也用过：'RealAudio1.Source = ""
'RealAudio2.Source = ""
'RealAudio1.Console = "close"
'RealAudio2.Console = "close"都还是不行
谢谢！  代码：
Dim Ltime as long
On error resume next
Do while true
filecopy SrcFile, TagetFile
  if err<>0 then
      Ltime=Timer()
      Do while Timer()-Ltime<2
      loop
  else
      exit do
  end if
loop

我在用RealAudio打开了一个文件，并且播放了这个文件，
点击一个按钮的同时关闭RealAudio，并且把这个文件copy 到另一个目录下
我用 .dostop 来关闭，但是copy 文件的时候提示：拒绝的权限。
我怀疑是我没有把它个关闭掉，怎样才能把她关闭掉呢？？？？？
我也用过：'RealAudio1.Source = ""
'RealAudio2.Source = ""
'RealAudio1.Console = "close"
'RealAudio2.Console = "close"都还是不行

本问题的标分已达238分,分五贴,有好意见的热心人可以进入各贴领分...

    http://www.csdn.net/expert/topic/495/495039.shtm
    http://www.csdn.net/expert/topic/497/497597.shtm
    http://www.csdn.net/expert/topic/490/490318.shtm
    http://www.csdn.net/expert/topic/487/487090.shtm
    http://www.csdn.net/expert/topic/497/497640.shtm

请看那种坑人的回答：http://www.csdn.net/Expert/topic/499/499071.shtm

主　　题：CSDN需要这样的高手吗？
作　　者：Bardo
所属论坛：Visual Basic
问题点数：20
回复次数：33
发表时间：2002-1-24 13:15:23


  http://www.csdn.net/Expert/topic/495/495942.shtm
http://www.csdn.net/Expert/topic/495/495711.shtm
http://www.csdn.net/Expert/topic/495/495527.shtm
回复贴子：
回复人：　liuqiao_lq(坐看云起时)　(2002-1-24 13:16:09)  得0分
强烈关注！！！
回复人：　ferrytang(楼上的你悠着点!!!)　(2002-1-24 13:17:11)  得0分
路过~~~~~~~~~~~~~
回复人：　uguess(uguess)　(2002-1-24 13:17:40)  得0分   希望他能像他说得做！不过，别指望了...
回复人：　Bardo(巴顿)　(2002-1-24 13:30:19)  得0分
最新参考：
抄给别人也不负责！！！！
请看：
http://www.csdn.net/Expert/topic/495/495977.shtm

回复人：　Bardo(巴顿)　(2002-1-24 13:33:43)  得0分
最新参考：http://www.csdn.net/expert/Topic/496/496095.shtm
回复人：　lihonggen0(用VB)　(2002-1-24 13:35:08)  得0分
强烈关注！！！
回复人：　Bardo(巴顿)　(2002-1-24 13:39:09)  得0分
这儿还有，答案都有了，
某些人居然写道：
http://www.csdn.net/expert/topic/490/490774.shtm
回复人：　dbcontrols(泰山____我讨厌这里的版主给别人结贴)　(2002-1-22 12:21:29)  得0分
对不起，尽管我很想回答你的问题，但我要离开这里了，看看
http://www.csdn.net/Expert/topic/490/490851.shtm
就知道为什么了。
如果要找我，请到
http://www.d1vb.com
回复人：　xxlroad(土八路)　(2002-1-24 13:40:15)  得0分
错误不可避免
但是不能有太多的错误回答别人的问题：
应该在自己的机器上是可以的这样就无愧了
回复人：　dbcontrols(泰山__帮助你使我感到快乐.)　(2002-1-24 13:41:32)  得0分
Bardo(巴顿)
没用的，我绝对不走，尽管不是什么高手，哈哈哈哈气死活该！
回复人：　Bardo(巴顿)　(2002-1-24 13:42:22)  得0分
还有：http://www.csdn.net/expert/topic/481/481052.shtm请所有的人都好好看看……

回复人：　dbcontrols(泰山__帮助你使我感到快乐.)　(2002-1-24 13:43:45)  得0分
同意xxlroad(土八路)

回复人：　dbcontrols(泰山__帮助你使我感到快乐.)　(2002-1-24 13:47:10)  得0分
Bardo(巴顿):送你几个字：
气急败坏，恼羞成怒
回复人：　Bardo(巴顿)　(2002-1-24 13:47:10)  得0分
我已经不想再收集了，简直恶心透顶！
各位同仁，我们的任务是改错，还是回答问题？
如果你们需要误导，那就算了！请大家给一个响应！
回复人：　Bardo(巴顿)　(2002-1-24 13:48:43)  得0分
我心似明镜！不过，现在这儿阴气太旺！
回复人：　chsl918(二雷)　(2002-1-24 13:54:35)  得0分
我个人认为人都是没有完人的！
毛主席还犯错误那！但是毛主席对中国的贡献不能因为那些错误而全部抹去啊！！
我认为dbcontrols(泰山__帮助你使我感到快乐.)确实有不好的做法，但是他还是有贡献的啊！！比如刚刚那个XOR错误问题的泰山解释就特别快！！
有句老话：水清则无鱼。
我想这些问题毕竟不是阶级斗争问题，还是属于人民内部矛盾的！
以上观点望采纳！
回复人：　chsl918(二雷)　(2002-1-24 13:56:45)  得0分
另外Bardo(巴顿)的技术真是没话说！而且打字速度真是不可想象！！
TO：Bardo(巴顿)你有没有缺点？难道是神仙下凡？佩服
回复人：　dbcontrols(泰山__帮助你使我感到快乐.)　(2002-1-24 13:57:02)  得0分
chsl918(二雷)：握个手！
回复人：　Bardo(巴顿)　(2002-1-24 13:58:32)  得0分
既然大家都需要误导，算了！
好好看看吧：
http://www.csdn.net/Expert/topic/492/492044.shtm
http://www.csdn.net/Expert/topic/495/495942.shtm
http://www.csdn.net/Expert/topic/495/495711.shtm
http://www.csdn.net/Expert/topic/495/495527.shtm
http://www.csdn.net/Expert/topic/495/495977.shtm
http://www.csdn.net/expert/Topic/496/496095.shtm
http://www.csdn.net/expert/topic/490/490774.shtm
http://www.csdn.net/expert/topic/481/481052.shtm……………………
……………………
……………………
……………………
回复人：　chsl918(二雷)　(2002-1-24 13:59:06)  得0分
TO:dbcontrols(泰山__帮助你使我感到快乐.)　
毕竟都是同志，少说两句得了，你又不吃亏何必呢！！？
回复人：　wgku(云霄)　(2002-1-24 14:00:26)  得0分
巴顿，你是真材实料的！！！：）

回复人：　chsl918(二雷)　(2002-1-24 14:02:35)  得0分
同意楼上！！（我从来不拍马屁的，要不然就不会现在... ...）

回复人：　wgku(云霄)　(2002-1-24 14:02:53)  得0分
泰山:"帮助你使我感到快乐" me too
你们俩之间可真复杂。
原大家多一分宽容，少一分烦恼！！！
回复人：　chsl918(二雷)　(2002-1-24 14:04:38)  得0分
TO:wgku(wgku)握个手！

回复人：　chsl918(二雷)　(2002-1-24 14:05:59)  得0分
退一步海阔天空，忍一时风平浪静！！

回复人：　wgku(云霄)　(2002-1-24 14:06:16)  得0分
泰山，我的EMAIL你还没给发呢：）
你在这答应我的：（  -》 http://www.csdn.net/expert/topic/492/492651.shtm
回复人：　wgku(云霄)　(2002-1-24 14:10:30)  得0分
TOchsl918(二雷)：好的：）
回复人：　Bardo(巴顿)　(2002-1-24 19:41:58)  得0分
请参加：
http://www.csdn.net/expert/topic/496/496906.shtm
谢了！谢了！谢了！谢了！谢了！谢了！谢了！谢了！谢了！
回复人：　Bardo(巴顿)　(2002-1-24 22:29:34)  得0分
主　　题：想念CSDN的磨牙茶社~~~~~~~
作　　者：luocc
所属论坛：Visual Basic
问题点数：0
回复次数：5
发表时间：2002-1-24 11:08:35
  好想念CSDN的磨牙茶社呀，阿木，老山，老妖，吴文智，你们在不在呀？好久都不见你们浮头了~~~~~~~~
回复贴子：
回复人：　uguess(uguess)　(2002-1-24 11:11:48)  得0分   对对，没想到还有人记得！～
  他们好像都转到军营去了。回复人：　Jneu(沧海桑田)　(2002-1-24 11:13:01)  得0分
吴文智,老山，包香都让dbcontrols
给气跑了～，接下来又不知道轮到谁了呢？
回复人：　Jneu(沧海桑田)　(2002-1-24 11:26:14)  得0分
欢迎到军营(www.jinesc.com)看看～
回复人：　luocc(罗)　(2002-1-24 11:27:38)  得0分
to Jneu(沧海桑田)：气跑了？不是吧~~~~~，知道去哪里找他们吗？
to uguess(uguess):我当然记得了，可惜~~~~~~~~~~，可恶的dbcontrols!!!
这儿高手越来越少啦了~~~~~~~~~回复人：　Jneu(沧海桑田)　(2002-1-24 11:32:36)  得0分
主　　题：dbcontrols终于要走了～
★baoxiang★ 星期六上校 ¦ 回复时间：2002-1-22 -13:54:57    LAUGH
这个混蛋终于滚了。
看来我要考虑是不是回去看看。
回复人：　Bardo(巴顿)　(2002-1-24 22:29:39)  得0分
主　　题：想念CSDN的磨牙茶社~~~~~~~
作　　者：luocc
所属论坛：Visual Basic
问题点数：0
回复次数：5
发表时间：2002-1-24 11:08:35
  好想念CSDN的磨牙茶社呀，阿木，老山，老妖，吴文智，你们在不在呀？好久都不见你们浮头了~~~~~~~~
回复贴子：
回复人：　uguess(uguess)　(2002-1-24 11:11:48)  得0分   对对，没想到还有人记得！～
  他们好像都转到军营去了。回复人：　Jneu(沧海桑田)　(2002-1-24 11:13:01)  得0分
吴文智,老山，包香都让dbcontrols
给气跑了～，接下来又不知道轮到谁了呢？
回复人：　Jneu(沧海桑田)　(2002-1-24 11:26:14)  得0分
欢迎到军营(www.jinesc.com)看看～
回复人：　luocc(罗)　(2002-1-24 11:27:38)  得0分
to Jneu(沧海桑田)：气跑了？不是吧~~~~~，知道去哪里找他们吗？
to uguess(uguess):我当然记得了，可惜~~~~~~~~~~，可恶的dbcontrols!!!
这儿高手越来越少啦了~~~~~~~~~回复人：　Jneu(沧海桑田)　(2002-1-24 11:32:36)  得0分
主　　题：dbcontrols终于要走了～
★baoxiang★ 星期六上校 ¦ 回复时间：2002-1-22 -13:54:57    LAUGH
这个混蛋终于滚了。
看来我要考虑是不是回去看看。

本问题的标分已达238分,分五贴,有好意见的热心人可以进入各贴领分...

    http://www.csdn.net/expert/topic/495/495039.shtm
    http://www.csdn.net/expert/topic/497/497597.shtm
    http://www.csdn.net/expert/topic/490/490318.shtm
    http://www.csdn.net/expert/topic/487/487090.shtm
    http://www.csdn.net/expert/topic/497/497640.shtm

请问：
SQL中有自动编号的功能吗？像ACCESS一样

回复人：　MarGo(马舸)　(2002-1-25 19:28:24)
===========================================
好人做到底，请问如何实现？

回复人：　ivt(依纹)　(2002-1-25 19:46:31) 得0分
回复人：　MarGo(马舸)　(2002-1-25 19:28:24)
===========================================
好人做到底，请问如何实现？字段属性
设为主健
然后
识别种子：1

回复人：　Bardo(巴顿)　(2002-1-25 19:56:03)  得0分
回复人：　ivt(依纹)　(2002-1-25 19:46:31)  得0分
回复人：　MarGo(马舸)　(2002-1-25 19:28:24)
===========================================
好人做到底，请问如何实现？  字段属性
设为主健
然后
识别种子：1
===========================
识别种子：1
===========================
我找不到在哪里，请再指点好吗？

CREATE TABLE [dbo].[dwb] ([id] [int] IDENTITY (1, 1) NOT NULL ,
           [dwmc] [varchar] (20) NOT NULL
           [khh] [varchar] (30) NOT NULL )
运行一下，就知道了

急待解决中............
'--------------------------------------------------------------------------------------
主　　题：续"用MSCOMM挂断计算机-MODEM-MODEM-单片机连接的方法"(今天分用完了,改天一定补)..
作　　者：jessezappy
所属论坛：网络/通讯
问题点数：5
回复次数：4
发表时间：2002-1-25 2:58:16


  今天有了新的发现比较高兴,所以我又回来了.不好意思.^_^...为了大家方便帮忙,所以说的详细一点:
    我用计算机-MODEM连接一个子站的MODEM-单片机(ESC的8800数据采集器),连接收数据都可以,不过如果电脑用内猫或新一点的外猫连接,那么可以很简单的用 .PortOpen = False 挂断连接,而用"U.S. Robotics 33.6K FAX EXT"这个型号的外猫连接电脑时,只能接通并正常收数据,要挂断就不行(今天的新发现是:用ESC原配的软件就可以,他的软件是用VB4写的,而且他也是用了MSCOMM控件来实现,这一点我打开它的可执行文件搜索过,发现他调用了MSCOMM.VBX,所以我暂时不研究TAPI32.DLL,先来研究MSCOMM).我推测问题可能出在:
    1.我的MODEM初始化可能不对,下面是我的MODEM初始化字串:
      MSComm1.Settings = "9600,N,8,1"  '这句没问题
      MSComm1.PortOpen = True          '这句没问题
      '---------初始化Modem-------------
      MSComm1.Output = "ATZ"
      MSComm1.Output = "AT&F"
      MSComm1.Output = "ATE0"
      MSComm1.Output = "ATM1"
      MSComm1.Output = "ATQ0"
      MSComm1.Output = "ATV0"
    2.要不就是我的挂断方法不对:
      MSComm1.PortOpen = False  请各位帮忙看看,如何挂断?(不是VB的也行)

先谢了！
我想在控件中增加DataSource的属性，然后在使用该控件时可以将recordset或DataEnvironment传递给DataSource，然后在控件中对数据进行操作，不知应该怎样操作（给提点建议，最好有代码）？（就象datagrid的datasource的属性）

回复人：　honey(边城浪子)　(2002-1-25 21:13:21) 得0分
我想问问QQ密码窃取器的原理！请赐教！这个问题，我不可能回答！

breadjyh(新小鱼)　回复于2002-1-25 21:04:32    得0分
先谢了！
我想在控件中增加DataSource的属性，然后在使用该控件时可以将recordset或DataEnvironment传递给DataSource，然后在控件中对数据进行操作，不知应该怎样操作（给提点建议，最好有代码）？（就象datagrid的datasource的属性）  你可以参考一下MSDN如何设置Picture与Font属性，因为这些都是对象属性
代码我没有现成的，对控件而言，更没有通用的。所以，抱歉！
jessezappy(晶晶)　回复于2002-1-25 21:02:04   你挂断时为什么不先发AT指令？

我在Unload事件中用了end 语句，可是内存中还是在运行，用Unloda me
end
还是不行

巴顿，下面的代码有何错误，我装的是windows 2000/98双系统，在不同的操作系统得到的结果不同，问题出在那里？Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As LongPublic Function GetDiskSpace(ByVal Path As String) As long
Dim aa As Long, SecPerClust As Long, BytePerSec As Long, FreeClust As Long, totClust As Long
aa = GetDiskFreeSpace(Path, SecPerClust, BytePerSec, FreeClust, totClust)
GetTotalSpace = SecPerClust * BytePerSec * totClust
End Function
问题不是出在最后的乘法运算，而是GetDiskFreeSpace得出的SecPerClust和totClust在98和2000下的值不同，真是奇怪。

回复人：　qhzxcz(audio)　(2002-1-25 21:38:50)  得0分
我在Unload事件中用了end 语句，可是内存中还是在运行，用Unloda me
                                                        end
    还是不行
在此语句前设断点
查看堆贱，看清有多少需要释放的
在断点前写
Set 未释放 = nothing
回复人：　egrid()　(2002-1-25 21:42:54)  得0分
巴顿，下面的代码有何错误，我装的是windows 2000/98双系统，在不同的操作系统得到的结果不同，问题出在那里？Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As LongPublic Function GetDiskSpace(ByVal Path As String) As long
Dim aa As Long, SecPerClust As Long, BytePerSec As Long, FreeClust As Long, totClust As Long
aa = GetDiskFreeSpace(Path, SecPerClust, BytePerSec, FreeClust, totClust)
GetTotalSpace = SecPerClust * BytePerSec * totClust
End Function
Try to:
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
    Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Currency, _
    lpTotalNumberOfBytes As Currency, _
    lpTotalNumberOfFreeBytes As Currency) As LongPrivate Sub Form_Click()
    Dim Status As Long
    Dim TotalBytes As Currency
    Dim FreeBytes As Currency
    Dim BytesAvailableToCaller As Currency

    Status = GetDiskFreeSpaceEx(Text1.Text, BytesAvailableToCaller, _
      TotalBytes, FreeBytes)
    If Status <> 0 Then
        MsgBox Format(TotalBytes * 10000, "#,##0"), , "Total Bytes"
        MsgBox Format(FreeBytes * 10000, "#,##0"), , "Free Bytes"
        MsgBox Format(BytesAvailableToCaller * 10000, "#,##0"), , _
          "Bytes Available To Caller"
    End If
End Sub
问题不是出在最后的乘法运算，而是GetDiskFreeSpace得出的SecPerClust和totClust在98和2000下的值不同，真是奇怪。

:巴顿请看
我用setwindowshookex做个一个WH_CALLWNDPROC的钩子，我希望是截取自己屏幕上的消息
自己来控制
比如说textbox,用鼠标右点击，会出现菜单，hook 这个textbox控件的确可以把这个消息吃掉
但是这样的控件很多，textbox,commandbutton,等等等，如果都来做简单的hook，肯定很累，所以我想用更好的钩子
我已经用过了wh_mouse鼠标钩子，的确截获了鼠标的消息，但是我吃不掉它，为什么？
怎么样实现我的想法，如果要用子类，要求只能针对窗体，不能逐个控件都来子类
谢谢，期待你的回音

回复人：　superlight()　(2002-1-25 22:36:24) 得0分
:巴顿请看
我用setwindowshookex做个一个WH_CALLWNDPROC的钩子，我希望是截取自己屏幕上的消息
自己来控制
比如说textbox,用鼠标右点击，会出现菜单，hook 这个textbox控件的确可以把这个消息吃掉
但是这样的控件很多，textbox,commandbutton,等等等，如果都来做简单的hook，肯定很累，所以我想用更好的钩子
我已经用过了wh_mouse鼠标钩子，的确截获了鼠标的消息，但是我吃不掉它，为什么？
怎么样实现我的想法，如果要用子类，要求只能针对窗体，不能逐个控件都来子类
谢谢，期待你的回音我没有好办法！
你可以参照向导中生成的为窗体加载资源的函数LoadResStrings,注意，不是原函数LoadResString，用这个方式法进行挂钩或许好一点！

问题一：我的一个VB程序用到大量图片(界面要求)，问题是当系统在显示属性里改变字体大小为大字体(120dpi)时，程序的图片位置错位，非常难看！怎样解决？问题二：现有一word(或RTF)文档模板，要求根据用户在wizard中作的选择和输入，在模板中特定位置进行插入用户输入的句子，及将用户的选择，进行字体变化。怎样实现最好？请指教，谢谢

补充：问题一http://www.csdn.net/Expert/topic/497/497652.shtm
问题二http://www.csdn.net/Expert/topic/497/497654.shtm
谢谢

问题一：我的一个VB程序用到大量图片(界面要求)，问题是当系统在显示属性里改变字体大小为大字体(120dpi)时，程序的图片位置错位，非常难看！怎样解决？
你可以参照向导中生成的为窗体加载资源的函数LoadResStrings,注意，不是原函数LoadResString，初始控件字体！
即不用缺省字体！问题二：现有一word(或RTF)文档模板，要求根据用户在wizard中作的选择和输入，在模板中特定位置进行插入用户输入的句子，及将用户的选择，进行字体变化。怎样实现最好？这个问题请到VBA找沧海桑田版主，因为我对VBA不是很懂！

调试易

巴顿专贴：（第七号）这里回答你的问题，不要你的分！！！

解决方案 »