#INCLUDE "sqlitening.inc"
MACRO bindt(str)=slbuildbinddat(str,"T")
FUNCTION PBMAIN AS LONG
LOCAL c,r,rows,cols AS LONG
cols = 50
rows = 2
REDIM s(1 TO cols,1 TO rows) AS STRING
slOpen "junk.db3","C"
slexe "create table if not exists t1(c1 text,c2 text,c3 text,c4 text,c5 text,c6 text,c7 text,c8 text,c9 text,c10 text,c11 text," +_
"c12 text,c13 text,c14 text,c15 text,c16 text,c17 text,c18 text,c19 text,c20 text,c21 text,c22 text,c23 text," +_
"c24 text,c25 text,c26 text,c27 text,c28 text,c29 text,c30 text,c31 text,c32 text,c33 text,c34 text,c35 text," +_
"c36 text,c37 text,c38 text,c39 text,c40 text,c41 text,c42 text,c43 text,c44 text,c45 text,c46 text,c47 text," +_
"c48 text,c49 text,c50 text)
FOR r = 1 TO rows
FOR c= 1 TO cols
s(c,r) = bindt(".") '<--- INSERT DATA (COLUMN,ROW)
NEXT
NEXT
slexe "begin exclusive"
slexebind "insert into t1 values(" + REPEAT$(cols-1,"?,") + "?)",JOIN$(s(),""),USING$("V#",UBOUND(s,1))
slexe "end"
LOCAL sRecordSet() AS STRING
slSelAry "select rowid, * from t1 order by rowid",sRecordSet(),"Q44"
? JOIN$(sRecordSet(),$CR)
END FUNCTION
eCode = GetLocalFile(sPicturePath, sPicture)
If eCode Then ? "Picture not found error." + Str$(eCode), %MB_SYSTEMMODAL Or %MB_ICONINFORMATION, VD_App.Title
Errorcode& = slExeBind(slBuildInsertOrUpdate("tblAntenatalBioData", "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & _
"?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & _
"?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & _
"?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?" & $Nul & "?"), _
slBuildBindDat(sHospitalNo, "T") & _
slBuildBindDat(sSurname, "T") & _
slBuildBindDat(sMaidenSurname, "T") & _
slBuildBindDat(sOthernames, "T") & _
slBuildBindDat(SQLiteDate(sDate), "T") & _
slBuildBindDat(sCategory, "T") & _
slBuildBindDat(SQLiteDate(sBirthDate), "T") & _
slBuildBindDat(sAge, "T") & _
slBuildBindDat(sConsultant, "T") & _
slBuildBindDat(SQLiteDate(sLMP), "T") & _
slBuildBindDat(SQLiteDate(sEDD), "T") & _
slBuildBindDat(sAddress, "T") & _
slBuildBindDat(sPhoneNo, "T") & _
slBuildBindDat(sEthnicGroup, "T") & _
slBuildBindDat(sOccupation, "T") & _
slBuildBindDat(sGravada, "T") & _
slBuildBindDat(sPara, "T") & _
slBuildBindDat(sKinName, "T") & _
slBuildBindDat(sKinAddress, "T") & _
slBuildBindDat(sKinPhoneNo, "T") & _
slBuildBindDat(sReligion, "T") & _
slBuildBindDat(sEnroleeNo, "T") & _
slBuildBindDat(SQLiteDate(sCardExpiryDate), "T") & _
slBuildBindDat(sPicturePath, "T") & _
slBuildBindDat(sMaritalStatus, "T") & _
slBuildBindDat(SQLiteDate(sMarriageDate), "T") & _
slBuildBindDat(sHusbandName, "T") & _
slBuildBindDat(sHusbandPhoneNo, "T") & _
slBuildBindDat(sHusbandOccupation, "T") & _
slBuildBindDat(sBloodGroup, "T") & _
slBuildBindDat(sBloodTransfusion, "T") & _
slBuildBindDat(sMenstrualCycle, "T") & _
slBuildBindDat(sGenotype, "T") & _
slBuildBindDat(sRhesus, "T") & _
slBuildBindDat(sSpecialComments, "T") & _
slBuildBindDat(sCardiacDisease, "T" ) & _
slBuildBindDat(sKidneyDisease, "T") & _
slBuildBindDat(sRheumaticDisease, "T" ) & _
slBuildBindDat(sMeasles, "T") & _
slBuildBindDat(sTuberculosis, "T") & _
slBuildBindDat(sOtherIllnesses, "T") & _
slBuildBindDat(sOperations, "T") & _
slBuildBindDat(sFamilyTuberculosis, "T") & _
slBuildBindDat(sDiabetes, "T") & _
slBuildBindDat(sHypertension, "T") & _
slBuildBindDat(sTwins, "T") & _
slBuildBindDat(sOtherDiseases, "T") & _
slBuildBindDat(sPicture, "B") & _
slBuildBindDat(gUsername, ("T")),"E")
#INCLUDE "sqlitening.inc"
GLOBAL gs AS STRING
FUNCTION PBMAIN AS LONG
slOpen "junk.db3"
slexe "drop table if exists parts"
slexe "create table if not exists parts(price integer)"
slexe "insert into parts values(1995),(1300),(4995),(101),(703)"
'if AS is used with same name as column with printf the order by will be alpha
rs "select printf('%.2f',price*.01) AS price from parts order by price"
'these order numerically
rs "select printf('%.2f',price*.01) from parts order by price" 'no AS
rs "select printf('%.2f',price*.01) AS price from parts order by parts.price" 'use table.column
rs "select printf('%.2f',price*.01) AS XYZ from parts order by price" 'AS different
? gs
END FUNCTION
FUNCTION rs(sql AS STRING) AS STRING
LOCAL sArray() AS STRING
IF ISFALSE(slSelAry(sql,sArray(),"Q9 E2")) THEN
gs+= JOIN$(sArray(),$CR) + $CR + $CR
ELSE
gs = "error:" + $CR + sql + $CR + $CR
END IF
END FUNCTION
#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