postgres add/edit/delete gui example

Its a bit hackie with any luck in future list box will
support multi columns

does anyone know the best way to implement some kind of
string grid type gadget? I'm not too keen on the multi
column list box as I can only stop column 0 resizing
by modding the gui module source and it shows lines
below the item lines

Once I've hacked together some kind of string grid I'd like
to make a module of data bound gui gadgets

Strict 

' thanks to ziltch for working out multi column listbox's

Import "libpq.a"

Extern "win32"
	Function SendMessage:Int(hWnd:Int,MSG:Int,wParam:Int,lParam:Int) = "SendMessageA@16"
	Function SetWindowLong:Int(hWnd ,nIndex,lNewLong )= "SetWindowLongA@12"
	Function GetWindowLong :Int(hWnd ,nIndex)= "GetWindowLongA@8"
End Extern



Const CONNEVTION_GOOD:Int=0
Const CONNECTION_BAD:Int=1
Const PGRES_TUPLES_OK:Int=2
Const PGRES_COMMAND_OK:Int=1

Extern
	Function PQconnectdb(s$z)
	Function PQstatus:Int(conn:Int)
	Function PQerrorMessage$z(conn:Int)
	Function PQexec:Int(conn:Int, query_string$z)
	Function PQresultStatus:Int(res:Int)
	Function PQclear(res:Int)
  Function PQfinish(conn:Int)
  Function PQgetvalue$z(res:Int,i:Int,n:Int)
	Function PQntuples:Int(res:Int) 
EndExtern

' assumes a table that will accept 
' insert into customers (surname,dob) values ('brown','1971-2-20')

Rem
-- Table: customers

-- DROP TABLE customers;

CREATE TABLE customers
(
  id int8 NOT NULL DEFAULT nextval('customers_id_seq'::regclass),
  dob date,
  surname text[],
  CONSTRAINT "primary key" PRIMARY KEY (id)
) 
WITHOUT OIDS;
ALTER TABLE customers OWNER TO postgres;

EndRem

Const LBS_DISABLENOSCROLL = 4096
Const LBS_EXTENDEDSEL = $800
Const LBS_HASSTRINGS = 64
Const LBS_MULTICOLUMN = 512
Const LBS_MULTIPLESEL = 8
Const LBS_NODATA	= $2000
Const LBS_NOINTEGRALHEIGHT = 256
Const LBS_NOREDRAW = 4
Const LBS_NOSEL =  $4000
Const LBS_NOTIFY  = 1
Const LBS_OWNERDRAWFIXED = 16
Const LBS_OWNERDRAWVARIABLE = 32
Const LBS_SORT = 2
Const LBS_STANDARD = $a00003
Const LBS_USETABSTOPS = 128
Const LBS_WANTKEYBOARDINPUT = $400


Const LVM_FIRST = $1000
Const LVM_GETITEMTEXTA = (LVM_FIRST + 45)
Const LVM_GETCOLUMNA	=(LVM_FIRST+25)
Const LVM_GETCOLUMNW	=(LVM_FIRST+95)
Const LVM_SETCOLUMNA	=(LVM_FIRST+26)
Const LVM_SETCOLUMNW	=(LVM_FIRST+96)
Const LVM_INSERTCOLUMNA	=(LVM_FIRST+27)
Const LVM_INSERTCOLUMNW	=(LVM_FIRST+97)
Const LVM_DELETECOLUMN	=(LVM_FIRST+28)
Const LVM_GETCOLUMNWIDTH	=(LVM_FIRST+29)
Const LVM_GETITEMA	= (LVM_FIRST+5)
Const LVM_GETITEMW	= (LVM_FIRST+75)
Const LVM_SETITEMA	= (LVM_FIRST+6)
Const LVM_SETITEMW	= (LVM_FIRST+76)
Const LVM_INSERTITEMA	= (LVM_FIRST+7)
Const LVM_INSERTITEMW	= (LVM_FIRST+77)
Const LVM_DELETEITEM	= (LVM_FIRST+8)
Const LVM_DELETEALLITEMS	= (LVM_FIRST+9)
Const LVM_GETCALLBACKMASK	= (LVM_FIRST+10)
Const LVM_SETCALLBACKMASK	=(LVM_FIRST+11)
Const LVM_SETCOLUMNWIDTH	=(LVM_FIRST+30)
Const LVM_GETTEXTCOLOR	=(LVM_FIRST+35)
Const LVM_SETTEXTCOLOR	=(LVM_FIRST+36)
Const LVM_GETTEXTBKCOLOR	=(LVM_FIRST+37)
Const LVM_SETTEXTBKCOLOR=	(LVM_FIRST+38)
Const LVM_INSERTCOLUMN       = LVM_FIRST + 27
Const LVM_INSERTITEM         = LVM_FIRST + 7
Const LVM_SETITEM            = LVM_FIRST + 6
Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54  ' optional wParam == mask
Const LVM_SETSELECTIONMARK    = LVM_FIRST + 67
Const LVM_GETITEMSTATE       = LVM_FIRST + 44
Const  LVM_SORTITEMS          = LVM_FIRST + 48
Const  LVM_GETITEMCOUNT       = LVM_FIRST + 4
Const LVM_GETITEM            = LVM_FIRST + 5
Const LVM_ENSUREVISIBLE      = LVM_FIRST + 19

Const LVCFMT_LEFT            = 0
Const LVCFMT_RIGHT           = $1
Const LVCFMT_CENTER          = $2
Const LVCFMT_JUSTIFYMASK     = $3
Const LVCFMT_IMAGE           = $800
Const LVCFMT_BITMAP_ON_RIGHT = $1000
Const LVCFMT_COL_HAS_IMAGES  = $8000

Const LVCF_FMT	=1
Const LVCF_WIDTH	=2
Const LVCF_TEXT	=4
Const LVCF_SUBITEM	=8
Const LVCF_IMAGE= 16
Const LVCF_ORDER =32
'Const LVIF_TEXT = 1

Const LVS_ICON             =0
Const LVS_REPORT	        =1
Const LVS_SMALLICON	        =2
Const LVS_LIST	            =3
Const LVS_TYPEMASK         =3
Const LVS_SINGLESEL        =4
Const LVS_SHOWSELALWAYS    =8
Const LVS_SORTASCENDING    =16
Const LVS_SORTDESCENDING   =32
Const LVS_SHAREIMAGELISTS	=64
Const LVS_NOLABELWRAP      =128
Const LVS_AUTOARRANGE      =256
Const LVS_EDITLABELS       =512
Const LVS_NOSCROLL         =$2000
Const LVS_TYPESTYLEMASK    =$fc00
Const LVS_ALIGNTOP	        =0
Const LVS_ALIGNLEFT	       =$800
Const LVS_ALIGNMASK	       =$c00
Const LVS_OWNERDRAWFIXED  =$400
Const LVS_NOCOLUMNHEADER  =$4000
Const LVS_NOSORTHEADER	   =$8000
Const GWL_STYLE      = -16

Const LVS_EX_GRIDLINES        = $00000001
Const LVS_EX_SUBITEMIMAGES    = $00000002
Const LVS_EX_CHECKBOXES       = $00000004
Const LVS_EX_TRACKSELECT      = $00000008
Const LVS_EX_HEADERDRAGDROP   = $00000010
Const LVS_EX_FULLROWSELECT    = $00000020 ' applies to report mode only
Const LVS_EX_ONECLICKACTIVATE = $00000040
Const LVS_EX_TWOCLICKACTIVATE = $00000080
Const LVS_EX_FLATSB           = $00000100
Const LVS_EX_REGIONAL         = $00000200
Const LVS_EX_INFOTIP          = $00000400 ' listview does InfoTips for you
Const LVS_EX_UNDERLINEHOT     = $00000800
Const LVS_EX_UNDERLINECOLD    = $00001000
Const LVS_EX_MULTIWORKAREAS   = $00002000
Const LVS_EX_LABELTIP         = $00004000 ' listview unfolds partly hidden labels if it does not have infotip text
Const LVS_EX_BORDERSELECT     = $00008000 ' border selection style instead of highlight
Const LVS_EX_DOUBLEBUFFER     = $00010000
Const LVS_EX_HIDELABELS       = $00020000
Const LVS_EX_SINGLEROW        = $00040000
Const LVS_EX_SNAPTOGRID       = $00080000 ' Icons automatically snap to grid.
Const LVS_EX_SIMPLESELECT     = $00100000 ' Also changes overlay rendering to top right for icon mode.

Const LVIF_TEXT              = $0001
Const LVIF_IMAGE             = $0002
Const LVIF_PARAM             = $0004
Const LVIF_STATE             = $0008
Const LVIF_INDENT            = $0010
Const LVIF_NORECOMPUTE       = $0800
Const LVIF_GROUPID           = $0100
Const LVIF_COLUMNS           = $0200

Type  LVCOLUMN  
	Field mask
	Field fmt
	Field cx
	Field pszText:Byte Ptr'LPTSTR 
	Field cchTextMax
	Field iSubItem
EndType

Type LVITEM 
	Field mask
	Field iItem
	Field iSubItem
	Field iState
	Field stateMask
	Field pszText:Byte Ptr
	Field cchTextMax
	Field iImage
	Field lParam
	Field iIndent
	Field iGroupId
	Field cColumns
	Field puColumns
EndType





Function makeheaders(listbox:TGadget)
	Local ListboxHwnd=QueryGadget(listbox,QUERY_HWND)
	Local colum:LVCOLUMN = New LVCOLUMN

	colum.mask = LVCF_FMT | LVCF_WIDTH | LVCF_TEXT | LVCF_SUBITEM

	colum.iSubItem = 0
	colum.fmt = LVCFMT_LEFT
		
		
	Local nr

' had to leave the initial blank cell because 1st column always
' resizes when the horisontal scrollbar goes
'	SendMessageA(ListboxHwnd, LVM_DELETECOLUMN,0,0)
	
	colum.pszText = "ID".ToCString()
	colum.cx= 120		
	SendMessageA(ListboxHwnd, LVM_INSERTCOLUMN, nr,Int(Byte Ptr colum))
	MemFree colum.pszText

	nr:+1		
 	colum.pszText = "Surname".ToCString()
	colum.cx= 80
	SendMessageA(ListboxHwnd, LVM_INSERTCOLUMN, nr,Int(Byte Ptr colum))
	MemFree colum.pszText	

	nr:+1
 	colum.pszText = "DOB".ToCString()
	colum.cx= 69
	SendMessageA(ListboxHwnd, LVM_INSERTCOLUMN, nr,Int(Byte Ptr colum))
	MemFree colum.pszText
	

End Function


Function AddRow(listBox:tgadget,row)
		Local ListboxHwnd=QueryGadget(listbox,QUERY_HWND)
		Local  lvI:LVITEM = New LVITEM 

		lvI.iItem = row 
		lvI.mask =  LVIF_TEXT | LVIF_STATE

		Local text:String

'lvI.pszText=PQgetvalue(res, row, 0) might be better as the string would be freed 
'when the result is freed, but is it safe???
		text=String(PQgetvalue(res, row, 0))
		lvI.pszText		= text .ToCString()
		lvI.iSubItem = 0
		SendMessageA(listboxHwnd, LVM_SETITEM, 0,Int(Byte Ptr lvI))
		MemFree lvI.pszText
			
		text=String(PQgetvalue(res, row, 2))
		lvI.pszText		= text .ToCString()
		lvI.iSubItem = 1
		SendMessageA(listboxHwnd, LVM_SETITEM, 0,Int(Byte Ptr lvI))
		MemFree lvI.pszText
		
		text=String(PQgetvalue(res, row, 1))
		lvI.pszText		= text .ToCString()
		lvI.iSubItem = 2
		SendMessageA(listboxHwnd, LVM_SETITEM, 0,Int(Byte Ptr lvI))
		MemFree lvI.pszText	

End Function


Function ListBoxColumnWidth(listbox:TGadget,Column,width)
	Local ListboxHwnd=QueryGadget(listbox,QUERY_HWND)
	Local col:LVCOLUMN = New LVCOLUMN	
	Col.mask = LVCF_WIDTH
	col.cx   = width
	SendMessage(listboxHwnd,LVM_SETCOLUMNA,Column,Int(Byte Ptr Col))
End Function



Local Window:TGadget

Global listbox:TGadget
Local OKbutton:TGadget


Window=CreateWindow("Window Events",40,40,420,260,Null,WINDOW_TITLEBAR )'| WINDOW_RESIZABLE)
Const gStyle = WS_VISIBLE | WS_CHILD | LVS_REPORT  | LVS_SHOWSELALWAYS |  LBS_DISABLENOSCROLL |LVS_SINGLESEL  '| LVS_EDITLABELS 

listbox=CreateListBox(10,34,390,22*7,Window,gStyle  )

Local ListboxHwnd=QueryGadget(listbox,QUERY_HWND)

SetWindowLong(ListboxHwnd , GWL_STYLE, gStyle ) 'change the style so that we have headings


Const GridExstyle =  LVS_EX_HEADERDRAGDROP | LVS_EX_GRIDLINES  | LVS_EX_FULLROWSELECT  '|LVS_EX_ONECLICKACTIVATE  '| LVS_EX_BORDERSELECT
	
SendMessageA(listboxHwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, GridExstyle ,GridExstyle )





makeHeaders(listbox)

OKbutton=CreateButton("Add",320,190,80,24,Window,BUTTON_OK)
Global DeleteButton:tgadget=CreateButton("Delete",200,190,80,24,window)
Global EditButton:tgadget=CreateButton("Edit",100,190,80,24,window)
SetGadgetLayout( listbox,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED,EDGE_ALIGNED )
SetGadgetLayout( OKbutton,0,EDGE_ALIGNED,0,EDGE_ALIGNED)



Global conn:Int = PQconnectdb("dbname=test user=postgres password=xxxxxx")
If PQstatus(conn) = CONNECTION_BAD Then
	Print "connection To db failed"
	Print PQerrorMessage(conn)
	End
EndIf
Global res:Int
refreshlist()



'PQclear(res) '     /* free result */
'PQfinish(conn) ' free connection

'column 0 is "hidden" id column
ListBoxColumnWidth(listbox,0,0)
ListBoxColumnWidth(listbox,3,1000)		' one of many attempted fudges to stop coloumn 0 resizing...

While True
	WaitEvent()
	'Print currentevent.tostring()
	Select CurrentEvent.id

		Case EVENT_WINDOWCLOSE
		  PQclear(res)
		  PQfinish(conn)
			End
		Case EVENT_GADGETACTION
			If EventSource()=OKbutton Then
				changerow(-1)
			EndIf
			If EventSource()=DeleteButton Then
				If SelectedGadgetItem(listbox)<>-1 Then
					'Print GadgetItemText(listbox,SelectedGadgetItem(listbox))
					Local id:Int=Int(getval(0))
	
					Local q:String="delete from customers where id="+id
					
					res=PQexec(conn, q)
					If PQresultStatus(res) <>PGRES_COMMAND_OK Then
						Notify "delete failed "+String(PQerrorMessage(conn))
					EndIf
					refreshlist()
			
					
				EndIf
			EndIf
			If EventSource()=EditButton Then
				Local id=Int(getval(0))
				changerow(id)
			EndIf
'			If EventSource()=listbox Then

'			EndIf
		Case EVENT_WINDOWSIZE
			ListBoxColumnWidth(listbox,0,0)

	End Select

Wend


Function getVal:String(i:Int)
	Local ListboxHwnd=QueryGadget(listbox,QUERY_HWND)
	Local  lvI:LVITEM = New LVITEM 

	lvI.iItem = 0
	lvI.mask =  LVIF_TEXT 

	Local text:String="0123456789012345678901234567890123456789"

	lvI.pszText		= text .ToCString()
	lvI.iSubItem = i
	lvI.cchTextMax=39
	SendMessageA(listboxHwnd, LVM_GETITEMTEXTA, SelectedGadgetItem(listbox),Int(Byte Ptr lvI))
	Local id:String=string.fromcstring(lvI.pszText)
	MemFree lvI.pszText
	Return id
EndFunction

Function changerow(r:Int)
	Local t:String
	If r=-1 Then t="Add" Else t="Edit"
	Local win:tgadget=CreateWindow(t,40,40,120,120,,WINDOW_TITLEBAR)
	Local surname:tgadget=CreateTextField(50,4,60,20,win)
	Local sl:tgadget=CreateLabel("surname",4,4,40,20,win)
	Local dob:tgadget=CreateTextField(50,28,60,20,win)
	Local dl:tgadget=CreateLabel("DOB",4,28,40,20,win)
	Local ok:tgadget=CreateButton("OK",4,52,20,20,win)
	Local cancel:tgadget=CreateButton("Cancel",44,52,40,20,win)
	If r<>-1 Then
		SetGadgetText surname,getval(1)
		SetGadgetText dob,getval(2)
	EndIf
	ActivateGadget surname
	Local valid:Int=False
	While valid=False
		While True
			WaitEvent()
			Select currentevent.id
				Case EVENT_WINDOWCLOSE
					valid=2
					Exit
				Case EVENT_GADGETACTION
					If EventSource()=cancel Then
						valid=2 
						Exit
					EndIf
					
					If EventSource()=ok Then
						If TextFieldText(surname).length=0 Then
							Notify "please specify a surname"
							Exit
						EndIf
						If TextFieldText(dob).length=0 Then
							Notify "please specify a DOB"
							Exit
						EndIf
						' should also check for valid year, month and day here
						valid=True
						Exit
					EndIf
			
			EndSelect
		
		Wend
		If valid Then
		' valid (ish) input!
			Local q:String
			q="insert into customers (surname,dob) values ('"+TextFieldText(surname)+"','"+TextFieldText(dob)+"')"
			If r<>-1 Then	q="update customers set surname='"+TextFieldText(surname)+"',dob='"+TextFieldText(dob)+"' where id="+r
			res=PQexec(conn, q)
			If PQresultStatus(res) <>PGRES_COMMAND_OK Then
				valid=False
				Notify "query failed "+String(PQerrorMessage(conn))
			EndIf
			refreshlist()
		EndIf
	Wend

	FreeGadget win 
EndFunction

Function refreshlist()
	Local query_string:String="select * from customers order by id"
	res = PQexec(conn, query_string)
	
	If PQresultStatus(res) <> PGRES_TUPLES_OK Then
		Print "query failed"
		Print PQerrorMessage(conn)
	  PQclear(res)
	  PQfinish(conn)
		End 	
	EndIf
	ClearGadgetItems listbox
	For Local i:Int = 0 To PQntuples(res)-1               ' /* loop through all rows returned */
		AddGadgetItem listbox,""
		addrow(listbox,i)
	Next
EndFunction