home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Final_-_vh207433772007.psc / clsAdvancedEdit.cls < prev    next >
Text File  |  2007-03-13  |  36KB  |  1,021 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 = "clsAdvancedEdit"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15.  
  16. Implements GXISubclass
  17.  
  18.  
  19. Private Const HDS_FLAT                          As Long = &H200
  20.  
  21. Private Const NM_FIRST                          As Long = &HFFFF + 1
  22.  
  23. Private Const SWP_SHOWWINDOW                    As Long = &H40
  24.  
  25. Private Const WS_OVERLAPPED                     As Long = &H0
  26. Private Const WS_CLIPSIBLINGS                   As Long = &H4000000
  27. Private Const WS_CAPTION                        As Long = &HC00000
  28. Private Const WS_SYSMENU                        As Long = &H80000
  29. Private Const WS_THICKFRAME                     As Long = &H40000
  30. Private Const WS_MINIMIZEBOX                    As Long = &H20000
  31. Private Const WS_MAXIMIZEBOX                    As Long = &H10000
  32. Private Const WS_CLIPCHILDREN                   As Long = &H2000000
  33.  
  34. Private Const WS_EX_TOOLWINDOW                  As Long = &H80
  35. Private Const WS_EX_RTLREADING                  As Long = &H2000
  36.  
  37. Private Const CLRYELLOW = "&H00FFFF &H00F0F0 &H00E1E1 &H00D2D2 &H00C3C3 &H00B4B4 &H00A5A5 &H009696 &H008787 &H007878 &H006969" & _
  38.                         " &H9CFFFF &H8DF0F0 &H7EE1E1 &H6FD2D2 &H60C3C3 &H51B4B4 &H42A5A5 &H339696 &H248787 &H157878 &H066969" & _
  39.                         " &HD2FFFF &HC3F0F0 &HB4E1E1 &HA5D2D2 &H96C3C3 &H87B4B4 &H78A5A5 &H699696 &H5A8787 &H4B7878 &H3C6969" & _
  40.                         " &HEBFFFF &HDCF0F0 &HCDE1E1 &HBED2D2 &HAFC3C3 &HA0B4B4 &H91A5A5 &H829696 &H738787 &H647878 &H556969"
  41. Private Const CLRMAGENTA = "&HFF00FF &HF000F0 &HE100E1 &HD200D2 &HC300C3 &HB400B4 &HA500A5 &H960096 &H870087 &H780078 &H690069" & _
  42.                         " &HFF9CFF &HF08DF0 &HE17EE1 &HD26FD2 &HC360C3 &HB451B4 &HA542A5 &H963396 &H872487 &H781578 &H690669" & _
  43.                         " &HFFD2FF &HF0C3F0 &HE1B4E1 &HD2A5D2 &HC396C3 &HB487B4 &HA578A5 &H966996 &H875A87 &H784B78 &H693C69" & _
  44.                         " &HFFEBFF &HF0DCF0 &HE1CDE1 &HD2BED2 &HC3AFC3 &HB4A0B4 &HA591A5 &H968296 &H877387 &H786478 &H695569"
  45. Private Const CLRCYAN = "&HFFFF00 &HF0F000 &HE1E100 &HD2D200 &HC3C300 &HB4B400 &HA5A500 &H969600 &H878700 &H787800 &H696900" & _
  46.                         " &HFFFF9C &HF0F08D &HE1E17E &HD2D26F &HC3C360 &HB4B451 &HA5A542 &H969633 &H878724 &H787815 &H696906" & _
  47.                         " &HFFFFD2 &HF0F0C3 &HE1E1B4 &HD2D2A5 &HC3C396 &HB4B487 &HA5A578 &H969669 &H87875A &H78784B &H69693C" & _
  48.                         " &HFFFFEB &HF0F0DC &HE1E1CD &HD2D2BE &HC3C3AF &HB4B4A0 &HA5A591 &H969682 &H878773 &H787864 &H696955"
  49. Private Const CLRBLUE = "&HFF0000 &HF00000 &HE10000 &HD20000 &HC30000 &HB40000 &HA50000 &H960000 &H870000 &H780000 &H690000" & _
  50.                         " &HFF9C9C &HF08D8D &HE17E7E &HD26F6F &HC36060 &HB45151 &HA54242 &H963333 &H872424 &H781515 &H690606" & _
  51.                         " &HFFD2D2 &HF0C3C3 &HE1B4B4 &HD2A5A5 &HC39696 &HB48787 &HA57878 &H966969 &H875A5A &H784B4B &H963C3C" & _
  52.                         " &HFFEBEB &HF0DCDC &HE1CDCD &HD2BEBE &HC3AFAF &HB4A0A0 &HA59191 &H968282 &H877373 &H786464 &H695555"
  53. Private Const CLRRED = "&H0000FF &H0000F0 &H0000E1 &H0000D2 &H0000C3 &H0000B4 &H0000A5 &H000096 &H000087 &H000078 &H000069" & _
  54.                         " &H9C9CFF &H8D8DF0 &H7E7EE1 &H6F6FD2 &H6060C3 &H5151B4 &H4242A5 &H333396 &H242487 &H151578 &H060669" & _
  55.                         " &HD2D2FF &HC3C3F0 &HB4B4E1 &HA5A5D2 &H9696C3 &H8787B4 &H7878A5 &H696996 &H5A5A87 &H4B4B78 &H3C3C69" & _
  56.                         " &HEBEBFF &HDCDCF0 &HCDCDE1 &HBEBED2 &HAFAFC3 &HA0A0B4 &H9191A5 &H828296 &H737387 &H646478 &H555569"
  57. Private Const CLRGREEN = "&H00FF00 &H00F000 &H00E100 &H00D200 &H00C300 &H00B400 &H00A500 &H009600 &H008700 &H007800 &H006900" & _
  58.                         " &H9CFF9C &H8DF08D &H7EE17E &H6FD26F &H60C360 &H51B451 &H42A542 &H339633 &H248724 &H157815 &H066906" & _
  59.                         " &HD2FFD2 &HC3F0C3 &HB4E1B4 &HA5D2A5 &H96C396 &H87B487 &H78A578 &H699669 &H5A875A &H4B784B &H3C693C" & _
  60.                         " &HEBFFEB &HDCF0DC &HCDE1CD &HBED2BE &HAFC3AF &HA0B4A0 &H91A591 &H829682 &H738773 &H647864 &H556955"
  61. Private Const CLRGREY = "&HD2D2D2 &HC3C3C3 &HB4B4B4 &HA5A5A5 &H969696 &H878787 &H787878 &H696969 &H5A5A5A &H4B4B4B &H3C3C3C" & _
  62.                         " &HEBEBEB &HDCDCDC &HCDCDCD &HBEBEBE &HAFAFAF &HA0A0A0 &H919191 &H828282 &H737373 &H646464 &H555555" & _
  63.                         " &HFAFAFA &HEBEBEB &HDCDCDC &HCDCDCD &HBEBEBE &HAFAFAF &HA0A0A0 &H919191 &H828282 &H737373 &H646464"
  64.  
  65.  
  66.  
  67. Public Enum ECAThemeStyle
  68.     ecaAzure = 0&
  69.     ecaClassic = 1&
  70.     ecaGloss = 2&
  71.     ecaMetal = 3&
  72.     ecaXp = 4&
  73. End Enum
  74.  
  75. Public Enum EIAImageType
  76.     eiaBitmap = 0&
  77.     eiaIcon = 1&
  78.     eiaCursor = 2&
  79.     eiaMetafile = 3&
  80. End Enum
  81.  
  82. Private Type RECT
  83.     left                                        As Long
  84.     top                                         As Long
  85.     Right                                       As Long
  86.     Bottom                                      As Long
  87. End Type
  88.  
  89. Private Type VERSIONINFO
  90.     dwOSVersionInfoSize                         As Long
  91.     dwMajorVersion                              As Long
  92.     dwMinorVersion                              As Long
  93.     dwBuildNumber                               As Long
  94.     dwPlatformId                                As Long
  95.     szCSDVersion                                As String * 128
  96. End Type
  97.  
  98.  
  99. Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersion As VERSIONINFO) As Long
  100.  
  101. Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, _
  102.                                                        ByVal lpClassName As String, _
  103.                                                        ByVal lpWindowName As String, _
  104.                                                        ByVal dwStyle As Long, _
  105.                                                        ByVal x As Long, _
  106.                                                        ByVal y As Long, _
  107.                                                        ByVal nWidth As Long, _
  108.                                                        ByVal nHeight As Long, _
  109.                                                        ByVal hWndParent As Long, _
  110.                                                        ByVal hMenu As Long, _
  111.                                                        ByVal hInstance As Long, _
  112.                                                        lpParam As Any) As Long
  113.  
  114. Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, _
  115.                                                        ByVal lpClassName As Long, _
  116.                                                        ByVal lpWindowName As Long, _
  117.                                                        ByVal dwStyle As Long, _
  118.                                                        ByVal x As Long, _
  119.                                                        ByVal y As Long, _
  120.                                                        ByVal nWidth As Long, _
  121.                                                        ByVal nHeight As Long, _
  122.                                                        ByVal hWndParent As Long, _
  123.                                                        ByVal hMenu As Long, _
  124.                                                        ByVal hInstance As Long, _
  125.                                                        lpParam As Any) As Long
  126.  
  127. Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
  128.  
  129. Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, _
  130.                                                ByVal hWndInsertAfter As Long, _
  131.                                                ByVal x As Long, _
  132.                                                ByVal y As Long, _
  133.                                                ByVal cx As Long, _
  134.                                                ByVal cy As Long, _
  135.                                                ByVal wFlags As Long)
  136.  
  137. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  138.  
  139. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
  140.                                                  ByVal hdc As Long) As Long
  141.  
  142. Private Declare Function ImageList_GetIcon Lib "comctl32" (ByVal hImageList As Long, _
  143.                                                            ByVal ImgIndex As Long, _
  144.                                                            ByVal fuFlags As Long) As Long
  145.  
  146. Private Declare Function ImageList_GetImageCount Lib "comctl32" (ByVal hImageList As Long) As Long
  147.  
  148. Private Declare Function ImageList_GetIconSize Lib "comctl32" (ByVal hImageList As Long, _
  149.                                                                cx As Long, _
  150.                                                                cy As Long) As Long
  151.  
  152. Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
  153.  
  154. Public Event ReturnData(ByVal sText As String, ByVal oFont As StdFont, ByVal lIcon As Long, ByVal lForeColor As Long, ByVal lBackColor As Long)
  155. Public Event DestroyMe()
  156.  
  157.  
  158. Private m_bIsNt                                 As Boolean
  159. Private m_bShowing                              As Boolean
  160. Private m_bUseUnicode                           As Boolean
  161. Private m_bFontRightLeading                     As Boolean
  162. Private m_lParentHwnd                           As Long
  163. Private m_lHostHwnd                             As Long
  164. Private m_lWidth                                As Long
  165. Private m_lHeight                               As Long
  166. Private m_lImlHwnd                              As Long
  167. Private m_lForeColor                            As Long
  168. Private m_lBackColor                            As Long
  169. Private m_lIconIndex                            As Long
  170. Private m_lhIcon                                As Long
  171. Private m_lThemeColor                           As Long
  172. Private m_lOffsetColor                          As Long
  173. Private m_sEditText                             As String
  174. Private m_eImageType                            As EIAImageType
  175. Private m_oFont                                 As StdFont
  176. Private m_eThemeStyle                           As ECAThemeStyle
  177. Private m_tRWnd                                 As RECT
  178. Private m_cTxEditBox                            As clsODControl
  179. Private m_cTxSize                               As clsODControl
  180. Private m_cPbDisplay                            As clsODControl
  181. Private m_cLbIcon                               As clsODControl
  182. Private m_cLbFontSelect                         As clsODControl
  183. Private m_cLbFontColor                          As clsODControl
  184. Private m_cLbBackColor                          As clsODControl
  185. Private m_cLbSize                               As clsODControl
  186. Private WithEvents m_cCbBackColor               As clsODControl
  187. Attribute m_cCbBackColor.VB_VarHelpID = -1
  188. Private WithEvents m_cCbFontSelect              As clsODControl
  189. Attribute m_cCbFontSelect.VB_VarHelpID = -1
  190. Private WithEvents m_cCbFontColor               As clsODControl
  191. Attribute m_cCbFontColor.VB_VarHelpID = -1
  192. Private WithEvents m_cBtScrollUp                As clsODControl
  193. Attribute m_cBtScrollUp.VB_VarHelpID = -1
  194. Private WithEvents m_cBtScrollDwn               As clsODControl
  195. Attribute m_cBtScrollDwn.VB_VarHelpID = -1
  196. Private WithEvents m_cBtClose                   As clsODControl
  197. Attribute m_cBtClose.VB_VarHelpID = -1
  198. Private WithEvents m_cBtSave                    As clsODControl
  199. Attribute m_cBtSave.VB_VarHelpID = -1
  200. Private WithEvents m_cBtFontBold                As clsODControl
  201. Attribute m_cBtFontBold.VB_VarHelpID = -1
  202. Private WithEvents m_cBtFontItalic              As clsODControl
  203. Attribute m_cBtFontItalic.VB_VarHelpID = -1
  204. Private WithEvents m_cBtFontStrike              As clsODControl
  205. Attribute m_cBtFontStrike.VB_VarHelpID = -1
  206. Private WithEvents m_cBtFontUnderline           As clsODControl
  207. Attribute m_cBtFontUnderline.VB_VarHelpID = -1
  208. Private m_cHostSubclass                         As GXMSubclass
  209.  
  210.  
  211. Private Sub Class_Initialize()
  212.  
  213.     m_bIsNt = CompatabilityCheck
  214.     m_lForeColor = -1
  215.     m_lBackColor = -1
  216.     m_lIconIndex = -1
  217.     
  218. End Sub
  219.  
  220. Private Sub m_cBtClose_Click()
  221. '/* signal close
  222.     DestroyHost
  223.     RaiseEvent DestroyMe
  224. End Sub
  225.  
  226. Private Sub m_cBtSave_Click()
  227. '/* return changes to parent
  228.  
  229.     If Not m_oFont Is Nothing Then
  230.         With m_oFont
  231.             .Bold = m_cBtFontBold.CommandPushed
  232.             .Italic = m_cBtFontItalic.CommandPushed
  233.             .Strikethrough = m_cBtFontStrike.CommandPushed
  234.             .Underline = m_cBtFontUnderline.CommandPushed
  235.         End With
  236.     End If
  237.     '/* send data
  238.     RaiseEvent ReturnData(m_cTxEditBox.Text, m_oFont, m_lIconIndex, m_lForeColor, m_lBackColor)
  239.  
  240. End Sub
  241.  
  242. Private Sub m_cCbFontSelect_ItemChange(ByVal lItem As Long)
  243. '/* font selection change
  244.  
  245.     With m_cCbFontSelect
  246.         If (.ListIndex = 0) Then
  247.             '/* open font dialog
  248.             ComboGetFont
  249.         Else
  250.             '/* update local font
  251.             If Not (.ListIndex = -1) Then
  252.                 Set m_oFont = New StdFont
  253.                 m_oFont.Name = .ListText(.ListIndex)
  254.             End If
  255.         End If
  256.     End With
  257.  
  258. End Sub
  259.  
  260. Private Sub ComboGetFont()
  261. '/* open font dialog
  262.  
  263. On Error Resume Next
  264.  
  265.     Set m_oFont = ShowFontDialog(m_lParentHwnd)
  266.  
  267. On Error GoTo 0
  268.  
  269. End Sub
  270.  
  271. Private Sub m_cBtScrollDwn_Click()
  272. '/* scroll down icon list
  273.  
  274.     m_lIconIndex = (m_lIconIndex - 1)
  275.     EditLoadPicture m_lIconIndex
  276.  
  277. End Sub
  278.  
  279. Private Sub m_cBtScrollUp_Click()
  280. '/* scroll up icon list
  281.  
  282.     m_lIconIndex = (m_lIconIndex + 1)
  283.     EditLoadPicture m_lIconIndex
  284.     
  285. End Sub
  286.  
  287. Private Sub m_cCbBackColor_ItemChange(ByVal lItem As Long)
  288. '/* backcolor change
  289.  
  290.     With m_cCbBackColor
  291.         If (.ListIndex = 0) Then
  292.             '/* open color dialog
  293.             m_lBackColor = ComboExtendedColors
  294.             .ComboIndexColor = m_lBackColor
  295.         Else
  296.             If Not (.ListIndex = -1) Then
  297.                 m_lBackColor = CLng(.ListText(.ListIndex))
  298.             End If
  299.         End If
  300.     End With
  301.  
  302. End Sub
  303.  
  304. Private Sub m_cCbFontColor_ItemChange(ByVal lItem As Long)
  305. '/* forecolor change
  306.  
  307.     With m_cCbFontColor
  308.         If (.ListIndex = 0) Then
  309.             '/* open color dialog
  310.             m_lForeColor = ComboExtendedColors
  311.             .ComboIndexColor = m_lForeColor
  312.         Else
  313.             If Not (.ListIndex = -1) Then
  314.                 m_lForeColor = CLng(.ListText(.ListIndex))
  315.             End If
  316.         End If
  317.     End With
  318.  
  319. End Sub
  320.  
  321. Public Property Get FontRightLeading() As Boolean
  322. '/* [get] right align fonts
  323.     FontRightLeading = m_bFontRightLeading
  324. End Property
  325.  
  326. Public Property Let FontRightLeading(ByVal PropvVal As Boolean)
  327. '/* [let] right align fonts
  328.     m_bFontRightLeading = PropvVal
  329. End Property
  330.  
  331. Public Property Get HostHwnd() As Long
  332.     HostHwnd = m_lHostHwnd
  333. End Property
  334.  
  335. Public Property Let HostHwnd(ByVal PropVal As Long)
  336.     m_lHostHwnd = PropVal
  337. End Property
  338.  
  339. Public Property Get UseUnicode() As Boolean
  340.     UseUnicode = m_bUseUnicode
  341. End Property
  342.  
  343. Public Property Let UseUnicode(ByVal PropVal As Boolean)
  344.     m_bUseUnicode = PropVal
  345. End Property
  346.  
  347. Public Property Get Width() As Long
  348.     Width = m_lWidth
  349. End Property
  350.  
  351. Public Property Let Width(ByVal PropVal As Long)
  352.     m_lWidth = PropVal
  353. End Property
  354.  
  355. Public Property Get Height() As Long
  356.     Height = m_lHeight
  357. End Property
  358.  
  359. Public Property Let Height(ByVal PropVal As Long)
  360.     m_lHeight = PropVal
  361. End Property
  362.  
  363. Public Sub CreateEditBox(ByVal lOwnerHwnd As Long, _
  364.                          ByVal lX As Long, _
  365.                          ByVal lY As Long, _
  366.                          ByVal eThemeStyle As ECAThemeStyle, _
  367.                          Optional ByVal lThemecolor As Long = -1, _
  368.                          Optional ByVal lThemeOffsetColor As Long = -1, _
  369.                          Optional ByVal sText As String, _
  370.                          Optional ByVal lImlHwnd As Long = -1, _
  371.                          Optional ByVal lIcnIndex As Long = -1, _
  372.                          Optional eImageType As EIAImageType)
  373.  
  374. '/* create edit window
  375.  
  376.     If Not (lOwnerHwnd = 0) Then
  377.         m_lParentHwnd = lOwnerHwnd
  378.         '/* create host window
  379.         CreateWindow
  380.         '/* subclass
  381.         Attach
  382.         With m_tRWnd
  383.             .left = lX
  384.             .Right = 362
  385.             .top = lY
  386.             .Bottom = 282
  387.         End With
  388.         '/* show
  389.         SetPosition m_lHostHwnd, m_tRWnd
  390.         '/* store image data
  391.         If (lImlHwnd > -1) Then
  392.             m_lImlHwnd = lImlHwnd
  393.             m_eImageType = eImageType
  394.             m_lIconIndex = lIcnIndex
  395.         End If
  396.         m_lThemeColor = lThemecolor
  397.         m_lOffsetColor = lThemeOffsetColor
  398.         m_sEditText = sText
  399.         m_eThemeStyle = eThemeStyle
  400.         '/* create support controls
  401.         CreateControls lImlHwnd, lIcnIndex
  402.     End If
  403.     
  404. End Sub
  405.  
  406. Private Sub CreateControls(ByVal lImlHwnd As Long, _
  407.                            Optional ByVal lIcnIndex As Long = -1)
  408.  
  409. '/* create support controls
  410.  
  411. Dim oFont As StdFont
  412.  
  413.     Set m_cTxEditBox = New clsODControl
  414.     With m_cTxEditBox
  415.         '/* control name
  416.         .Name = "txtEdit"
  417.         '/* borderstyle
  418.         .BorderStyle ecbsThin
  419.         .UseUnicode = m_bUseUnicode
  420.         .FontRightLeading = m_bFontRightLeading
  421.         '/* create control window
  422.         .Create m_lHostHwnd, 9, 6, 337, 118, ecsTextBox
  423.         '/* add text
  424.         .Text = m_sEditText
  425.     End With
  426.     
  427.     Set m_cLbFontColor = New clsODControl
  428.     With m_cLbFontColor
  429.         .Name = "lblColor"
  430.         .BorderStyle ecbsNone
  431.         .AutoBackColor = True
  432.         .FontRightLeading = m_bFontRightLeading
  433.         .UseUnicode = m_bUseUnicode
  434.         .Create m_lHostHwnd, 9, 129, 44, 13, ecsLabel
  435.         .Text = "ForeColor"
  436.         .AutoSize = True
  437.     End With
  438.     
  439.     Set m_cCbFontColor = New clsODControl
  440.     With m_cCbFontColor
  441.         .Name = "cbForeColor"
  442.         .BorderStyle ecbsThin
  443.         .ThemeStyle = m_eThemeStyle
  444.         If (m_lThemeColor > -1) Then
  445.             .ThemeColor = m_lThemeColor
  446.         End If
  447.         If (m_lOffsetColor > -1) Then
  448.             .HiliteColor = m_lOffsetColor
  449.         End If
  450.         .FontRightLeading = m_bFontRightLeading
  451.         .UseUnicode = m_bUseUnicode
  452.         .Create m_lHostHwnd, 9, 141, 160, 120, ecsImageCombo
  453.         .AddItem "More.."
  454.     End With
  455.     
  456.     Set m_cLbFontSelect = New clsODControl
  457.     With m_cLbFontSelect
  458.         .Name = "lblCellfont"
  459.         .BorderStyle ecbsNone
  460.         .AutoBackColor = True
  461.         .FontRightLeading = m_bFontRightLeading
  462.         .UseUnicode = m_bUseUnicode
  463.         .Create m_lHostHwnd, 9, 170, 41, 13, ecsLabel
  464.         .Text = "Cell Font"
  465.         .AutoSize = True
  466.     End With
  467.     
  468.     Set m_cCbFontSelect = New clsODControl
  469.     With m_cCbFontSelect
  470.         .Name = "cbFontSelect"
  471.         .BorderStyle ecbsThin
  472.         .ThemeStyle = m_eThemeStyle
  473.         If (m_lThemeColor > -1) Then
  474.             .ThemeColor = m_lThemeColor
  475.         End If
  476.         If (m_lOffsetColor > -1) Then
  477.             .HiliteColor = m_lOffsetColor
  478.         End If
  479.         .FontRightLeading = m_bFontRightLeading
  480.         .UseUnicode = m_bUseUnicode
  481.         .Create m_lHostHwnd, 9, 182, 160, 120, ecsImageCombo
  482.         .AddItem "More.."
  483.     End With
  484.     
  485.     Set m_cBtFontBold = New clsODControl
  486.     With m_cBtFontBold
  487.         .Name = "cmdBold"
  488.         .HiliteColor = &HCCCCCC
  489.         Set oFont = New StdFont
  490.         With oFont
  491.             .Name = "ARIAL"
  492.             .Size = 8
  493.             .Bold = True
  494.         End With
  495.         Set .Font = oFont
  496.         .CommandPushButton = True
  497.         .ThemeStyle = m_eThemeStyle
  498.         If (m_lThemeColor > -1) Then
  499.             .ThemeColor = m_lThemeColor
  500.         End If
  501.         If (m_lOffsetColor > -1) Then
  502.             .HiliteColor = m_lOffsetColor
  503.         End If
  504.         .FontRightLeading = m_bFontRightLeading
  505.         .UseUnicode = m_bUseUnicode
  506.         .Create m_lHostHwnd, 9, 212, 22, 22, ecsCommandButton
  507.         .Text = "B"
  508.         Set oFont = Nothing
  509.     End With
  510.     
  511.     Set m_cBtFontItalic = New clsODControl
  512.     With m_cBtFontItalic
  513.         .Name = "cmdItalic"
  514.         .HiliteColor = &HCCCCCC
  515.         Set oFont = New StdFont
  516.         With oFont
  517.             .Name = "ARIAL"
  518.             .Size = 8
  519.             .Bold = True
  520.             .Italic = True
  521.         End With
  522.         Set .Font = oFont
  523.         .CommandPushButton = True
  524.         .ThemeStyle = m_eThemeStyle
  525.         If (m_lThemeColor > -1) Then
  526.             .ThemeColor = m_lThemeColor
  527.         End If
  528.         If (m_lOffsetColor > -1) Then
  529.             .HiliteColor = m_lOffsetColor
  530.         End If
  531.         .FontRightLeading = m_bFontRightLeading
  532.         .UseUnicode = m_bUseUnicode
  533.         .Create m_lHostHwnd, 35, 212, 22, 22, ecsCommandButton
  534.         .Text = "I"
  535.         Set oFont = Nothing
  536.     End With
  537.     
  538.     Set m_cBtFontStrike = New clsODControl
  539.     With m_cBtFontStrike
  540.         .Name = "cmdStrike"
  541.         .HiliteColor = &HCCCCCC
  542.         Set oFont = New StdFont
  543.         With oFont
  544.             .Name = "ARIAL"
  545.             .Size = 8
  546.             .Bold = True
  547.             .Strikethrough = True
  548.         End With
  549.         Set .Font = oFont
  550.         .CommandPushButton = True
  551.         .ThemeStyle = m_eThemeStyle
  552.         If (m_lThemeColor > -1) Then
  553.             .ThemeColor = m_lThemeColor
  554.         End If
  555.         If (m_lOffsetColor > -1) Then
  556.             .HiliteColor = m_lOffsetColor
  557.         End If
  558.         .FontRightLeading = m_bFontRightLeading
  559.         .UseUnicode = m_bUseUnicode
  560.         .Create m_lHostHwnd, 61, 212, 22, 22, ecsCommandButton
  561.         .Text = "S"
  562.         Set oFont = Nothing
  563.     End With
  564.     
  565.     Set m_cBtFontUnderline = New clsODControl
  566.     With m_cBtFontUnderline
  567.         .Name = "cmdUnderline"
  568.         .HiliteColor = &HCCCCCC
  569.         Set oFont = New StdFont
  570.         With oFont
  571.             .Name = "Arial"
  572.             .Size = 8
  573.             .Bold = True
  574.             .Underline = True
  575.         End With
  576.         Set .Font = oFont
  577.         .CommandPushButton = True
  578.         .ThemeStyle = m_eThemeStyle
  579.         If (m_lThemeColor > -1) Then
  580.             .ThemeColor = m_lThemeColor
  581.         End If
  582.         If (m_lOffsetColor > -1) Then
  583.             .HiliteColor = m_lOffsetColor
  584.         End If
  585.         .FontRightLeading = m_bFontRightLeading
  586.         .UseUnicode = m_bUseUnicode
  587.         .Create m_lHostHwnd, 87, 212, 22, 22, ecsCommandButton
  588.         .Text = "U"
  589.         Set oFont = Nothing
  590.     End With
  591.  
  592.     Set m_cLbSize = New clsODControl
  593.         With m_cLbSize
  594.         .Name = "lblSize"
  595.         .BorderStyle ecbsNone
  596.         .AutoBackColor = True
  597.         .FontRightLeading = m_bFontRightLeading
  598.         .UseUnicode = m_bUseUnicode
  599.         .Create m_lHostHwnd, 137, 222, 10, 11, ecsLabel
  600.         Set oFont = New StdFont
  601.         With oFont
  602.             .Name = "Small Fonts"
  603.             .Size = 7
  604.             .Bold = True
  605.         End With
  606.         Set .Font = oFont
  607.         .Text = "Size"
  608.         .AutoSize = True
  609.     End With
  610.     
  611.     Set m_cTxSize = New clsODControl
  612.     With m_cTxSize
  613.         .Name = "txtSize"
  614.         .BorderStyle ecbsThin
  615.         .FontRightLeading = m_bFontRightLeading
  616.         .UseUnicode = m_bUseUnicode
  617.         .Create m_lHostHwnd, 117, 214, 18, 19, ecsTextBox
  618.         .Text = "8"
  619.     End With
  620.     
  621.     Set m_cLbBackColor = New clsODControl
  622.     With m_cLbBackColor
  623.         .Name = "lblBackColor"
  624.         .BorderStyle ecbsNone
  625.         .AutoBackColor = True
  626.         .FontRightLeading = m_bFontRightLeading
  627.         .UseUnicode = m_bUseUnicode
  628.         .Create m_lHostHwnd, 186, 180, 48, 13, ecsLabel
  629.         .Text = "BackColor"
  630.         .AutoSize = True
  631.     End With
  632.     
  633.     Set m_cCbBackColor = New clsODControl
  634.     With m_cCbBackColor
  635.         .Name = "cbBackColor"
  636.         .BorderStyle ecbsThin
  637.         .ThemeStyle = m_eThemeStyle
  638.         If (m_lThemeColor > -1) Then
  639.             .ThemeColor = m_lThemeColor
  640.         End If
  641.         If (m_lOffsetColor > -1) Then
  642.             .HiliteColor = m_lOffsetColor
  643.         End If
  644.         .FontRightLeading = m_bFontRightLeading
  645.         .UseUnicode = m_bUseUnicode
  646.         .Create m_lHostHwnd, 186, 192, 160, 120, ecsImageCombo
  647.         .AddItem "More.."
  648.     End With
  649.  
  650.     Set m_cBtSave = New clsODControl
  651.     With m_cBtSave
  652.         .Name = "cmdSave"
  653.         .HiliteColor = &HCCCCCC
  654.         .ThemeStyle = m_eThemeStyle
  655.         If (m_lThemeColor > -1) Then
  656.             .ThemeColor = m_lThemeColor
  657.         End If
  658.         If (m_lOffsetColor > -1) Then
  659.             .HiliteColor = m_lOffsetColor
  660.         End If
  661.         .FontRightLeading = m_bFontRightLeading
  662.         .UseUnicode = m_bUseUnicode
  663.         .Create m_lHostHwnd, 210, 225, 64, 22, ecsCommandButton
  664.         .Text = "Save"
  665.     End With
  666.     
  667.     Set m_cBtClose = New clsODControl
  668.     With m_cBtClose
  669.         .Name = "cmdClose"
  670.         .HiliteColor = &HCCCCCC
  671.         .ThemeStyle = m_eThemeStyle
  672.         If (m_lThemeColor > -1) Then
  673.             .ThemeColor = m_lThemeColor
  674.         End If
  675.         If (m_lOffsetColor > -1) Then
  676.             .HiliteColor = m_lOffsetColor
  677.         End If
  678.         .FontRightLeading = m_bFontRightLeading
  679.         .UseUnicode = m_bUseUnicode
  680.         .Create m_lHostHwnd, 282, 225, 64, 22, ecsCommandButton
  681.         .Text = "Close"
  682.     End With
  683.  
  684.     If (lImlHwnd > -1) Then
  685.         Set m_cLbIcon = New clsODControl
  686.         With m_cLbIcon
  687.             .Name = "lblCellIcon"
  688.             .BorderStyle ecbsNone
  689.             .AutoBackColor = True
  690.             .FontRightLeading = m_bFontRightLeading
  691.             .UseUnicode = m_bUseUnicode
  692.             .Create m_lHostHwnd, 189, 129, 21, 13, ecsLabel
  693.             .Text = "Cell Icon"
  694.             .AutoSize = True
  695.         End With
  696.         
  697.         Set m_cPbDisplay = New clsODControl
  698.         With m_cPbDisplay
  699.             .Name = ""
  700.             .BorderStyle ecbsThin
  701.             .BackColor = vbWhite
  702.             .UseUnicode = m_bUseUnicode
  703.             .Create m_lHostHwnd, 189, 141, 40, 34, ecsPictureBox
  704.             '/* load current icon
  705.             If (lIcnIndex > -1) Then
  706.                 EditLoadPicture lIcnIndex
  707.             End If
  708.         End With
  709.  
  710.         Set m_cBtScrollUp = New clsODControl
  711.         With m_cBtScrollUp
  712.             .Name = "cmdScrollUp"
  713.             .HiliteColor = &HCCCCCC
  714.             .ThemeStyle = m_eThemeStyle
  715.             Set oFont = Nothing
  716.             Set oFont = New StdFont
  717.             With oFont
  718.                 .Name = "Arial"
  719.                 .Size = 8
  720.                 .Bold = True
  721.             End With
  722.             Set .Font = oFont
  723.             If (m_lThemeColor > -1) Then
  724.                 .ThemeColor = m_lThemeColor
  725.             End If
  726.             If (m_lOffsetColor > -1) Then
  727.                 .HiliteColor = m_lOffsetColor
  728.             End If
  729.             .UseUnicode = m_bUseUnicode
  730.             .Create m_lHostHwnd, 234, 141, 16, 16, ecsCommandButton
  731.             .Text = Chr$(43)
  732.         End With
  733.         
  734.         Set m_cBtScrollDwn = New clsODControl
  735.         With m_cBtScrollDwn
  736.             .Name = "cmdScrollDown"
  737.             .HiliteColor = &HCCCCCC
  738.             .ThemeStyle = m_eThemeStyle
  739.             Set .Font = oFont
  740.             If (m_lThemeColor > -1) Then
  741.                 .ThemeColor = m_lThemeColor
  742.             End If
  743.             If (m_lOffsetColor > -1) Then
  744.                 .HiliteColor = m_lOffsetColor
  745.             End If
  746.             .UseUnicode = m_bUseUnicode
  747.             .Create m_lHostHwnd, 234, 160, 16, 16, ecsCommandButton
  748.             .Text = Chr$(45)
  749.         End With
  750.     End If
  751.     
  752.     Set oFont = Nothing
  753.     ComboAddColors
  754.     ComboAddFonts
  755.     
  756. End Sub
  757.  
  758. Private Sub EditLoadPicture(ByVal lIcnIndex As Long)
  759. '/* load icon into picturebox
  760.  
  761. Dim lWidth      As Long
  762. Dim lHeight     As Long
  763. Dim lImgCount   As Long
  764.  
  765.     If Not (m_lImlHwnd = -1) Then
  766.         '/* get image count
  767.         lImgCount = ImageList_GetImageCount(m_lImlHwnd)
  768.         If (lIcnIndex > (lImgCount - 1)) Then
  769.             m_lIconIndex = (lImgCount - 1)
  770.         ElseIf m_lIconIndex < 0 Then
  771.             m_lIconIndex = 0
  772.         Else
  773.             m_lIconIndex = lIcnIndex
  774.         End If
  775.         '/* clean up
  776.         If Not (m_lhIcon = 0) Then
  777.             EditDestroyIcon
  778.         End If
  779.         '/* create the icon copy
  780.         m_lhIcon = ImageList_GetIcon(m_lImlHwnd, m_lIconIndex, 0&)
  781.         If (m_lhIcon > 0) Then
  782.             '/* get icon size
  783.             ImageList_GetIconSize m_lImlHwnd, lWidth, lHeight
  784.             '/* load to picturebox
  785.             m_cPbDisplay.PictureBoxLoadImage m_lhIcon, m_eImageType, lWidth, lHeight
  786.         End If
  787.     End If
  788.  
  789. End Sub
  790.  
  791. Private Sub EditDestroyIcon()
  792. '/* destroy icon copy
  793.  
  794.     If Not (m_lhIcon = 0) Then
  795.         DestroyIcon m_lhIcon
  796.         m_lhIcon = 0
  797.     End If
  798.  
  799. End Sub
  800.  
  801. Private Sub ComboAddFonts()
  802. '/* add font list and icons
  803.  
  804. Dim lCt     As Long
  805. Dim lHdc    As Long
  806. Dim lTtHnd  As Long
  807. Dim lRtHnd  As Long
  808. Dim vFont   As Variant
  809. Dim cIml    As clsImageList
  810.  
  811.     '/* get system icon handles
  812.     Set cIml = New clsImageList
  813.     lRtHnd = cIml.SystemIconHandle(".FON", eisSmallIcon)
  814.     lTtHnd = cIml.SystemIconHandle(".TTF", eisSmallIcon)
  815.     With m_cCbFontSelect
  816.         '/* init ods imagelist
  817.         .InitListBoxIml 14, 14
  818.         '/* add the icons
  819.         .ImlListBoxAddIcon lRtHnd
  820.         .ImlListBoxAddIcon lTtHnd
  821.     End With
  822.     '/* get the system fonts list
  823.     lHdc = GetDC(m_lParentHwnd)
  824.     vFont = EnumSystemFonts(lHdc)
  825.     ReleaseDC m_lParentHwnd, lHdc
  826.     '/* add font list to combo
  827.     For lCt = 0 To UBound(vFont, 2)
  828.         Select Case vFont(1, lCt)
  829.         Case 0, 1
  830.             m_cCbFontSelect.AddItem vFont(0, lCt), 0
  831.         Case Else
  832.             m_cCbFontSelect.AddItem vFont(0, lCt), 1
  833.         End Select
  834.     Next lCt
  835.     Set cIml = Nothing
  836.     
  837. End Sub
  838.  
  839. Private Sub ComboAddColors()
  840. '/* load combo color list
  841.  
  842. Dim lCt     As Long
  843. Dim sColor  As String
  844. Dim sClr()  As String
  845.  
  846. On Error Resume Next
  847.  
  848.     '/* split color const
  849.     sColor = CLRYELLOW & CLRMAGENTA & CLRCYAN & CLRBLUE & CLRRED & CLRGREEN & CLRGREY
  850.     sClr = Split(sColor, Chr$(32))
  851.     '/* add to lists
  852.     For lCt = 0 To UBound(sClr)
  853.         m_cCbBackColor.AddItem sClr(lCt), , CLng(sClr(lCt))
  854.         m_cCbFontColor.AddItem sClr(lCt), , CLng(sClr(lCt))
  855.     Next lCt
  856.  
  857. On Error GoTo 0
  858.  
  859. End Sub
  860.  
  861. Private Function ComboExtendedColors() As Long
  862. '/* launch color dialog
  863.  
  864. Dim lRet        As Long
  865. Dim lCust()    As Long
  866.  
  867.     ReDim lCust(15)
  868.     lCust(0) = &HFFFFFF
  869.     lRet = ShowColorDialog(m_lParentHwnd, &HFFFFFF, lCust, 1)
  870.     If Not (lRet = -1) Then
  871.         ComboExtendedColors = lRet
  872.     End If
  873.  
  874. End Function
  875.  
  876. Private Sub CreateWindow()
  877. '/* create api window
  878.  
  879. Dim lTTStyle As Long
  880. Dim lExStyle As Long
  881. Dim sTitle   As String
  882.  
  883.     '/* style constants
  884.     lTTStyle = WS_CLIPSIBLINGS Or WS_SYSMENU Or HDS_FLAT Or WS_CLIPCHILDREN
  885.     lExStyle = WS_EX_TOOLWINDOW
  886.     If m_bFontRightLeading Then
  887.         lExStyle = lExStyle Or WS_EX_RTLREADING
  888.     End If
  889.     sTitle = "Advanced Edit"
  890.     '/* create tool/header window
  891.     If m_bIsNt Then
  892.         m_lHostHwnd = CreateWindowExW(lExStyle, StrPtr("SysHeader32"), StrPtr(sTitle), lTTStyle, _
  893.             0&, 0&, 0&, 0&, m_lParentHwnd, 0&, App.hInstance, ByVal 0&)
  894.     Else
  895.         m_lHostHwnd = CreateWindowExA(lExStyle, "SysHeader32", sTitle, lTTStyle, _
  896.             0&, 0&, 0&, 0&, m_lParentHwnd, 0&, App.hInstance, ByVal 0&)
  897.     End If
  898.  
  899. End Sub
  900.  
  901. Private Function CompatabilityCheck() As Boolean
  902. '/* nt version check
  903.  
  904. Dim tVer As VERSIONINFO
  905.  
  906.     tVer.dwOSVersionInfoSize = Len(tVer)
  907.     GetVersionEx tVer
  908.     If tVer.dwMajorVersion >= 5 Then
  909.         CompatabilityCheck = True
  910.     End If
  911.  
  912. End Function
  913.  
  914. Private Sub SetPosition(ByVal lHwnd As Long, _
  915.                         ByRef tRect As RECT)
  916.  
  917. '/* show window
  918.  
  919.     If Not (m_lHostHwnd = 0) Then
  920.         With tRect
  921.             SetWindowPos lHwnd, 0&, .left, .top, .Right, .Bottom, SWP_SHOWWINDOW
  922.         End With
  923.     End If
  924.  
  925. End Sub
  926.  
  927. Private Sub Attach()
  928. '/* attach subclasser
  929.  
  930.     If Not (m_lHostHwnd = 0) Then
  931.         Set m_cHostSubclass = New GXMSubclass
  932.         With m_cHostSubclass
  933.             .Subclass m_lHostHwnd, Me
  934.             .AddMessage m_lHostHwnd, WM_CLOSE, MSG_AFTER
  935.         End With
  936.     End If
  937.     
  938. End Sub
  939.  
  940. Private Sub Detach()
  941. '/* detach subclasser
  942.  
  943.     If Not m_cHostSubclass Is Nothing Then
  944.         With m_cHostSubclass
  945.             .DeleteMessage m_lHostHwnd, WM_CLOSE, MSG_AFTER
  946.             .UnSubclass m_lHostHwnd
  947.         End With
  948.         Set m_cHostSubclass = Nothing
  949.     End If
  950.     
  951. End Sub
  952.  
  953. Private Sub GXISubclass_WndProc(ByVal bBefore As Boolean, _
  954.                                 bHandled As Boolean, _
  955.                                 lReturn As Long, _
  956.                                 ByVal lHwnd As Long, _
  957.                                 ByVal uMsg As eMsg, _
  958.                                 ByVal wParam As Long, _
  959.                                 ByVal lParam As Long, _
  960.                                 lParamUser As Long)
  961.     
  962.     '/* signal window termination to parent
  963.     If (uMsg = WM_CLOSE) Then
  964.         RaiseEvent DestroyMe
  965.     End If
  966.     
  967. End Sub
  968.  
  969.  
  970. '> Cleanup
  971. '>>>>>>>>>>>>>>>>
  972. Private Sub DestroyHost()
  973. '/* destroy host window
  974.  
  975.     '/* detach subclasser
  976.     Detach
  977.     '/* destroy window
  978.     If Not m_lHostHwnd = 0 Then
  979.         DestroyWindow m_lHostHwnd
  980.         m_lHostHwnd = 0
  981.         m_bShowing = False
  982.     End If
  983.     
  984. End Sub
  985.  
  986. Public Sub DestroyEditBox()
  987. '/* cleanup
  988.     
  989.     EditDestroyIcon
  990.     If Not m_cTxEditBox Is Nothing Then Set m_cTxEditBox = Nothing
  991.     If Not m_cTxSize Is Nothing Then Set m_cTxSize = Nothing
  992.     
  993.     If Not m_cPbDisplay Is Nothing Then Set m_cPbDisplay = Nothing
  994.     
  995.     If Not m_cCbBackColor Is Nothing Then Set m_cCbBackColor = Nothing
  996.     If Not m_cCbFontSelect Is Nothing Then Set m_cCbFontSelect = Nothing
  997.     If Not m_cCbFontColor Is Nothing Then Set m_cCbFontColor = Nothing
  998.     
  999.     If Not m_cBtFontBold Is Nothing Then Set m_cBtFontBold = Nothing
  1000.     If Not m_cBtFontItalic Is Nothing Then Set m_cBtFontItalic = Nothing
  1001.     If Not m_cBtFontStrike Is Nothing Then Set m_cBtFontStrike = Nothing
  1002.     If Not m_cBtFontUnderline Is Nothing Then Set m_cBtFontUnderline = Nothing
  1003.     If Not m_cBtClose Is Nothing Then Set m_cBtClose = Nothing
  1004.     If Not m_cBtSave Is Nothing Then Set m_cBtSave = Nothing
  1005.     If Not m_cBtScrollUp Is Nothing Then Set m_cBtScrollUp = Nothing
  1006.     If Not m_cBtScrollDwn Is Nothing Then Set m_cBtScrollDwn = Nothing
  1007.     
  1008.     If Not m_cLbIcon Is Nothing Then Set m_cLbIcon = Nothing
  1009.     If Not m_cLbFontSelect Is Nothing Then Set m_cLbFontSelect = Nothing
  1010.     If Not m_cLbFontColor Is Nothing Then Set m_cLbFontColor = Nothing
  1011.     If Not m_cLbBackColor Is Nothing Then Set m_cLbBackColor = Nothing
  1012.     If Not m_cLbSize Is Nothing Then Set m_cLbSize = Nothing
  1013.     If Not m_oFont Is Nothing Then Set m_oFont = Nothing
  1014.     DestroyHost
  1015.  
  1016. End Sub
  1017.  
  1018. Private Sub Class_Terminate()
  1019.     DestroyEditBox
  1020. End Sub
  1021.