Code Select
#PBFORMS CREATED V2.01
#COMPILE EXE 'Save as "Modeless.bas" PBFORMS with Jose Roca includes
#DIM ALL
%UNICODE = 1
#INCLUDE ONCE "Windows.inc"
#INCLUDE ONCE "sqlitening.inc"
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#RESOURCE "modeless.pbr"
#PBFORMS END INCLUDES
GLOBAL ghDlg AS DWORD
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1 = 101
%LABEL1 = 1001
%TEXTBOX1 = 2001
%BTN_BUTTON1 = 3001
%TEXTBOX2 = 3002
#PBFORMS END CONSTANTS
#PBFORMS DECLARATIONS
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
SELECT CASE AS LONG CB.MSG
CASE %WM_INITDIALOG
ghDlg = CB.HNDL
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CB.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
SELECT CASE AS LONG CB.CTL
CASE %BTN_BUTTON1
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
LOCAL hThread AS LONG
THREAD CREATE SQLitening(0) TO hThread
THREAD CLOSE hThread TO hThread
END IF
END SELECT
CASE %WM_DESTROY
PostQuitMessage 0 'required with modeless Jose Roca message pump
EXIT FUNCTION
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
LOCAL hDlg AS DWORD
LOCAL hFont1 AS DWORD
LOCAL hFont2 AS DWORD
DIALOG NEW hParent, "", 72, 138, 919, 380, %WS_POPUP OR %WS_BORDER OR _
%WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR %DS_MODALFRAME OR _
%DS_CENTER 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 BUTTON, hDlg, %BTN_BUTTON1, "Execute", 5, 360, 50, 15
CONTROL ADD TEXTBOX, hDlg, %TEXTBOX1, "", 5, 25, 910, 265, %WS_CHILD OR _
%WS_VISIBLE OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE _
OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT _
OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LABEL, hDlg, %LABEL1, "Modeless DDT with Jose Roca includes", _
387, 5, 230, 20, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
%WS_EX_LTRREADING
CONTROL ADD TEXTBOX, hDlg, %TEXTBOX2, "select rowid,* from parts", 5, 300, _
725, 55, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
%WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR _
%ES_AUTOVSCROLL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
FONT NEW "MS Sans Serif", 10, 1, %ANSI_CHARSET TO hFont1
FONT NEW "Courier New", 12, 0, %ANSI_CHARSET TO hFont2
CONTROL SET FONT hDlg, %LABEL1, hFont1
CONTROL SET FONT hDlg, %TEXTBOX2, hFont2
#PBFORMS END DIALOG
DIALOG SHOW MODELESS hDlg, CALL ShowDIALOG1Proc TO lRslt
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
IF IsDialogMessage(hDlg, uMsg) = 0 THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
WEND '---------- End Jose Roca message pump
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
FONT END hFont1
FONT END hFont2
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
THREAD FUNCTION sqlitening(BYVAL x AS LONG) AS LONG
LOCAL s,sql,sdata2,sdata3,sArray() AS STRING
CONTROL SET TEXT ghDlg,%TEXTBOX1,s
slOpen "sample.db3","C"
CONTROL GET TEXT ghDlg,%TEXTBOX2 TO sql
IF sql = "select rowid,* from parts" THEN
sql = "select rowid as ROW,MANUF,REDREF,PRODUCT,LANGUAGE,CPU_OS,MEDIA,TYPE,PGROUP,printf('%.2f',price*.01) AS PRICE from parts"
END IF
slSelAry sql,sArray(),"Q9 E2 "
REDIM lTabStop(1 TO 9) AS LONG
lTabStop(1) = 22 'manuf
lTabStop(2) = 160 'redref
lTabStop(3) = 200 'product
lTabStop(4) = 440 'language
lTabStop(5) = 500 'cpu_os
lTabStop(6) = 540 'media
lTabstop(7) = 590 'type
lTabstop(8) = 640 'pgroup
lTabstop(9) = 820 'price
CONTROL SEND ghDlg,%TEXTBOX1,%EM_SETTABSTOPS,UBOUND(lTabStop), VARPTR(lTabStop(1))
s = JOIN$(sArray(),$CRLF)
LockWindow
CONTROL SET TEXT ghDlg,%TEXTBOX1,s 'fill textbox
REM CONTROL SEND ghDlg,%TEXTBOX1,%WM_VSCROLL,%SB_BOTTOM,0 'scroll to bottom of textbox
UnlockWindow
END FUNCTION
'_______________________________________________________________________________________________
FUNCTION rs(sql AS STRING) AS STRING
LOCAL sArray() AS STRING
IF slSelAry(sql,sArray(),"Q9 E2 c") THEN
? sql + $CR + slGetError,%MB_SYSTEMMODAL OR %MB_ICONERROR,"Recordset"
ELSE
FUNCTION=JOIN$(sArray(),$CR)
END IF
END FUNCTION
'_______________________________________________________________________________________________
FUNCTION LockWindow AS LONG
CONTROL SEND ghDlg, %TEXTBOX1,%WM_SETREDRAW,0,0
END FUNCTION
FUNCTION UnlockWindow AS LONG
CONTROL SEND ghDlg,%TEXTBOX1,%WM_SETREDRAW,1,0
END FUNCTION