Tweet
I have code from Chris Boss, Pierre Bellisle, and Borje Hagsten, that all three demonstrate some functionality of an owner-drawn Combobox. Although nicely done, and well documented. However all three compile and run correctly only the 1st time. From that time on, unless I rename the *.bas file, I get the error "Destination file write error".
I have watched the process in process viewer, and they do disappear when I close the demo. But if I hit "Compile and Run" again, I get my error.
I have looked over the code of each but can not pick out what may be lingering in the system that I can not recompile?
Can anyone correct or show me the error? I get the same results if I compile for debug as well.
For ease of demonstrating the problem, each contributors code is seen below
Chris Boss
Pierre Bellisle
Borje Hagsten
I have watched the process in process viewer, and they do disappear when I close the demo. But if I hit "Compile and Run" again, I get my error.
I have looked over the code of each but can not pick out what may be lingering in the system that I can not recompile?
Can anyone correct or show me the error? I get the same results if I compile for debug as well.
For ease of demonstrating the problem, each contributors code is seen below
Chris Boss
Code:
#COMPILE EXE '#Win 8.03#
#DIM ALL
#INCLUDE "WIN32API.INC" '#2005-01-27#
%Combobox = 101
GLOBAL hDlg AS DWORD
GLOBAL hCombobox AS DWORD
'
' ---------------------------------------------------------------------------
' OwnerDraw Code By Chris Boss - put into Public Domain (2007)
' http://cwsof.com
' ---------------------------------------------------------------------------
' Simplfied OwnerDraw routines:
' ---------------------------------------------------------------------------
'
' ---------------------------------------------------------------------------
' lParam&: lParam value for %WM_DRAWITEM
' ItemNum&: returns item index number
' IText$: returns item text
' ---------------------------------------------------------------------------
'
FUNCTION OD_GetInfo(BYVAL lParam&, ItemNum&, IText$) AS LONG ' returns control ID number
LOCAL zT AS ASCIIZ * 1025
LOCAL ODR AS DRAWITEMSTRUCT PTR
ODR=lParam&
IF @ODR.CtlType=%ODT_COMBOBOX OR @ODR.CtlType=%ODT_LISTBOX THEN
ItemNum&[email protected]
IF @ODR.CtlType=%ODT_LISTBOX THEN
SendMessage @ODR.hwndItem, %LB_GETTEXT, ItemNum&, VARPTR(zT)
ELSE
IF (@ODR.itemState AND %ODS_COMBOBOXEDIT) = %ODS_COMBOBOXEDIT THEN
GetWindowText @ODR.hwndItem, zT, 1025
ELSE
SendMessage @ODR.hwndItem, %CB_GETLBTEXT, ItemNum&, VARPTR(zT)
END IF
END IF
IText$=zT
FUNCTION = @ODR.CtlID
END IF
END FUNCTION
'
' ---------------------------------------------------------------------------
' lParam&: lParam value from %WM_DRAWTEXT message
' IText$: Text for item
' TXColor&: text color (use -1 for default)
' BGColor&: background color (use -1 for default)
' TProp$: (properties) C - center text, R - right justify, L - left justify, M - multiline, F - show focus rectangle,
' ---------------------------------------------------------------------------
'
SUB OD_DrawText(BYVAL lParam&, BYVAL IText$, BYVAL TXColor&, BYVAL BGColor&, BYVAL TProp$)
LOCAL ODR AS DRAWITEMSTRUCT PTR, XFlag&
LOCAL hNewBrush&, TFormat&, RC AS RECT, LOffset&
ODR=lParam&
TProp$=UCASE$(TProp$)
LOffset&=8 ' left margin offset
IF @ODR.hdc<>0 THEN
SaveDC @ODR.hDC
IF (@ODR.itemState AND %ODS_SELECTED) = %ODS_SELECTED THEN
TXColor&=GetSysColor(%COLOR_HIGHLIGHTTEXT)
BGColor&=GetSysColor(%COLOR_HIGHLIGHT)
ELSE
IF TXColor&=-1 THEN TXColor&=GetSysColor(%COLOR_WINDOWTEXT)
IF BGColor&=-1 THEN BGColor&=GetSysColor(%COLOR_WINDOW)
END IF
hNewbrush&=CreateSolidBrush(BGColor&)
SelectObject @ODR.hDC, hNewbrush&
FillRect @ODR.hDC, @ODR.rcItem, hNewBrush&
SetBKColor @ODR.hDC, BGColor&
SetTextColor @ODR.hDC, TXColor&
RC = @ODR.rcItem
IF INSTR(TProp$, "R") THEN
TFormat&=TFormat& OR %DT_RIGHT
ELSE
IF INSTR(TProp$,"C") THEN TFormat&=TFormat& OR %DT_CENTER ELSE TFormat&=TFormat& OR %DT_LEFT
END IF
IF INSTR(TProp$, "M")=0 THEN
TFormat&=TFormat& OR %DT_SINGLELINE OR %DT_VCENTER
END IF
RC.nLeft=RC.nLeft+LOffset&
DrawText @ODR.hDC, BYVAL STRPTR(IText$), LEN(IText$), RC, TFormat&
IF (@ODR.itemState AND %ODS_FOCUS) = %ODS_FOCUS THEN
IF INSTR(TProp$,"F") THEN DrawFocusRect @ODR.hDC, @ODR.rcItem
END IF
RestoreDC @ODR.hDC, -1
DeleteObject hNewBrush&
END IF
END SUB
'
CALLBACK FUNCTION DlgProc
LOCAL ItemNum&, IText$
SELECT CASE CBMSG
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDOK
DIALOG END CBHNDL
CASE %Combobox
IF HIWRD(CBWPARAM) = %CBN_SELENDOK THEN
END IF
END SELECT
CASE %WM_DRAWITEM
SELECT CASE OD_GetInfo(CBLPARAM, ItemNum&, IText$) ' returns control ID #
CASE %Combobox
LOCAL C1&, C2&
C1&=RGB(0,0,0)
IF itemNum& MOD 2 = 1 THEN C2&=RGB(164,225,225) ELSE C2&=RGB(224,255,255)
OD_DrawText CBLPARAM, IText$, C1&, C2&, "LF"
CASE ELSE
END SELECT
CASE ELSE
END SELECT
END FUNCTION
'
FUNCTION PBMAIN
DIM ComboArray(0 TO 5) AS STRING
ComboArray(0) = "Black"
ComboArray(1) = "Green"
ComboArray(2) = "Red"
ComboArray(3) = "Brown"
ComboArray(4) = "Gray"
ComboArray(5) = "Yellow"
DIALOG NEW %HWND_DESKTOP, "Color Combo", , , 120, 80, %WS_SYSMENU TO hDlg
SetClassLong hDlg, %GCL_HICON, LoadIcon(BYVAL %NULL, BYVAL %IDI_INFORMATION) 'Have a nice icon
CONTROL ADD COMBOBOX, hDlg, %Combobox, ComboArray(), 10, 10, 100, 120, _
%CBS_OWNERDRAWFIXED OR %CBS_HASSTRINGS OR %CBS_DROPDOWNLIST OR _
%WS_TABSTOP OR %CBS_DISABLENOSCROLL OR %WS_VSCROLL
hCombobox = GetDlgItem(hDlg, %Combobox)
SendMessage(hCombobox, %CB_SETCURSEL, 0, 0)
CONTROL ADD BUTTON, hDlg, %IDOK, "&Close", 30, 35, 60, 14
DIALOG SHOW MODAL hDlg, CALL DlgProc
END FUNCTION
Code:
#COMPILE EXE '#Win 8.03#
#DIM ALL
#INCLUDE "WIN32API.INC" '#2005-01-27#
%Combobox = 101
GLOBAL hDlg AS DWORD
GLOBAL hCombobox AS DWORD
'______________________________________________________________________________
CALLBACK FUNCTION DlgProc
LOCAL lpdis AS DRAWITEMSTRUCT PTR
LOCAL zTxt AS ASCIIZ * 64
LOCAL rct AS RECT
LOCAL hBrush AS DWORD
LOCAL hBrushPrev AS DWORD
LOCAL SomeColor AS DWORD
SELECT CASE CBMSG
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDOK
DIALOG END CBHNDL
CASE %Combobox
IF HIWRD(CBWPARAM) = %CBN_SELENDOK THEN
END IF
END SELECT
CASE %WM_DRAWITEM
IF CBWPARAM = %Combobox THEN
lpdis = CBlParam
IF @lpdis.itemID <> -1 THEN 'Valid selection
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'Background color outside text area
IF @lpdis.itemID MOD 2 THEN
SomeColor = RGB(225, 225, 225)
ELSE
SomeColor = RGB(190, 190, 190)
END IF
hBrush = CreateSolidBrush(SomeColor)
hBrushPrev = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context
CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush)'Paint background color rectangle
CALL SelectObject(@lpdis.hDC, hBrushPrev) 'Select old brush back
CALL DeleteObject(hBrush) 'Delete brush
'Text fore color and text background color
CALL SendMessage(hCombobox, %CB_GETLBTEXT, @lpdis.itemID, VARPTR(zTxt)) 'Get text
CALL SetBkColor(@lpdis.hDC, SomeColor) 'Set text Background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'Set text color
CALL TextOut(@lpdis.hDC, 2, @lpdis.rcItem.ntop + 2, zTxt, LEN(zTxt)) 'Draw text
'If item is selected
IF (@lpdis.itemState AND %ODS_SELECTED) THEN 'If selected
rct.nLeft = 2 : rct.nRight = @lpdis.rcItem.nRight 'Set cordinates
rct.ntop = @lpdis.rcItem.ntop
rct.nbottom = @lpdis.rcItem.nbottom
CALL InvertRect(@lpdis.hDC, rct) 'Invert area around text only
CALL DrawFocusRect(@lpdis.hDC, @lpdis.rcItem) 'Draw a focus rectangle around all
END IF
END SELECT
FUNCTION = %TRUE
EXIT FUNCTION
END IF
END IF
END SELECT
END FUNCTION
'______________________________________________________________________________
FUNCTION PBMAIN
DIM ComboArray(0 TO 5) AS STRING
ComboArray(0) = "Black"
ComboArray(1) = "Green"
ComboArray(2) = "Red"
ComboArray(3) = "Brown"
ComboArray(4) = "Gray"
ComboArray(5) = "Yellow"
DIALOG NEW %HWND_DESKTOP, "Color Combo", , , 120, 80, %WS_SYSMENU TO hDlg
SetClassLong hDlg, %GCL_HICON, LoadIcon(BYVAL %NULL, BYVAL %IDI_INFORMATION) 'Have a nice icon
CONTROL ADD COMBOBOX, hDlg, %Combobox, ComboArray(), 10, 10, 100, 120, _
%CBS_OWNERDRAWFIXED OR %CBS_HASSTRINGS OR %CBS_DROPDOWNLIST OR _
%WS_TABSTOP OR %CBS_DISABLENOSCROLL OR %WS_VSCROLL
hCombobox = GetDlgItem(hDlg, %Combobox)
SendMessage(hCombobox, %CB_SETCURSEL, 0, 0)
CONTROL ADD BUTTON, hDlg, %IDOK, "&Close", 30, 35, 60, 14
DIALOG SHOW MODAL hDlg, CALL DlgProc
END FUNCTION
'_____________________________________________________________________________
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ComboBox Color list, ownerdrawn - by Borje Hagsten, January 2001.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Needed a goodlooking color pick Combo for a setup dialog, so wrote
' this one. Maybe could be useful for someone else, so.. :-)
'
' Thanks to: Chris Boss, for the original GetQBColor function.
' Public Domain, feel free to use and customize as you like.
' Code is commented, should be easy to follow. GDI stuff should be
' safe, no leaks. Still, as always, use at own "risk".. :-)
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Declares
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
#COMPILE EXE
#INCLUDE "WIN32API.INC"
%ID_LABEL1 = 100
%ID_COMBO1 = 120
GLOBAL oldCBproc AS LONG 'for subclassing, to hold original window procedure address
DECLARE CALLBACK FUNCTION DlgProc
DECLARE FUNCTION GetQBColor(BYVAL c AS LONG) AS LONG
DECLARE FUNCTION CBProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main dialog callback
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION DlgProc
SELECT CASE CBMSG
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDOK : DIALOG END CBHNDL 'Exit
CASE %ID_COMBO1
IF HIWRD(CBWPARAM) = %CBN_SELENDOK THEN
'You can trap changes in selection here, if needed. Uncomment
'the following code to see a way of picking selected color.
'Can also be used in other place, like checking before exit, etc.
'LOCAL col AS LONG 'returns selected color
'col = GetQBColor(SendMessage(CBLPARAM, %CB_GETCURSEL, 0, 0))
'MSGBOX "&H" + HEX$(col)
'FUNCTION = 0: EXIT FUNCTION
END IF
END SELECT
CASE %WM_DESTROY 'Un-subclass Combobox
IF oldCBproc THEN
SetWindowLong GetDlgItem(CBHNDL, %ID_COMBO1), %GWL_WNDPROC, oldCBproc
END IF
CASE %WM_DRAWITEM, %WM_MEASUREITEM 'Pass these on to CBproc
IF CBWPARAM = %ID_COMBO1 THEN
CBProc GetDlgItem(CBHNDL, %ID_COMBO1), CBMSG, CBWPARAM, CBLPARAM
FUNCTION = 0: EXIT FUNCTION
END IF
END SELECT
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Subclassed Combobox procedures
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION CBProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
SELECT CASE wMsg
CASE %WM_MEASUREITEM 'Don't need it here, keep it for ev. future use
CASE %WM_DRAWITEM
LOCAL hBrush AS LONG, hBrushOld AS LONG, rct AS RECT
LOCAL lpdis AS DRAWITEMSTRUCT PTR, zTxt AS ASCIIZ * 64
lpdis = lParam
IF @lpdis.itemID = -1 THEN EXIT FUNCTION
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'CLEAR BACKGROUND
hBrush = CreateSolidBrush(GetSysColor(%COLOR_WINDOW)) 'Create a background brush
hBrushOld = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context
CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush) 'Paint background color rectangle
CALL SelectObject(@lpdis.hDC, hBrushOld) 'Select old brush back
CALL DeleteObject(hBrush) 'Delete brush
'DRAW TEXT
CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW)) 'Set text Background
CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'Set text color
CALL SendMessage(hWnd, %CB_GETLBTEXT, @lpdis.itemID, VARPTR(zTxt)) 'Get text
CALL TextOut(@lpdis.hDC, 28, @lpdis.rcItem.ntop + 2, zTxt, LEN(zTxt)) 'Draw text
'SELECTED ITEM
IF (@lpdis.itemState AND %ODS_SELECTED) THEN 'if selected
rct.nLeft = 26 : rct.nRight = @lpdis.rcItem.nRight 'Set cordinates
rct.ntop = @lpdis.rcItem.ntop
rct.nbottom = @lpdis.rcItem.nbottom
CALL InvertRect(@lpdis.hDC, rct) 'invert area around text only
CALL DrawFocusRect(@lpdis.hDC, @lpdis.rcItem) 'and draw a focus rectangle around all
END IF
'PAINT COLOR RECTANGLE (using RoundRect for nicer looks.. :-)
' Here you can customize if you like - like BitBlt bitmaps via a memDC
' instead, or use DrawFrameControl to draw a "fake" checkbox, etc..
rct.nLeft = 4 : rct.nRight = 24 'Set cordinates
rct.ntop = @lpdis.rcItem.ntop + 2
rct.nbottom = @lpdis.rcItem.nbottom - 2
hBrush = CreateSolidBrush(GetQBColor(@lpdis.itemID)) 'Create brush with proper color
hBrushOld = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context
CALL RoundRect(@lpdis.hDC, rct.nLeft, rct.ntop, rct.nRight, rct.nbottom, 3, 3) 'Draw
CALL SelectObject(@lpdis.hDC, hBrushOld) 'Select old brush back
CALL DeleteObject(hBrush) 'Delete brush
END SELECT
FUNCTION = %TRUE : EXIT FUNCTION
END SELECT
FUNCTION = CallWindowProc(oldCBproc, hWnd, wMsg, wParam, lParam) 'process other messages
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Entrance - Create dialog and controls
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION PBMAIN
LOCAL hDlg AS LONG, I AS LONG, hCombo AS LONG
REDIM arr(15) AS STRING
DIALOG NEW 0, "Color Combo sample", , , 120, 80, %WS_SYSMENU TO hDlg
'Create items for list
arr(0) = "Black" : arr(1) = "Blue"
arr(2) = "Green" : arr(3) = "Cyan"
arr(4) = "Red" : arr(5) = "Magenta"
arr(6) = "Brown" : arr(7) = "Light Gray"
arr(8) = "Gray" : arr(9) = "Light Blue"
arr(10) = "Light Green" : arr(11) = "Light Cyan"
arr(12) = "Light Red" : arr(13) = "Light Magenta"
arr(14) = "Yellow" : arr(15) = "Bright White"
CONTROL ADD BUTTON, hDlg, %IDOK, "&Close", 30, 45, 60, 14
CONTROL ADD COMBOBOX, hDlg, %ID_COMBO1, arr(), 10, 10, 100, 120, _
%CBS_OWNERDRAWFIXED OR %CBS_HASSTRINGS OR %CBS_DROPDOWNLIST OR _
%WS_TABSTOP OR %CBS_DISABLENOSCROLL OR %WS_VSCROLL
CONTROL HANDLE hDlg, %ID_COMBO1 TO hCombo 'Subclass Combobox
IF hCombo THEN oldCBproc = GetWindowLong(hCombo, %GWL_WNDPROC)
IF oldCBproc THEN SetWindowLong hCombo, %GWL_WNDPROC, CODEPTR(CBProc)
CONTROL SEND hDlg, %ID_COMBO1, %CB_SETCURSEL, 10, 0 'Select an item, like 10..
DIALOG SHOW MODAL hDlg, CALL DlgProc
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Basic QB color function. "Borrowed" from larger GetQBColor function
' by Chris Boss. Thank you Chris, hope you don't mind.. :-)
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION GetQBColor(BYVAL c AS LONG) AS LONG
SELECT CASE c
CASE 0 : FUNCTION = RGB(0,0,0) ' Black
CASE 1 : FUNCTION = RGB(0,0,128) ' Blue
CASE 2 : FUNCTION = RGB(0,128,0) ' Green
CASE 3 : FUNCTION = RGB(0,128,128) ' Cyan
CASE 4 : FUNCTION = RGB(196,0,0) ' Red
CASE 5 : FUNCTION = RGB(128,0,128) ' Magenta
CASE 6 : FUNCTION = RGB(128,64,0) ' Brown
CASE 7 : FUNCTION = RGB(196,196,196) ' Light Gray
CASE 8 : FUNCTION = RGB(128,128,128) ' Gray
CASE 9 : FUNCTION = RGB(0,0, 255) ' Light Blue
CASE 10 : FUNCTION = RGB(0,255,0) ' Light Green
CASE 11 : FUNCTION = RGB(0,255,255) ' Light Cyan
CASE 12 : FUNCTION = RGB(255,0,0) ' Light Red
CASE 13 : FUNCTION = RGB(255,0,255) ' Light Magenta
CASE 14 : FUNCTION = RGB(255,255,0) ' Yellow
CASE 15 : FUNCTION = RGB(255,255,255) ' Bright White
END SELECT
END FUNCTION
Comment