home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Disk_Data_2224916142012.psc / clsKeyEdit.cls < prev   
Text File  |  2012-06-14  |  7KB  |  163 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cKeyEdit"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. ' ***************************************************************************
  17. ' Module:        cKeyEdit
  18. '
  19. ' Description:   These are the common edit routines you will find in most
  20. '                word processors.  (Copy, Cut, Paste)
  21. '
  22. ' ===========================================================================
  23. '    DATE      NAME / DESCRIPTION
  24. ' -----------  --------------------------------------------------------------
  25. ' 02-JUL-1998  Kenneth Ives  kenaso@tx.rr.com
  26. '              Wrote module
  27. ' 11-Jan-2009  Kenneth Ives  kenaso@tx.rr.com
  28. '              Updated ProcessNumericOnly() routine flower box with an
  29. '              additional code suggestion.
  30. ' 20-Dec-2010  Kenneth Ives  kenaso@tx.rr.com
  31. '              - Major update to CenterCaption() routine.
  32. '              - Changed ErrorMsg call to InfoMsg call in CenterCaption()
  33. '                and CenterReportText() routines.
  34. ' 25-Dec-2010  Kenneth Ives  kenaso@tx.rr.com
  35. '              Rewrote CenterReportText() routine.
  36. ' 18-Feb-2011  Kenneth Ives  kenaso@tx.rr.com
  37. '              Added NoCopyText() routine.
  38. ' 16-Mar-2011  Kenneth Ives  kenaso@tx.rr.com
  39. '              Updated CenterReportText() routine
  40. ' 10-Jul-2011  Kenneth Ives  kenaso@tx.rr.com
  41. '              Fixed a bug in CenterCaption() routine.
  42. ' 02-Oct-2011  Kenneth Ives  kenaso@tx.rr.com
  43. '              Fixed minor bugs.  See ProcessNumericOnly() and
  44. '              ProcessAlphaNumeric() routines.
  45. ' ***************************************************************************
  46. Option Explicit
  47.   
  48. ' ***************************************************************************
  49. ' Constants
  50. ' ***************************************************************************
  51.   Private Const MODULE_NAME             As String = "clsKeyEdit"
  52.   Private Const SPI_GETNONCLIENTMETRICS As Long = 41
  53.   Private Const LOGPIXELSY              As Long = 90
  54.  
  55. ' ***************************************************************************
  56. ' Type structures
  57. ' ***************************************************************************
  58.   Private Type LogFont
  59.       FontHeight          As Long
  60.       FontWidth           As Long
  61.       FontEscapement      As Long
  62.       FontOrientation     As Long
  63.       FontWeight          As Long
  64.       FontItalic          As Byte
  65.       FontUnderline       As Byte
  66.       FontStrikeOut       As Byte
  67.       FontCharSet         As Byte
  68.       FontOutPrecision    As Byte
  69.       FontClipPrecision   As Byte
  70.       FontQuality         As Byte
  71.       FontPitchAndFamily  As Byte
  72.       FontFaceName        As String * 32
  73.   End Type
  74.  
  75.   Private Type NONCLIENTMETRICS
  76.       cbSize              As Long
  77.       iBorderWidth        As Long
  78.       iScrollWidth        As Long
  79.       iScrollHeight       As Long
  80.       iCaptionWidth       As Long
  81.       iCaptionHeight      As Long
  82.       LFCaptionFont       As LogFont
  83.       iSMCaptionWidth     As Long
  84.       iSMCaptionHeight    As Long
  85.       LFSMCaptionFont     As LogFont
  86.       iMenuWidth          As Long
  87.       iMenuHeight         As Long
  88.       LFMenuFont          As LogFont
  89.       LFStatusFont        As LogFont
  90.       LFMessageFont       As LogFont
  91.   End Type
  92.  
  93. ' ***************************************************************************
  94. ' API Declares
  95. ' ***************************************************************************
  96.   ' The GetSystemMetrics function retrieves various system metrics and
  97.   ' system configuration settings.  System metrics are the dimensions
  98.   ' (widths and heights) of Windows display elements. All dimensions
  99.   ' retrieved by GetSystemMetrics are in pixels.
  100.   Private Declare Function GetSystemMetrics Lib "user32" _
  101.           (ByVal nIndex As Long) As Long
  102.  
  103.   ' The GetDeviceCaps function retrieves device-specific information
  104.   ' about a specified device.
  105.   Private Declare Function GetDeviceCaps Lib "gdi32" _
  106.           (ByVal hDC As Long, ByVal nIndex As Long) As Long
  107.  
  108.   ' The SystemParametersInfo function queries or sets systemwide
  109.   ' parameters. This function can also update the user profile while
  110.   ' setting a parameter.  This function is intended for use with
  111.   ' applications, such as Control Panel, that allow the user to
  112.   ' customize the Windows environment.
  113.   Private Declare Function SystemParametersInfo Lib "user32" _
  114.           Alias "SystemParametersInfoA" (ByVal uAction As Long, _
  115.           ByVal uParam As Long, lpvParam As Any, _
  116.           ByVal fuWinIni As Long) As Long
  117.  
  118.   ' ZeroMemory is used for clearing contents of a type structure.
  119.   Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" _
  120.           (Destination As Any, ByVal Length As Long)
  121.  
  122.  
  123. ' ***************************************************************************
  124. ' ****                      Methods                                      ****
  125. ' ***************************************************************************
  126.  
  127. ' ***************************************************************************
  128. ' Routine:       CenterCaption
  129. '
  130. ' Description:   Centers a caption on a form.
  131. '
  132. ' Parameters:    frmForm - Name of form whose caption is to be centered
  133. '
  134. ' ===========================================================================
  135. '    DATE      NAME / DESCRIPTION
  136. ' -----------  --------------------------------------------------------------
  137. ' 17-OCT-2000  Tom Pydeski
  138. '              http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=12103&lngWId=1
  139. ' 20-Dec-2010  Kenneth Ives  kenaso@tx.rr.com
  140. '              Modified and documented
  141. ' 10-Jul-2011  Kenneth Ives  kenaso@tx.rr.com
  142. '              Exit routine if form caption is empty.
  143. ' ***************************************************************************
  144. Public Sub CenterCaption(ByRef frmForm As Form)
  145.                     
  146.     Dim strCaption      As String
  147.     Dim lngTwips        As Long
  148.     Dim lngCtrlBox      As Long
  149.     Dim lngTbarWidth    As Long
  150.     Dim lngTbarHeight   As Long
  151.     Dim lngCaptionWidth As Long
  152.     
  153.     On Error GoTo CenterCaption_Error
  154.        
  155.     Set frmForm.Font = GetTitleFont(frmForm)  ' Get font information
  156.     strCaption = TrimStr(frmForm.Caption)     ' Capture form caption
  157.     
  158.     ' If no caption then leave
  159.     If Len(strCaption) = 0 Then
  160.         Exit Sub
  161.     End If
  162.     
  163.     lngTbarHeight = GetSystemMetrics(4) * Screen.TwipsPerPixelX   ' height of window