yaodurant.drawing.choosecolor.vb

Programming the .NET Compact Framework with vb 源代码

' YaoDurant.Drawing.ChooseColor.vb - Wrapper for calling Win32
' color picker common dialog box.
'
' Code from _Programming the .NET Compact Framework with C#_
' and _Programming the .NET Compact Framework with VB_
' (c) Copyright 2002-2003 Paul Yao and David Durant. 
' All rights reserved.
Imports System.Runtime.InteropServices

Namespace YaoDurant.Drawing

Public Class ChooseColorDlg

   ' Private data -- the Win32 CHOOSECOLOR structure
   Private m_cc As CHOOSECOLORSTRUCT

   ' Class initialization function
   Public Function Init(ByVal ctrlParent As Control) As Boolean
      ' Allocate array for initial colors.
      Dim cbColorData As Integer = 16 * 4
      Dim ipColors As IntPtr = LocalAlloc(LMEM_FIXED, cbColorData)

      If ipColors.Equals(IntPtr.Zero) Then
         Return False
      End If

      m_cc = New CHOOSECOLORSTRUCT
      m_cc.lStructSize = Marshal.SizeOf(m_cc)
      m_cc.hwndOwner = GetHwndFromControl(ctrlParent)
      m_cc.hInstance = IntPtr.Zero
      m_cc.rgbResult = 0
      m_cc.lpCustColors = ipColors
      m_cc.Flags = CC_RGBINIT
      m_cc.lCustData = 0
      m_cc.lpfnHook = IntPtr.Zero
      m_cc.lpTemplateName = IntPtr.Zero

      Return True
   End Function

   Public Function ShowDialog(ByRef clrValue As Color) As Boolean
      Dim iRet As Integer = 0
      Dim Red As Integer = clrValue.R
      Dim Green As Integer = clrValue.G
      Dim Blue As Integer = clrValue.B
      Dim Temp As Integer = 0

      m_cc.rgbResult = (Blue << 16) + (Green << 8) + Red

      iRet = ChooseColor(m_cc)
      If iRet <> 0 Then
         Red = CInt(m_cc.rgbResult And &HFF)
         Green = CInt((m_cc.rgbResult And &HFF00) >> 8)
         Blue = CInt((m_cc.rgbResult And &HFF0000) >> 16)
         clrValue = Color.FromArgb(Red, Green, Blue)
         Return True
      Else
         Return False
      End If
   End Function

   '
   ' Memory allocation functions & values.
   '
   Public Shared LMEM_FIXED As Integer = 0
   <DllImport("coredll.dll")> _
   Public Shared Function LocalAlloc(ByVal uFlags As Integer, _
   ByVal uBytes As Integer) As IntPtr
   End Function
   <DllImport("coredll.dll")> _
   Public Shared Function LocalFree( _
   ByVal hMem As IntPtr) As IntPtr
   End Function
   Public Shared INVALID_HANDLE_VALUE As Integer = -1

   '
   ' Color dialog function & values.
   '
   <DllImport("commdlg.dll")> _
   Public Shared Function ChooseColor( _
   ByRef lpcc As CHOOSECOLORSTRUCT) As Integer
   End Function
   Public Structure CHOOSECOLORSTRUCT
      Public lStructSize As Integer
      Public hwndOwner As IntPtr
      Public hInstance As IntPtr
      Public rgbResult As Integer
      Public lpCustColors As IntPtr
      Public Flags As Integer
      Public lCustData As Integer
      Public lpfnHook As IntPtr
      Public lpTemplateName As IntPtr
   End Structure

   Public Const CC_RGBINIT As Integer = &H1
   Public Const CC_FULLOPEN As Integer = &H2
   Public Const CC_PREVENTFULLOPEN As Integer = &H4
   Public Const CC_ENABLEHOOK As Integer = &H10
   Public Const CC_ENABLETEMPLATE As Integer = &H20
   Public Const CC_ENABLETEMPLATEHANDLE As Integer = &H40
   Public Const CC_SOLIDCOLOR As Integer = &H80
   Public Const CC_ANYCOLOR As Integer = &H100

   '
   ' Focus functions
   '
   <DllImport("coredll.dll")> _
   Public Shared Function GetFocus() As IntPtr
   End Function
   <DllImport("coredll.dll")> _
   Public Shared Function SetFocus(ByVal hWnd As IntPtr) As IntPtr
   End Function

   Public Function GetHwndFromControl( _
   ByVal ctrl As Control) As IntPtr
      Dim hwndControl As IntPtr

      ' Check whether control has focus.
      If (ctrl.Focused) Then
         hwndControl = GetFocus()
      Else
         Dim ipFocus As IntPtr = GetFocus()
         ctrl.Focus()
         hwndControl = GetFocus()
         SetFocus(ipFocus)
      End If

      Return hwndControl
   End Function

End Class
End Namespace