And one of my pet peeves is the humble LABEL widget. Microsoft does not call this widget a label, instead using the name STATIC, perhaps
because you can left and right click on it all day long and nothing will ever happen. I find this user operation incongruous since the
programmer can set the font face, attributes, size, text color, background color, border style, position and size of this widget at
both compile and run times but the poor user can effect no change at all.
Consider a user with vision impairment - would it not be beneficial for that user to be able to change the font face, size and color?
And what about the user who is sometimes operating in bright sunshine and sometimes in a darkened room - for example the bridge
of a ship at night. Would the ability to change colors of a label control not be beneficial?
The attached code demonstrates that it is indeed possible for the USER to select and set the font face, size, attributes and the text
and background colors. Other LABEL features such as the border style, size and position of the widget could also be changed by the
user but are not demonstrated in the supplied code.
Another of my pet peeves is the CHOOSEFONT dialog, specifically the text color is limited to just 16 options and the background color
cannot be selected at all. I have sub-classed the ChooseFont dialog so that both text and background colors can be selected by calling
the Windows standard ChooseColor dialog and the ChooseFont sample text is then presented in those colors.
In order to achieve this the rgbColors member of the ChooseFont structure has been re-purposed as a pointer to a UDT that holds two
integers in order to accommodate the text and background colors.
OPERATION
The code creates a small window with two labels (Standard and Enhanced). Right Click on the Enhanced Label and the ** NEW **
ChooseFont dialog will open allowing the font face, attributes, size, text and background colors for the label to be selected and set.
The code can be improved lots, it is still a work in progress - just thought I would share - maybe others have better ideas.
here fontSelect.rc
Code: Select all
#define frmLabels 1000
#define lblStandard 1001
#define lblEnhanced 1002
#define cmdExit 1004
#define cmdHelp 1003
frmLabels DIALOGEX 10,10,144,54
CAPTION "FontSelect Demo"
FONT 8,"MS Sans Serif",0,0,0
CLASS "DLGCLASS"
STYLE 0x10CA0000
BEGIN
CONTROL "Windows standard label",lblStandard,"Static",0x50001300,5,6,134,12
CONTROL "ring0 Enhanced label",lblEnhanced,"Static",0x50001300,5,22,134,12
CONTROL "EXIT",cmdExit,"Button",0x50010000,78,39,60,12
CONTROL "ABOUT",cmdHelp,"Button",0x50010000,6,39,60,12
END
Code: Select all
#Define frmLabels 1000
#Define lblStandard 1001
#Define lblEnhanced 1002
#Define cmdHelp 1003
#Define cmdExit 1004
Type ToColor ''' used with CHOOSEFONT structure
fore As DWORD32 ''' to SET and GET both
back As DWORD32 ''' TEXT and BACK color
End Type
Type textSize ''' used with GetTextExtentPoint32
As Long cx ''' to determine pixel size of
As Long cy ''' specified text string
End Type
Type StringDesc ''' used in drawSampleText
pointa As Zstring Ptr ''' actual string address
length As Integer ''' actual length of string
memory As Integer ''' amount of memory allocated for string
End Type
Dim Shared As ZString Ptr CommandLine ''' required by windoze
Dim Shared As HMODULE hInstance ''' required by windoze
Dim Shared As UINT32 iResult '''
Dim Shared As HWND hWinMain '''
Dim Shared As HWND hWin '''
'''
Dim Shared As HWND hEnhanced '''
Dim Shared As HDC staticHDC '''
'''
Dim Shared As HBRUSH bgBrush '''
Dim Shared As COLORREF crLblText '''
Dim Shared As COLORREF crLblBack '''
'''
Dim Shared As ChooseFont Ptr pCF '''
'''
Const ClassName="DLGCLASS" ''' required by windoze
Const AppName="Dialog as main" ''' required by windoze
Code: Select all
#Include Once "windows.bi"
#Include Once "win/winnt.bi"
#Include Once "win/commdlg.bi"
#Include Once "win/commctrl.bi"
#Include Once "FontSelect.bi"
Declare Function EnhancedSubClass(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As INT32,ByVal lParam As UINT32) As INT32
Declare Function selectFont(hWin As HWND,FontHandle As HFONT,BGcolor As INT32,FGcolor As INT32) As Any Ptr
Declare Function cfHookProc(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As Integer,ByVal lParam As Integer) As Integer
Declare Function selectColor(hWin As HWND,oldColor As COLORREF) As INT32
Declare Function setStaticColor(hWin As HWND,BGcolor As INT32) As BOOLEAN
Declare Function drawSampleText(fHDC As HDC,FontHandle As HFONT,BGcolor As UINT32,FGcolor As UINT32) As BOOL
Function WndProc(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As Integer
''' procedure for main window
Select Case uMsg
Case WM_INITDIALOG
''' definitions
hWinMain = hWin
hEnhanced = GetDlgItem(hWin,lblEnhanced)
staticHDC = GetDC(hEnhanced)
''' sub-class Enhanced static control to capture WM_RBUTTONDOWN
Dim As Long EnhancedProcOrg = SetWindowLong(hEnhanced,GWL_WNDPROC,Cast(DWORD,@EnhancedSubClass))
SetWindowLongPtr(hEnhanced,GWLP_USERDATA,EnhancedProcOrg)
Case WM_CTLCOLORSTATIC
''' Wparam = HDC of static
''' Lparam = HWND of static
Dim As COLORREF bgKolor
If lParam = hEnhanced Then
If pCF Then
''' we only want to set the colors here IF the user has actually selected colors
SetBkColor(Cast(HDC,wParam),crLblBack)
SetTextColor(Cast(HDC,wParam),crLblText)
''' if the application returns a brush that it created,
''' then the application must free that brush!
If bgBrush Then DeleteObject(bgBrush)
bgBrush = CreateSolidBrush(crLblBack)
Return Cast(Long,bgBrush)
EndIf
EndIf
Case WM_PAINT
Case WM_COMMAND
Select Case HiWord(wParam)
Case BN_CLICKED,1
Select Case LoWord(wParam)
Case lblStandard
''' nothing to see here, move along!
Case lblEnhanced
''' ignore left mouse button
''' right mouse button is captured and handled at EnhancedSubClass proc
Case cmdHelp
MessageBox(hWin,"Windows ChooseFont subclass demonstration by ring0","FontSelect",MB_ICONINFORMATION Or MB_OK)
Case cmdExit
SendMessage(hWin,WM_Close,0,0)
End Select
End Select
Case WM_CLOSE
''' The application should call the DeleteObject function to delete any font
''' when it is no longer needed; for example, after it destroys the control.
If bgBrush Then DeleteObject(bgBrush)
DestroyWindow(hWin)
Case WM_DESTROY
PostQuitMessage(NULL)
End Select
''' NB: if we don't do the following then CPU load = 50% for this process in Task Manager
Function = DefWindowProc(hWin,uMsg,wParam,lParam)
End Function
Function WinMain(ByVal hInst As HINSTANCE,ByVal hPrevInst As HINSTANCE,ByVal CmdLine As ZString ptr,ByVal CmdShow As Integer) As Integer
Dim As WNDCLASSEX wc
wc.cbSize = SizeOf(WNDCLASSEX)
wc.style = CS_HREDRAW or CS_VREDRAW Or CS_PARENTDC
wc.lpfnWndProc = @WndProc
wc.cbClsExtra = 0
wc.cbWndExtra = DLGWINDOWEXTRA
wc.hInstance = hInst
wc.hbrBackground = Cast(HBRUSH,COLOR_BTNFACE+1)
wc.lpszMenuName = NULL
wc.lpszClassName = @ClassName
wc.hIcon = LoadIcon(NULL,IDI_APPLICATION)
wc.hIconSm = wc.hIcon
wc.hCursor = LoadCursor(NULL,IDC_ARROW)
RegisterClassEx(@wc)
Dim As HWND hWin = CreateDialogParam(hInstance,Cast(ZString Ptr,frmLabels),NULL,@WndProc,NULL)
ShowWindow(hWin,SW_SHOWNORMAL)
UpdateWindow(hWin)
Dim msg As MSG
While (GetMessage(@msg,NULL,0,0) <> FALSE)
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
Return msg.wParam
End Function
''' Program start ----------------------------------------------------------
hInstance=GetModuleHandle(NULL)
CommandLine=GetCommandLine
InitCommonControls
WinMain(hInstance,NULL,CommandLine,SW_SHOWDEFAULT)
ExitProcess(0)
End
Function EnhancedSubClass(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As INT32,ByVal lParam As UINT32) As INT32
''' SubClass procedure for Enhanced Label - trap mouse right click and call SelectFont,
''' - on return set : Enhanced Label font and color attributes
''' : display selected font attributes at FormMain
Select Case uMsg
Case WM_RBUTTONDOWN
''' parse the font, size, attributes, fore and back colors to Windoze ChooseFont dialog
Dim As HFONT labelFont = SendMessage(hWin,WM_GETFONT,0,0)
Dim As INT32 labelFore = GetTextColor(staticHDC)
Dim As INT32 labelBack = GetPixel(GetDC(hWin),1,1)
pCF = selectFont(hWin,labelFont,labelBack,labelFore)
If pCF Then
Dim As ToColor Ptr p2C = Cast(ToColor Ptr,pCF -> rgbColors)
crLblBack = Cast(COLORREF,p2C -> back)
crLblText = Cast(COLORREF,p2C -> fore)
SetBkColor(staticHDC,crLblBack)
SetTextColor(staticHDC,crLblText)
Dim As LOGFONT Ptr pLF = pCF -> lpLogFont
Dim As hFont hUserFont = CreateFontIndirect(pLF)
SendMessage(hWin,WM_SETFONT,hUserFont,TRUE)
EndIf
Case Else
Dim As Any Ptr EnhancedProcOrg = Cast(UInteger Ptr,GetWindowLongPtr(hWin,GWLP_USERDATA))
Return CallWindowProc(EnhancedProcOrg,hWin,uMsg,wParam,lParam)
End Select
End Function
Function selectFont(hWin As HWND,FontHandle As HFONT,BGcolor As INT32,FGcolor As INT32) As Any Ptr
''' this function is a wrapper for the Windoze ChooseFont dialog
''' in particular cf.RGBcolors is now a pointer to UDT color type
Static As LOGFONT lf
GetObject(FontHandle,SizeOf(LOGFONT),@lf)
Dim cfColor As ToColor
cfColor.fore = FGcolor
cfColor.back = BGcolor
Static As ChooseFont cf
cf.lStructSize = SizeOf(cf)
cf.hwndOwner = hWin
cf.hDC = NULL '' used for printers
cf.lpLogFont = @lf
cf.iPointSize = 0 '' size of selected font on exit
cf.Flags = CF_SCREENFONTS Or CF_ENABLEHOOK Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT
' CF_EFFECTS causes Strikethru, Underline and text color options to be displayed
' CF_FIXEDPITCHONLY
cf.rgbColors = Cast(DWORD,@cfColor) '' selected color value
cf.lCustData = Cast(DWORD,@cf) '' lParam data passed to hook proc
cf.lpfnHook = @cfHookProc
cf.lpTemplateName = NULL
cf.hInstance = NULL
cf.lpszStyle = NULL '' required if CF_USESTYLE flag is specified
cf.nFontType = SCREEN_FONTTYPE
cf.nSizeMin = 0 '' required if CF_LIMITSIZE flag is specified
cf.nSizeMax = 0 '' required if CF_LIMITSIZE flag is specified
ChooseFont(@cf)
If cf.iPointSize Then
Return @cf
Else
Return 0
EndIf
End Function
Function cfHookProc(ByVal hWin As HWND,_
ByVal uMsg As UINT,_
ByVal wParam As Integer,_
ByVal lParam As Integer) As Integer
''' this function is the hook procedure for Windoze ChooseFont dialog
''' if this hook procedure returns zero, the default dialog box procedure processes the message.
''' if this hook procedure returns a nonzero value, the default dialog box procedure ignores the message.
Static As ZString Ptr pszFace
Static As ChooseFont Ptr pCF
Static As LOGFONT Ptr pLF
Static As COLORREF crBack
Static As COLORREF crFore
Static As UINT32 iHeight
Static As UINT32 iWeight
Static As HFONT hFontSample
Static As HWND hWinCF
Static As HDC CF_HDC
Static As BOOL bStrike
Static As BOOL bItalic
Static As BOOL bUnder
Static As BOOL bOK
Select Case uMsg
Case WM_INITDIALOG
''' LPARAM = pointer to CHOOSEFONT structure
pCF = Cast(ChooseFont Ptr,lParam)
pLF = pCF -> lpLogFont
iHeight = pLF -> lfHeight
bOK = FALSE
hWinCF = hWin
CF_HDC = GetDC(hWin)
Dim As ToColor Ptr pMyColors = Cast(ToColor Ptr,pCF -> rgbColors)
crBack = pMyColors -> back Or &H80000000
crFore = pMyColors -> fore Or &H80000000
Dim As handle hFont = SendDlgItemMessage(hWin,1136,WM_GETFONT,0,0)
pszFace = Callocate(33,SizeOf(Byte)) ''' face name string
ShowWindow(GetDlgItem(hWin,&H473),SW_HIDE) ''' Color label
ShowWindow(GetDlgItem(hWin,&H443),SW_HIDE) ''' Color combo
CreateWindow("Button","Set Text Color",WS_CHILD Or WS_VISIBLE,18,223,100,18,hWin,1501,GetModuleHandle(0),0)
Dim As HWND hFore = CreateWindow("STATIC","",WS_CHILD Or WS_VISIBLE Or SS_SUNKEN Or SS_NOTIFY,128,224,20,17,hWin,1502,0,NULL)
SetWindowLong(hFore,GWL_USERDATA,Cast(Long,crFore))
CreateWindow("Button","Set Back Color",WS_CHILD Or WS_VISIBLE,18,245,100,18,hWin,1503,GetModuleHandle(0),0)
Dim As HWND hBack = CreateWindow("STATIC","",WS_CHILD Or WS_VISIBLE Or SS_SUNKEN Or SS_NOTIFY,128,245,20,17,hWin,1504,0,NULL)
SetWindowLong(hBack,GWL_USERDATA,Cast(Long,crBack))
SendDlgItemMessage(hWin,1501,WM_SETFONT,hFont,TRUE)
SendDlgItemMessage(hWin,1502,WM_SETFONT,hFont,TRUE)
SendDlgItemMessage(hWin,1503,WM_SETFONT,hFont,TRUE)
SendDlgItemMessage(hWin,1504,WM_SETFONT,hFont,TRUE)
SetWindowPos(GetDlgItem(hWin,1),HWND_TOP,210,285,0,0,SWP_NOZORDER Or SWP_NOSIZE) ''' OK
SetWindowPos(GetDlgItem(hWin,2),HWND_TOP,100,285,0,0,SWP_NOZORDER Or SWP_NOSIZE) ''' CANCEL
SetWindowPos(hWin,HWND_TOP,0,0,350,346,SWP_NOMOVE Or SWP_NOZORDER) ''' FORM
Case WM_ERASEBKGND
''' sent for example when the window must be resized.
''' is NOT sent prior to a BitBlt
Case WM_CTLCOLORDLG
''' sent to a dialog box before windows draws the dialog box
''' allow user to set the background color of the dialog box
Case WM_CTLCOLORSTATIC
''' Wparam = HDC static
''' Lparam = HWND static
Static As HBRUSH bgBrush
Dim As COLORREF bgKolor
bgKolor = Cast(COLORREF,GetWindowLong(Cast(HWND,lParam),GWLP_USERDATA))
If bgKolor Then
If bgBrush Then DeleteObject(bgBrush)
bgBrush = CreateSolidBrush(bgKolor And &HFFFFFF)
Return Cast(Long,bgBrush)
EndIf
Case WM_PAINT
''' Wparam = HDC
''' always arrives here with WPARAM = 0 when Sample Text is to be re-drawn
''' we capture all the font parameters and post a message to ourself, then
''' allow the ChooseFont dialog default code to execute.
''' After that is complete we receive the message we sent and can then
''' process and display the full color version of sample text.
''' Case 1136: ''' font face name combo box
iResult = SendDlgItemMessage(hWin,1136,CB_GETCURSEL,0,0)
SendDlgItemMessage(hWin,1136,CB_GETLBTEXT,iResult,pszFace)
''' Case 1137: ''' font attribute combo box
iResult = SendDlgItemMessage(hWin,1137,CB_GETCURSEL,0,0)
Dim As UINT32 iLength = SendDlgItemMessage(hWin,1137,CB_GETLBTEXTLEN,iResult,0)
Dim As ZString Ptr pszAttr = Callocate(iLength+1,SizeOf(Byte))
SendDlgItemMessage(hWin,1137,CB_GETLBTEXT,iResult,pszAttr)
Dim As UByte iByte = pszAttr[0]
Select Case iByte
Case 66 ''' Black / Bold / Bold Oblique
If pszAttr[1] = 108 Then ''' Black
iWeight = 900
bItalic = FALSE
EndIf
If pszAttr[1] = 111 Then ''' Bold
iWeight = 700
bItalic = FALSE
EndIf
If iLength > 6 Then ''' Bold Oblique
iWeight = 700
bItalic = TRUE
EndIf
Case 73 ''' Italic
bItalic = TRUE
Case 78 ''' Narrow / Narrow Italic / Narrow Bold / Narrow Bold Italic
If iLength > 13 Then ''' Narrow Bold Italic
iWeight = 700
bItalic = TRUE
Else
If iLength > 6 Then ''' Narrow Italic
If pszAttr[7] = 73 Then
iWeight = 400
bItalic = TRUE
EndIf
If pszAttr[7] = 66 Then ''' Narrow Bold
iWeight = 700
bItalic = FALSE
EndIf
Else
iWeight = 400
bItalic = FALSE
EndIf
EndIf
Case 79 ''' Oblique
iWeight = 400
bItalic = TRUE
Case 82 ''' Regular
iWeight = 400
bItalic = FALSE
End Select
PostMessage(hWin,WM_APP,0,0)
Case WM_COMMAND
Select Case LoWord(wParam)
Case 1 ''' OK
pCF -> iPointSize = iHeight
Dim As ToColor Ptr pToColor = pCF -> rgbColors
pToColor -> back = crBack
pToColor -> fore = crFore
pLF -> lfHeight = iHeight
pLF -> lfWeight = iWeight
pLF -> lfItalic = bItalic
pLF -> lfUnderline = bUnder
pLF -> lfStrikeOut = bStrike
bOK = TRUE
SendMessage(hWin,WM_COMMAND,MAKEWPARAM(2,BN_CLICKED),GetDlgItem(hWin,2))
Return 1
Case 2 ''' CANCEL
If bOK = FALSE Then ''' we really do cancel
pCF -> iPointSize = 0
EndIf
Case 1138: ''' font size combo box
iResult = SendDlgItemMessage(hWin,1138,CB_GETCURSEL,0,0)
Dim As String sSize = " " ''' allocate space
Dim As StringDesc Ptr psd = CPtr(StringDesc Ptr,@sSize)
SendDlgItemMessage(hWin,1138,CB_GETLBTEXT,iResult,psd->pointa)
iHeight = ValUInt(sSize)
Case 1040: ''' font strikeout check box
bStrike = SendDlgItemMessage(hWin,1040,BM_GETCHECK,0,0)
Case 1041: ''' font underline check box
bUnder = SendDlgItemMessage(hWin,1041,BM_GETCHECK,0,0)
Case 1501, 1502: ''' text color
Dim As INT32 iResult = selectColor(hWin,crFore)
If iResult <> -1 Then
SetWindowLong(GetDlgItem(hWin,1502),GWL_USERDATA,Cast(Long,iResult))
setStaticColor(GetDlgItem(hWin,1502),iResult)
crFore = iResult
GoTo showSample
EndIf
Case 1503,1504: ''' back color
iResult = selectColor(hWin,crBack)
If iResult <> -1 Then
SetWindowLong(GetDlgItem(hWin,1504),GWL_USERDATA,Cast(Long,iResult))
setStaticColor(GetDlgItem(hWin,1504),iResult)
crBack = iResult
GoTo showSample
EndIf
End Select
Case WM_APP
GoTo showSample
End Select
Return 0
showSample:
If hFontSample Then DeleteObject(hFontSample)
hFontSample = CreateFont(iHeight,0,0,0,_
iWeight,bItalic,bUnder,bStrike,_
ANSI_CHARSET,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,_
DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,pszFace)
drawSampleText(CF_HDC,hfontSample,crBack,crFore)
Return 0
End Function
Function selectColor(hWin As HWND,oldColor As COLORREF) As INT32
''' wrapper for Windoze chooseColor dialog
''' return value is INT32 so that we can return -1 if user selects CANCEL
Static As COLORREF customColor(0 To 15)
Dim As ChooseColor cc
cc.lStructSize = SizeOf(cc)
cc.hwndOwner = hWin
cc.hInstance = NULL
cc.rgbResult = oldColor
cc.lpCustColors = @customColor(0)
cc.Flags = CC_FULLOPEN Or CC_RGBINIT
cc.lCustData = NULL
cc.lpfnHook = NULL
cc.lpTemplateName = NULL
If ChooseColor(@cc) Then
Return cc.rgbResult
Else
Return -1
EndIf
End Function
Function setStaticColor(hWin As HWND,BGcolor As INT32) As BOOLEAN
Dim As HDC staticDC = GetDC(hWin)
Dim As RECT staticRECT
GetClientRect(hWin,@staticRECT)
Dim As HBRUSH newBrush = CreateSolidBrush(BGcolor)
Dim As HBRUSH oldBrush = SelectObject(staticDC,newBrush)
''' by filling the rect we brush over any text
FillRect(staticDC,@staticRect,newBrush)
SelectObject(staticDC,oldBrush)
DeleteObject(newBrush)
ReleaseDC(hWin,staticDC)
''' set MSB so we know a color has been set - even if the color is zero!!
BGcolor = BGcolor Or &H80000000
SetWindowLong(hWin,GWL_USERDATA,Cast(Long,BGcolor))
Return TRUE
End Function
Function drawSampleText(fHDC As HDC,FontHandle As HFONT,BGcolor As UINT32,FGcolor As UINT32) As BOOL
Static As HDC hdcMemSample
Static As HBITMAP bmpMemSample
Static As COLORREF fHDC_Color
If hdcMemSample Then
DeleteDC(hdcMemSample)
DeleteObject(bmpMemSample)
EndIf
If FontHandle Then
fHDC_Color = GetBkColor(fHDC)
hdcMemSample = CreateCompatibleDC(NULL)
Dim As String sSample = "aAbByYzZ"
Dim As StringDesc Ptr pSampleData = CPtr(StringDesc Ptr,@sSample)
Dim As UINT32 textLong = pSampleData->length ''' number of characters in string
Dim As HFONT hdcMemFont = SelectObject(hdcMemSample,FontHandle)
DeleteObject(hdcMemFont)
''' we always make the bitmap at least large enough to accomodate the sample text
''' but never smaller than the size of the sample text display area so that we
''' will always cover whatever was there before.
Dim As textSize newSize
GetTextExtentPoint32(hdcMemSample,pSampleData->pointa,textLong,@newSize)
Dim As UINT32 bmpSizeX, bmpSizeY
Dim As UINT32 bmpDrawX, bmpDrawY
If newSize.cx < 157 Then
bmpSizeX = 157
bmpDrawX = (157 - newSize.cx)\2
Else
bmpSizeX = newSize.cx
bmpDrawX = 0
EndIf
If newSize.cy < 48 Then
bmpSizeY = 48
bmpDrawY = (48 - newSize.cy)\2
Else
bmpSizeY = newSize.cy
bmpDrawY = 0
EndIf
bmpMemSample = CreateBitmap(bmpSizeX,bmpSizeY,1,32,NULL)
Dim As HBITMAP bmpMemFirst = SelectObject(hdcMemSample,bmpMemSample)
DeleteObject(bmpMemFirst)
''' flood fill the bitmap with backgound color
Dim As HPEN newPen = CreatePen(PS_SOLID,1,Cast(COLORREF,BGcolor And &HFFFFFF))
Dim As HPEN oldPen = SelectObject(hdcMemSample,newPen)
DeleteObject(oldPen)
Dim As HBRUSH oldBrush = SelectObject(hdcMemSample,CreateSolidBrush(BGcolor And &HFFFFFF))
DeleteObject(oldBrush)
Rectangle(hdcMemSample,0,0,bmpSizeX,bmpSizeY)
''' write the text to memory bitmap
SetBkColor(hdcMemSample,Cast(COLORREF,BGcolor And &HFFFFFF))
SetTextColor(hdcMemSample,Cast(COLORREF,FGcolor And &HFFFFFF))
''' TextOut is 3.6x faster than DrawText even after using Len function and DT_NOCLIP flag.
TextOut(hdcMemSample,bmpDrawX,bmpDrawY,pSampleData->pointa,textLong)
''' if the new bitmap is larger than the size of the sample box then only show the centre
Dim As UINT32 xSource = 0
If newSize.cx > 157 Then xSource = (newSize.cx - 157)\2
Dim As UINT32 ySource = 0
If newSize.cy > 48 Then ySource = (newSize.cy - 48)\2
BitBlt(fHDC,173,173,157,48,hdcMemSample,xSource,ySource,SRCCOPY)
Return TRUE
EndIf
Return FALSE
End Function