Show posts
Instead of killing and adding grid this version uses MLG_PUTEX
It also leaves the scroll bars on at all times using /D switch
It also leaves the scroll bars on at all times using /D switch
Code Select
#PBFORMS CREATED V2.01
#COMPILE EXE 'slMlg.bas
#DIM ALL
'----------------------------------------------------------------------------------------
GLOBAL ghDlg,hGrid AS LONG
#PBFORMS BEGIN INCLUDES
#RESOURCE "slMLG.pbr"
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE "COMMCTRL.INC"
#INCLUDE ONCE "PBForms.INC"
#PBFORMS END INCLUDES
#INCLUDE ONCE "mlg.inc"
#INCLUDE ONCE "sqlitening.inc"
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDC_GRID = 1009
%GridLabel = 1010
%TEXT_DATABASE = 1011
%TEXT_SQL = 1012
%LBL_DATABASE = 1013
%LBL_SQL = 1014
%BTN_RUN = 1015
%LBL_LABEL1 = 1016
%IDC_STATUSBAR1 = 1017
#PBFORMS END CONSTANTS
#PBFORMS DECLARATIONS
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
SUB Resize
LOCAL DialogWidth,DialogHeight AS LONG
LOCAL GridWidth ,GridHeight AS LONG
'get size of dialog
DIALOG GET SIZE ghDlg TO DialogWidth,DialogHeight
'get size of MLG
CONTROL GET SIZE ghDlg,%IDC_GRID TO GridWidth ,GridHeight 'grid width,height
IF GridWidth THEN 'if 0 then do not redraw
CONTROL SET SIZE ghDlg,%IDC_GRID, DialogWidth-14,GridHeight 'set grid width
CONTROL REDRAW ghDlg,%IDC_GRID
END IF
END SUB
CALLBACK FUNCTION ShowDIALOG1Proc()
LOCAL DialogWidth,DialogHeight AS LONG
LOCAL gridwidth,gridheight AS LONG
LOCAL SelStart,SelEnd AS LONG
SELECT CASE AS LONG CB.MSG
CASE %WM_EXITSIZEMOVE
Resize
CASE %WM_INITDIALOG
LOCAL s AS STRING
ghDlg = CB.HNDL
GridFromSQL
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CB.WPARAM THEN
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_CHAR
CASE %WM_COMMAND
SELECT CASE AS LONG CB.CTL
CASE %IDC_STATUSBAR1
CASE %TEXT_DATABASE
CASE %TEXT_SQL
IF CB.CTLMSG = %EN_SETFOCUS THEN 'SQL input control got focus
CONTROL SEND CB.HNDL, %TEXT_SQL,%EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd)
CONTROL SEND CB.HNDL, %TEXT_SQl,%EM_SETSEL,SelEnd,SelEnd
END IF
CASE %BTN_RUN
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
GridFromSQL
CONTROL SET FOCUS CB.HNDL,%TEXT_SQl
CONTROL SEND CB.HNDL, %TEXT_SQL,%EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd)
CONTROL SEND CB.HNDL, %TEXT_SQl,%EM_SETSEL,SelEnd,SelEnd
END IF
CASE %IDC_GRID
END SELECT
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
DIALOG NEW hParent, "", 286, 170, 768, 359, %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_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD TEXTBOX, hDlg, %TEXT_DATABASE, "sample.db3", 43, 297, 99, 13
CONTROL ADD TEXTBOX, hDlg, %TEXT_SQL, "select * from parts limit 234", 42, _
313, 441, 13
CONTROL ADD LABEL, hDlg, %GridLabel, "%GridLabel - Grid will display " + _
"here", 0, 0, 752, 260
CONTROL SET COLOR hDlg, %GridLabel, %WHITE, %BLUE
CONTROL ADD LABEL, hDlg, %LBL_DATABASE, "Database", 5, 297, 32, 11
CONTROL ADD LABEL, hDlg, %LBL_SQL, "SQL", 5, 315, 23, 10
CONTROL ADD BUTTON, hDlg, %BTN_RUN, "Run", 5, 329, 23, 10
CONTROL ADD LABEL, hDlg, %LBL_LABEL1, "Press Enter or click Run", 5, _
277, 324, 10
CONTROL ADD STATUSBAR, hDlg, %IDC_STATUSBAR1, "Rows 0 Columns 0", 0, 0, _
0, 0
#PBFORMS END DIALOG
CONTROL SET TEXT hDlg,%TEXT_SQL, _
"select manuf,redref,product,language,cpu_os,media,type,pgroup,printf('%.2f',price*.01) as PRICE from parts"
'DIALOG SET TEXT hdlg,EXE.NAME$
LOCAL Msg AS TagMsg
LOCAL flag AS LONG 'prevent grid displaying twice when we set focus
DIALOG SHOW MODELESS hDlg, CALL ShowDIALOG1Proc TO lRslt
DO WHILE GetMessage(Msg, %NULL, 0, 0)
IF IsDialogMessage(hDlg, Msg) = %FALSE THEN
TranslateMessage Msg
DispatchMessage Msg
END IF
IF msg.wparam = 13 THEN 'enter pressed in any control
'DIALOG SET TEXT ghDlg,USING$("ID # Counter #",GetDlgCtrlID(GetFocus),gCounter)
'IF GetDlgCtrlID(GetFocus) = %TEXT_SQL THEN 'in %TEXT_SQL control?
IF flag = 0 THEN GridFromSQL 'execute sql and MLG
flag = flag XOR 1 'toggle flag
'CONTROL SET FOCUS hDlg,%TEXT_SQL 'focus to sql input control
LOCAL selStart,SelEnd AS LONG
CONTROL SEND hDlg, %TEXT_SQL,%EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd)
CONTROL SEND hdlg, %TEXT_SQl,%EM_SETSEL,SelEnd,SelEnd
'END IF
CONTROL SET FOCUS hDlg,%TEXT_SQL 'always focus to sql input
END IF
LOOP WHILE ISWIN(hDlg)
FUNCTION = lRslt
END FUNCTION
FUNCTION GridFromSQL AS LONG
LOCAL rownum,colnum,rows,cols AS LONG
LOCAL x AS LONG,y AS LONG,gridwidth,gridheight AS LONG
LOCAL s AS STRING
LOCAL sDatabase AS STRING
LOCAL sql AS STRING
LOCAL sRecordSet() AS STRING
CONTROL GET TEXT ghDlg,%TEXT_DATABASE TO sDatabase
CONTROL GET TEXT ghDlg,%TEXT_SQL TO sql
slOpen sDatabase,"C E0" 'E0 we will handle open database error open/close database each time called
IF slGetErrorNumber THEN
? "Database name: " + WRAP$(sdataBase,$DQ,$DQ) + $CR + slGetError,%MB_SYSTEMMODAL,"SQL Open"
EXIT FUNCTION
END IF
slSelAry sql,sRecordSet(),"E0" 'E0 we will handle SQL error
IF slGetErrorNumber THEN
? CHR$(slGetError,$CR,"Database name: ",WRAP$(sdataBase,$DQ,$DQ),$CR,$CR,sql),%MB_SYSTEMMODAL,"SQL Error"
EXIT FUNCTION
END IF
rows = UBOUND(sRecordset,2) 'SQLitening(col,row) order
cols = UBOUND(sRecordset,1) 'SQLitening(col,row) order
REDIM RowsCols(rows,cols) AS STRING 'MLG(row,col) order
CONTROL GET LOC ghdlg,%GridLabel TO x,y
CONTROL GET SIZE ghdlg,%GridLabel TO gridwidth,gridheight
CONTROL SHOW STATE ghDlg, %GridLabel, %SW_HIDE 'must hide grid position label
STATIC newgrid AS LONG
IF newgrid = 0 THEN
newgrid = 1
CONTROL KILL ghDlg, %IDC_GRID 'start a fresh grid
s = USING$("r#/c#/d-0",Rows,cols) 'initial rows and columns /d-0 don't hide scrollbars
CONTROL ADD "MYLITTLEGRID", ghDlg, %IDC_GRID, s, x, y, gridwidth,gridheight, %MLG_STYLE
CONTROL HANDLE ghDlg, %IDC_GRID TO hGrid
#IF %DEF(%MLG_UNLOCK)
MLG_UNLOCK
#ENDIF
END IF
'Create MLG(Row,Col) from SQLitening(Col,Row)
FOR rownum = 0 TO rows
FOR colnum = 1 TO cols
RowsCols(rownum,colnum) = sRecordSet(colnum,rownum)
NEXT
NEXT
Mlg_PutEx hGrid,RowsCols(),-4,1 'put array to MLG in row,col order
FOR x = 1 TO UBOUND(RowsCols,2) 'column names should have been in grid?
MLG_PUT hGrid,0,x,RowsCols(0,x),1
NEXT
slClose
CONTROL SET TEXT ghDlg,%IDC_STATUSBAR1,USING$("Rows #, Columns #",rows,cols)
Resize
END FUNCTION