GRAPHIC CLEAR and GRAPHIC CLEAR -1 seems to be failing.
According to the docs:
However, that does not seem to be the case:
According to the docs:
rgbColor&
Optional RGB value representing the fill color. If rgbColor& is omitted (or -1), the graphic target is cleared to the default background color for the selected graphic target
Optional RGB value representing the fill color. If rgbColor& is omitted (or -1), the graphic target is cleared to the default background color for the selected graphic target
Code:
#COMPILE EXE
DEFLNG A - Z
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
#INCLUDE "COMMCTRL.INC"
#ENDIF
#INCLUDE "PBForms.INC"
%IDD_DIALOG1 = 101
%LBX_Relations = 1001
%LBL_Relations = 1002
%GFX_Relations = 1003
%DLG_MESS = %WM_USER + 500
$NULSPC = CHR$(0 TO 32)
DECLARE FUNCTION Set_Box(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, Ag$(), Sz) AS LONG
DECLARE FUNCTION Relations_DLG(BYVAL hParent AS DWORD) AS LONG
DECLARE CALLBACK FUNCTION Relations_CB()
FUNCTION PBMAIN()
Relations_DLG %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION Relations_CB()
STATIC NumHeads AS DWORD
STATIC NumDatas AS DWORD
STATIC Nd AS DWORD
STATIC TxtWide AS DWORD
STATIC ChrWide AS DWORD
STATIC ChrHigh AS DWORD
STATIC NumAg AS DWORD
STATIC Dstart() AS DWORD
STATIC Dfield() AS DWORD
STATIC Dheads() AS STRING
STATIC Ddat() AS STRING
STATIC Abbr() AS STRING
STATIC Ag() AS STRING
STATIC Tribes() AS STRING
STATIC Dcat AS STRING
LOCAL DlgHnd AS DWORD
LOCAL CtlHnd AS DWORD
LOCAL Wparam AS LONG
LOCAL Lparam AS LONG
LOCAL CtlMess AS LONG
LOCAL A AS STRING
LOCAL B AS STRING
DlgHnd = CBHNDL
CtlHnd = CBCTL
Lparam = CBLPARAM
Wparam = CBWPARAM
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler
LOCAL TxtHigh AS LONG
DIM Ag$(1 TO 1)
DIM Dstart(1 TO 1)
DIM Dfield(1 TO 1)
DIM Dheads$(1 TO 1)
DIM Ddat$(1 TO 1)
CALL Agreements(Ag$(), NumAg)
' CALL Read_Db(CURDIR$ + "\gamedb\$Leaders.FDB", Numheads, NumDatas, Dstart(), _
' Dfield(), Dheads$(), Dcat$, Ddat$())
NumDatas = 9
DIM Tribes$(1 TO NumDatas)
' FOR I = 1 TO NumDatas
' Tribes$(I) = RTRIM$(MID$(Ddat$(I), Dstart(2), Dfield(2)), ANY $NULSPC)
' NEXT I
' CALL Read_Db(CURDIR$ + "\gamedb\$Relations.FDB", Numheads, Nd, Dstart(), _
' Dfield(), Dheads$(), Dcat$, Ddat$())
FOR I = 1 TO NumDatas
' IF VAL(MID$(Ddat$(I), Dstart(5), Dfield(5))) = 0 THEN Tribes$(I) = "?"
Tribes$(I) = "?"
NEXT I
'if Val(Mid$(Ddat$(1), Dstart(5), Dfield(5)) = 0 then
' DestroyWindow(DlgHnd)
'end if
Set_Box(DlgHnd, %LBX_Relations, Ag$(), NumAg)
GRAPHIC ATTACH DlgHnd, %GFX_Relations
' GRAPHIC CLEAR -1
' GRAPHIC Attach DlgHnd, %GFX_Relations, redraw
GRAPHIC COLOR RGB(128, 0, 0), -2
FONT NEW "courier new", 10, 3, 0, 1, 0 TO Fhndl
GRAPHIC SET FONT Fhndl
A$ = "0"
GRAPHIC CHR SIZE TO ChrWide, ChrHigh
ChrWide = ChrWide * 2
ChrHigh = ChrHigh * 2
' A$ = SPACE$(Dfield(2))
A$ = SPACE$(4)
GRAPHIC TEXT SIZE A$ TO TxtWide, TxtHigh
PostMessage(DlgHnd, %DLG_MESS, %LB_SETSEL, 1)
PostMessage(DlgHnd, %DLG_MESS, %LB_GETSEL, 0)
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE Wparam THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND
' Process control notifications
CtlMess = CBCTLMSG
SELECT CASE AS LONG CtlHnd
CASE %LBX_Relations
IF CtlMess = %LBN_SELCHANGE OR CtlMess = %LBN_DBLCLK THEN
CONTROL HANDLE DlgHnd, %LBX_Relations TO CtlHnd
Choice = SendMessage(CtlHnd, %LB_GETCURSEL, 0, 0) + 1
CONTROL SET TEXT DlgHnd, %LBL_Relations, Ag$(Choice)
GRAPHIC ATTACH DlgHnd, %GFX_Relations
' GRAPHIC CLEAR -1
' CALL Relations(DlgHnd, TxtWide, ChrWide, ChrHigh, Nd, NumDatas, _
' Dstart(), Dfield(), Ddat$(), Tribes$(), I)
'====================================================================
' AT THIS POINT GRAPHIC CLEAR should change the background color to white
' then back to gray. It doesn't.
'====================================================================
GRAPHIC CLEAR %WHITE
SLEEP 1000
GRAPHIC CLEAR -1
'====================================================================
X! = TxtWide + ChrWide
Y! = 0
GRAPHIC GET CLIENT TO Gfxx, Gfxy
FOR I = 1 TO NumDatas
GRAPHIC SET POS(X!, Y!)
GRAPHIC PRINT Tribes$(I)
Lx! = X! + TxtWide \ 2
Ly! = Y! + ChrHigh \ 2
IF Choice < 2 THEN
GRAPHIC LINE (Lx!, Ly!) - (Lx!, Gfxy), %BLUE
ELSE
'GRAPHIC LINE (Lx!, Ly!) - (Lx!, Gfxy), %RED
END IF
X! = X! + TxtWide + ChrWide
NEXT I
X! = 0!
Y! = ChrHigh
FOR I = 1 TO NumDatas
GRAPHIC SET POS(X!, Y!)
GRAPHIC PRINT Tribes$(I)
Lx! = X! + TxtWide + ChrWide
Ly! = Y! + ChrHigh \ 4
IF Choice < 2 THEN
GRAPHIC LINE (Lx!, Ly!) - (Gfxx, Ly!), %BLUE
END IF
Y! = Y! + ChrHigh
NEXT I
' GRAPHIC REDRAW
FUNCTION = 1
EXIT FUNCTION
END IF
END SELECT
CASE %DlG_MESS
IF Wparam = %LB_SETSEL THEN LISTBOX SELECT DlgHnd, %LBX_Relations, Lparam
IF Wparam = %LB_GETSEL THEN
Wparam = MAK(DWORD, %LBX_Relations, %LBN_DBLCLK)
CONTROL HANDLE DlgHnd, %LBX_Relations TO CtlHnd
Lparam = MAK(DWORD, CtlHnd, 0)
PostMessage(DlgHnd, %WM_COMMAND, Wparam, Lparam)
END IF
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
' ** Sample Code **
'------------------------------------------------------------------------------
FUNCTION Set_Box(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, Ag$(), Sz) AS LONG
LOCAL I AS LONG
FOR I = 1 TO Sz
LISTBOX ADD hDlg, lID, Ag$(I)
NEXT I
END FUNCTION
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION Relations_DLG(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Foreign Relations", 86, 55, 429, 223, %WS_OVERLAPPED _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD LISTBOX, hDlg, %LBX_Relations, , 5, 10, 95, 195, %WS_CHILD OR _
%WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %WS_HSCROLL OR %LBS_NOTIFY OR _
%LBS_HASSTRINGS, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LABEL, hDlg, %LBL_Relations, "War", 100, 10, 325, 10, _
%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
CONTROL ADD GRAPHIC, hDlg, %GFX_Relations, "", 110, 25, 315, 195
CONTROL SET COLOR hDlg, %LBL_Relations, RGB(0, 0, 128), -1 'RGB(128, 0, 0), -1
hFont1 = PBFormsMakeFont("Courier New", 12, 700, %FALSE, %FALSE, %FALSE, _
%ANSI_CHARSET)
CONTROL SEND hDlg, %LBL_Relations, %WM_SETFONT, hFont1, 0
DIALOG SHOW MODAL hDlg, CALL Relations_CB TO lRslt
FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB Agreements(Ag$(), Sz)
DATA "War"
DATA "Preferred Trading Partner"
DATA "Trade Embargos"
DATA "Mutual Protection Pact"
DATA "War Passage"
DATA "Safe Passage"
DATA "Trade Passage"
DATA "Worker Passage"
DATA "Military Alliances"
Sz = DATACOUNT
REDIM Ag$(1 TO Sz)
FOR I = 1 TO Sz
Ag$(I) = READ$(I)
NEXT I
END SUB
Comment