gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on May 22, 2023 6:55:57 GMT -5
'@import "C:\Users\loyka\AppData\Roaming\Liberty BASIC v4.5.1\inc\exit.inc"
'@import "C:\Users\loyka\AppData\Roaming\Liberty BASIC v4.5.1\inc\prgramagoron.inc"
IACompileDateTime$ = "44701.08:01:16"
'Include a specific code file
' ____________________________________________________________________________________________________
'|____________________________________________________________________________________________________|
'| |
'| The following code was imported using the Import Architect © 2013 - Infinity by Brandon R. Parker |
'| prgramagoron.inc |
'|____________________________________________________________________________________________________|
'|____________________________________________________________________________________________________|
'** Created by Liberty BASIC Workshop - 17/2/2023 09:27:05
'** Προγραμματισμός Αγορών
[InitColors]
'Please use default colors when possible.
'ForegroundColor$ = "Black"
'BackgroundColor$ = "Buttonface"
GlOBAL hwndListView1
GlOBAL hwndListView2
GlOBAL hwndListView3
True = 1 : False = 0
[WindowSetup]
NOMAINWIN
WindowWidth = 980 : WindowHeight = 700
UpperLeftX = INT((DisplayWidth-WindowWidth)/2)
UpperLeftY = INT((DisplayHeight-WindowHeight)/2)
[ControlSetup]
Menu #main8, "Λίστα", "Άνοιγμα Λίστας Α'", [openListaA], "Άνοιγμα Λιστας Β'", [openListaB], | , "Αποθήκευση Λίστας Α'", [saveListaA], "Αποθήκευση Λίστας Β'", [saveListaB], | , "Καθαρισμός Λίστας", [clearLista], "Εκτύπωση Λίστας", [printLista], | , "Επιστροφή", [backStart]
Menu #main8, "Ταξινόμηση", "Ταξινόμηση Κατά Όνομα", [ratingByName], "Ταξινόμηση Κατά Προμηθευτή", [ratingByProm], "Ταξινόμηση Κατά Στοκ", [ratingByStock]
Menu #main8, "Καταχώρηση", "Ημερομηνία Καταχώρησης", [dateEntry], "Καταχώρηση Όλων", [entryAll], "Καταχώρηση Επιλεγμένων", [entryCheck]
statictext #main8.prag1, "Αποθήκη", 340, 5, 135, 25
statictext #main8.prag2, "Ποσότητα:", 670, 50, 65, 20
statictext #main8.prag6, "Λίστα Παραγγελίας", 360, 245, 135, 20
statictext #main8.prag7, "Σύνολα ανα Προμηθευτή", 135, 475, 200, 20
statictext #main8.prag8, "Κόστος", 830, 490, 85, 20
stylebits #main8.prag4, _BS_MULTILINE, 0, 0, 0
button #main8.prag4, "Εισαγωγη προϊόντος στη λίστα", [entrProd], UL, 650, 90, 220, 25
stylebits #main8.prag5, _BS_MULTILINE, 0, 0, 0
button #main8.prag5, "Εξαγωγή προϊόντος από τη λίστα", [outProg], UL, 650, 125, 220, 25
stylebits #main8.prag9, _BS_MULTILINE, 0, 0, 0
button #main8.prag9, "Επιστροφή", [exit], UL, 795, 595, 125, 25
TextboxColor$ = "White"
textbox #main8.prag3, 760, 50, 70, 24
Open "Προγραμματισμός Αγορών" for Window_nf as #main8
#main8 "trapclose [exit]"
#main8 "font consolas 10"
call CreateListViews HWND(#main8)
[main.inputLoop]
Wait
[openListaA]
'place code here
Wait
[openListaB]
'place code here
Wait
[saveListaA]
'place code here
Wait
[saveListaB]
'place code here
Wait
[clearLista]
'place code here
Wait
[printLista]
'place code here
Wait
[ratingByName]
'place code here
Wait
[ratingByProm]
'place code here
Wait
[ratingByStock]
'place code here
Wait
[dateEntry]
'place code here
Wait
[entryAll]
'place code here
Wait
[entryCheck]
'place code here
Wait
[wareHouse]
'place listview handling code here
LVM.GETITEMA = 4101 : LVM.GETITEMCOUNT = 4100
LVIF.TEXT = 1 : LVM.GETITEMSTATE = 4138
LVIS.SELECTED = 2 : LVIF.STATE = 8
'Returns 0-based index of selected item. Call this routine on a timer
'with resolution of 1000 ms to see which item is selected.
calldll #user32, "SendMessageA", hwndListView1 As uLong, LVM.GETITEMCOUNT as long,_
0 as long, 0 as long, total As Long
For index = 0 To total - 1 'check each row
LVITEM.mask.struct = LVIF.TEXT Or LVIF.STATE
LVITEM.iItem.struct = Index 'row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.cchTextMax.struct = 32
LVITEM.pszText$.struct = Space$(32)
LVITEM.stateMask.struct = LVIS.SELECTED
calldll #user32, "SendMessageA", hwndListView1 As uLong, LVM.GETITEMA as long,_
index as long, LVITEM as struct , re As Long
state = LVITEM.state.struct 'selected state of item
If state And LVIS.SELECTED Then
txt$ = winstring(LVITEM.pszText$.struct)
'txt$ now contains text in column 1 of the row selected
Exit For
End If
Next
wait
[listOrder]
'place listview handling code here
LVM.GETITEMA = 4101 : LVM.GETITEMCOUNT = 4100
LVIF.TEXT = 1 : LVM.GETITEMSTATE = 4138
LVIS.SELECTED = 2 : LVIF.STATE = 8
'Returns 0-based index of selected item. Call this routine on a timer
'with resolution of 1000 ms to see which item is selected.
calldll #user32, "SendMessageA", hwndListView2 As uLong, LVM.GETITEMCOUNT as long,_
0 as long, 0 as long, total As Long
For index = 0 To total - 1 'check each row
LVITEM.mask.struct = LVIF.TEXT Or LVIF.STATE
LVITEM.iItem.struct = Index 'row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.cchTextMax.struct = 32
LVITEM.pszText$.struct = Space$(32)
LVITEM.stateMask.struct = LVIS.SELECTED
calldll #user32, "SendMessageA", hwndListView2 As uLong, LVM.GETITEMA as long,_
index as long, LVITEM as struct , re As Long
state = LVITEM.state.struct 'selected state of item
If state And LVIS.SELECTED Then
txt$ = winstring(LVITEM.pszText$.struct)
'txt$ now contains text in column 1 of the row selected
Exit For
End If
Next
wait
[allProm]
'place listview handling code here
LVM.GETITEMA = 4101 : LVM.GETITEMCOUNT = 4100
LVIF.TEXT = 1 : LVM.GETITEMSTATE = 4138
LVIS.SELECTED = 2 : LVIF.STATE = 8
'Returns 0-based index of selected item. Call this routine on a timer
'with resolution of 1000 ms to see which item is selected.
calldll #user32, "SendMessageA", hwndListView3 As uLong, LVM.GETITEMCOUNT as long,_
0 as long, 0 as long, total As Long
For index = 0 To total - 1 'check each row
LVITEM.mask.struct = LVIF.TEXT Or LVIF.STATE
LVITEM.iItem.struct = Index 'row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.cchTextMax.struct = 32
LVITEM.pszText$.struct = Space$(32)
LVITEM.stateMask.struct = LVIS.SELECTED
calldll #user32, "SendMessageA", hwndListView3 As uLong, LVM.GETITEMA as long,_
index as long, LVITEM as struct , re As Long
state = LVITEM.state.struct 'selected state of item
If state And LVIS.SELECTED Then
txt$ = winstring(LVITEM.pszText$.struct)
'txt$ now contains text in column 1 of the row selected
Exit For
End If
Next
wait
[entrProd]
'place code here
wait
[outProg]
'place code here
wait
Sub CreateListViews hWin
'ListView controls are complex. Please see API documentation
'for full information on their use. This code will get you started.
LVS.REPORT = 1 : LVS.NOSORTHEADER = 32768
LVS.SINGLESEL = 4 : LVM.INSERTCOLUMN = 4123
LVCF.WIDTH = 2 : LVM.INSERTITEM = 4103
LVCF.TEXT = 4 : LVM.SETITEM = 4102
LVIF.TEXT = 1 : LVS.SHOWSELALWAYS = 8
Struct LVITEM,mask As ulong,iItem As long,iSubItem As long,state As ulong,stateMask As ulong,_
pszText$ As ptr,cchTextMax As Long,iImage As Long,lParam As Long,iIndent As Long
Struct LVCOLUMN,mask As ulong,fmt As long,cx As long,pszText$ As ptr,cchTextMax As Long,iSubItem As Long,iImage As Long,iOrder As Long
style = _WS_CHILD OR _WS_VISIBLE OR LVS.NOSORTHEADER Or LVS.REPORT Or LVS.SINGLESEL Or LVS.SHOWSELALWAYS
calldll #comctl32, "InitCommonControls", re as void
calldll #user32, "GetWindowLongA", hWin as uLong, _GWL_HINSTANCE as long, hInstance as uLong
calldll #user32, "CreateWindowExA", _WS_EX_CLIENTEDGE As long,"SysListView32" as ptr,_
"" as ptr, style as long, 30 as Long, 30 as Long, 610 as Long, 165 as Long,_
hWin as uLong, 0 as long, hInstance as uLong,"" as ptr, hwndListView1 As uLong
calldll #user32, "SendMessageA" , hwndListView1 as uLong, 4150 as Long,_
32 As Long, 32 As Long, re as Long 'make listview fullrowselect style
LVCOLUMN.mask.struct = LVCF.WIDTH OR LVCF.TEXT
LVCOLUMN.cx.struct = 90 'desired width of column in pixels
LVCOLUMN.pszText$.struct = "First"
'Add first column header, index is 0. Indexes are 0-based.
calldll #user32, "SendMessageA" , hwndListView1 as uLong, LVM.INSERTCOLUMN as Long,_
0 as long, LVCOLUMN as Struct, re as Long
'Add second column header. Additional headers are added in this manner.
columnIndex = 1 'be sure to increment index for each additional column
LVCOLUMN.pszText$.struct = "Second" 'insert header caption here
calldll #user32, "SendMessageA" , hwndListView1 as uLong, LVM.INSERTCOLUMN as Long,_
columnIndex as long, LVCOLUMN as Struct, re as Long
LVITEM.mask.struct = LVIF.TEXT
LVITEM.iItem.struct = 0 'first row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.pszText$.struct = "row 1 col 1" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView1 as uLong, LVM.INSERTITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 1 'second row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.pszText$.struct = "row 2 col 1" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView1 as uLong, LVM.INSERTITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 0 'first row
LVITEM.iSubItem.struct = 1 'second column
LVITEM.pszText$.struct = "row 1 col 2" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView1 as uLong, LVM.SETITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 1 'second row
LVITEM.iSubItem.struct = 1 'second column
LVITEM.pszText$.struct = "row 2 col 2" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView1 as uLong, LVM.SETITEM as Long,_
0 As Long, LVITEM As struct, re as Long
calldll #user32, "CreateWindowExA", _WS_EX_CLIENTEDGE As long,"SysListView32" as ptr,_
"" as ptr, style as long, 30 as Long, 270 as Long, 900 as Long, 180 as Long,_
hWin as uLong, 0 as long, hInstance as uLong,"" as ptr, hwndListView2 As uLong
calldll #user32, "SendMessageA" , hwndListView2 as uLong, 4150 as Long,_
32 As Long, 32 As Long, re as Long 'make listview fullrowselect style
LVCOLUMN.mask.struct = LVCF.WIDTH OR LVCF.TEXT
LVCOLUMN.cx.struct = 90 'desired width of column in pixels
LVCOLUMN.pszText$.struct = "First"
'Add first column header, index is 0. Indexes are 0-based.
calldll #user32, "SendMessageA" , hwndListView2 as uLong, LVM.INSERTCOLUMN as Long,_
0 as long, LVCOLUMN as Struct, re as Long
'Add second column header. Additional headers are added in this manner.
columnIndex = 1 'be sure to increment index for each additional column
LVCOLUMN.pszText$.struct = "Second" 'insert header caption here
calldll #user32, "SendMessageA" , hwndListView2 as uLong, LVM.INSERTCOLUMN as Long,_
columnIndex as long, LVCOLUMN as Struct, re as Long
LVITEM.mask.struct = LVIF.TEXT
LVITEM.iItem.struct = 0 'first row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.pszText$.struct = "row 1 col 1" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView2 as uLong, LVM.INSERTITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 1 'second row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.pszText$.struct = "row 2 col 1" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView2 as uLong, LVM.INSERTITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 0 'first row
LVITEM.iSubItem.struct = 1 'second column
LVITEM.pszText$.struct = "row 1 col 2" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView2 as uLong, LVM.SETITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 1 'second row
LVITEM.iSubItem.struct = 1 'second column
LVITEM.pszText$.struct = "row 2 col 2" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView2 as uLong, LVM.SETITEM as Long,_
0 As Long, LVITEM As struct, re as Long
calldll #user32, "CreateWindowExA", _WS_EX_CLIENTEDGE As long,"SysListView32" as ptr,_
"" as ptr, style as long, 30 as Long, 500 as Long, 415 as Long, 110 as Long,_
hWin as uLong, 0 as long, hInstance as uLong,"" as ptr, hwndListView3 As uLong
calldll #user32, "SendMessageA" , hwndListView3 as uLong, 4150 as Long,_
32 As Long, 32 As Long, re as Long 'make listview fullrowselect style
LVCOLUMN.mask.struct = LVCF.WIDTH OR LVCF.TEXT
LVCOLUMN.cx.struct = 90 'desired width of column in pixels
LVCOLUMN.pszText$.struct = "First"
'Add first column header, index is 0. Indexes are 0-based.
calldll #user32, "SendMessageA" , hwndListView3 as uLong, LVM.INSERTCOLUMN as Long,_
0 as long, LVCOLUMN as Struct, re as Long
'Add second column header. Additional headers are added in this manner.
columnIndex = 1 'be sure to increment index for each additional column
LVCOLUMN.pszText$.struct = "Second" 'insert header caption here
calldll #user32, "SendMessageA" , hwndListView3 as uLong, LVM.INSERTCOLUMN as Long,_
columnIndex as long, LVCOLUMN as Struct, re as Long
LVITEM.mask.struct = LVIF.TEXT
LVITEM.iItem.struct = 0 'first row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.pszText$.struct = "row 1 col 1" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView3 as uLong, LVM.INSERTITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 1 'second row
LVITEM.iSubItem.struct = 0 'first column
LVITEM.pszText$.struct = "row 2 col 1" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView3 as uLong, LVM.INSERTITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 0 'first row
LVITEM.iSubItem.struct = 1 'second column
LVITEM.pszText$.struct = "row 1 col 2" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView3 as uLong, LVM.SETITEM as Long,_
0 As Long, LVITEM As struct, re as Long
LVITEM.iItem.struct = 1 'second row
LVITEM.iSubItem.struct = 1 'second column
LVITEM.pszText$.struct = "row 2 col 2" 'put desired text here
calldll #user32, "SendMessageA" , hwndListView3 as uLong, LVM.SETITEM as Long,_
0 As Long, LVITEM As struct, re as Long
End Sub
' ____________________________________________________________________________________________________
'|____________________________________________________________________________________________________|
'| |
'| End of: prgramagoron.inc |
'|____________________________________________________________________________________________________|
'|____________________________________________________________________________________________________|
' ____________________________________________________________________________________________________
'|____________________________________________________________________________________________________|
'| |
'| The following code was imported using the Import Architect © 2013 - Infinity by Brandon R. Parker |
'| exit.inc |
'|____________________________________________________________________________________________________|
'|____________________________________________________________________________________________________|
[exit]
flags = _MB_ICONQUESTION OR _MB_YESNO
calldll #user32, "MessageBoxA", _
0 as long, _
"Είστε σίγουρος/η οτί θέλετε να τερματίσετε την εφαρμογή Λογιστήριο;" as ptr, _
"Exit" as ptr, _
flags as long, _
Result as long
'Result returns : 1=ok 2=cancel 3=abort 4=retry 5=ignore 6=yes 7=no
if Result = 6 then
close #main8 : END
end if
if Result = 7 then
goto [main.inputLoop]
end if
' ____________________________________________________________________________________________________
'|____________________________________________________________________________________________________|
'| |
'| End of: exit.inc |
'|____________________________________________________________________________________________________|
'|____________________________________________________________________________________________________|
I tried to test the architect a few days ago without any success, but today I succeeded and I'm very happy about it. Thank you Mr. Parker. Gaslouk.
|
|
