(c) 2002 Visual Studio Magazine
Fawcette Technical Publications

Issue: January 2002
Section: Q&A
Author: Karl Peterson

VB6	Let a Class Paint When Needed
Listing 1	You can turn over all the details of painting an MDI form's background by just setting a few properties of this class. By using WithEvents to declare a reference to the client MDIForm, the class is notified whenever the client is resized so it can regenerate a background graphic. CMdiBackground uses a dynamically added PictureBox control as the canvas on which it creates new background images for assignment to the client form's Picture property. (You can download the full class code from the VSM Web site; see the Go Online box for details.)

Option Explicit

' [Win32 API declarations cut for space reasons]

' Member variables
Private WithEvents m_Client As MDIForm
Private m_Canvas As PictureBox
Private m_Graphic As StdPicture
Private m_AutoRefresh As Boolean
Private m_hWnd As Long

' Constants
Private Const pbID As String = "mdiBackPicture"

Public Enum mdiColors
	mdiColorTop = 0
	mdiColorBottom = 1
End Enum

' Background styles
Public Enum mdiBackStyles
	mdiSolid = 0
	mdiGradient = 1
End Enum

Private Sub Class_Initialize()
	' Set default values for class
	m_AutoRefresh = False
End Sub

Private Sub Class_Terminate()
	' Clean up
	Set m_Graphic = Nothing
	Call ClientTeardown
End Sub

Private Sub m_Client_Resize()
	' Adjust canvas to fit
	If m_Client.WindowState <> vbMinimized Then
		Call CanvasResize
	End If
End Sub

Public Property Set Client(ByVal NewClient As _
	MDIForm)
	' Clean up old client, if need be
	Call ClientTeardown
	' Set up new client
	Set m_Client = NewClient
	Call ClientSetup
End Property

Public Property Get Client() As MDIForm
	Set Client = m_Client
End Property

Public Property Let Color(Optional ByVal Which _
	As mdiColors = mdiColorTop, ByVal NewVal As _
	OLE_COLOR)
		' [code snipped for space]
End Property

Public Property Get Color(Optional ByVal Which _
	As mdiColors = mdiColorTop) As OLE_COLOR
		' [code snipped for space]
End Property

Public Sub Refresh()
	Const swpFlags As Long = _
		SWP_FRAMECHANGED Or SWP_NOMOVE Or _
		SWP_NOZORDER Or SWP_NOSIZE

	' Bail if no canvas established
	If m_Canvas Is Nothing Then Exit Sub

	' Paint pretty picture :-)
	With m_Canvas
		' [painting code snipped for space]
	End With

	' Force client to repaint canvas
	Set m_Client.Picture = m_Canvas.Image
	Call SetWindowPos(m_Client.hWnd, 0, 0, 0, 0, _
		0, swpFlags)
End Sub

Private Sub CanvasResize()
	Dim w As Long, h As Long
	' Bail if no canvas established
	If m_Canvas Is Nothing Then Exit Sub
	' Adjust canvas to fit
	w = m_Client.ScaleWidth + _
		(GetSystemMetrics(SM_CXVSCROLL) * _
		Screen.TwipsPerPixelX)
	h = m_Client.ScaleHeight + _
		(GetSystemMetrics(SM_CYHSCROLL) * _
		Screen.TwipsPerPixelY)
	Call m_Canvas.Move(0, 0, w, h)
	' Always update graphics on resize!
	Call Refresh
End Sub

Private Sub ClientSetup()
	' Bail if no client established
	If m_Client Is Nothing Then Exit Sub
	' Create background canvas
	Set m_Canvas = m_Client.Controls.Add( _
		"VB.PictureBox", pbID)
	With m_Canvas
		' Set appropriate properties
		.AutoRedraw = True
		.BorderStyle = 0 'none
		.ClipControls = False
		' Cache window handle
		m_hWnd = .hWnd
	End With
	Call CanvasResize
End Sub

Private Sub ClientTeardown()
	' Bail if no client established
	If m_Client Is Nothing Then Exit Sub
	' Remove background canvas
	If IsWindow(m_hWnd) Then
		' Testing the window is required because
		' the client may be in an indeterminate
		' state and its control collection could be
		' hosed if in the middle of unloading.
		On Error Resume Next
		Call m_Client.Controls.Remove(pbID)
		Set m_Canvas = Nothing
	End If
	' Release reference to client
	Set m_Client = Nothing
End Sub

VB5, VB6	Accept String Returns
Listing 2	All 32-bit Windows platforms provide the GetCommandLine API in both Unicode and ANSI implementations. This example demonstrates how VB  converts API-returned strings from ANSI to Unicode automatically. Here, a pointer to ANSI data is assigned to a String return, and voil! However, if you want to insure you get the original Unicode string data, you still need to assign the returned memory contents directly to your String variable.

Option Explicit

Private Declare Function GetCommandLineA Lib _
	"kernel32" () As String
Private Declare Function GetCommandLineW Lib _
	"kernel32" () As Long

Private Declare Sub CopyMemory Lib "kernel32" _
	Alias "RtlMoveMemory" (pTo As Any, _
	uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib _
	"kernel32" (ByVal lpString As Long) As Long

Public Function ToString(Optional ForceUnicode _
	As Boolean = False) As String
	' Default (only) procedure
	If ForceUnicode Then
		ToString = _
			PointerToStringW(GetCommandLineW())
	Else
		ToString = GetCommandLineA()
	End If
End Function

Private Function PointerToStringW(lpStringW As _
	Long) As String
	Dim Buffer() As Byte
	Dim nLen As Long

	If lpStringW Then
		nLen = lstrlenW(lpStringW) * 2
		If nLen Then
			ReDim Buffer(0 To (nLen - 1)) As Byte
			CopyMemory Buffer(0), _
				ByVal lpStringW, nLen
			PointerToStringW = Buffer
		End If
	End If
End Function
