Post by metro on May 30, 2020 23:29:44 GMT -5
Maybe useful ,
'** 24/05/2003 15:55:47
'** An implementation of multiple columns in a standard listbox
' Features: four functions for left, center or right alignment and currency format.
' Use of a hidden graphics box and the stringwidth function to calculate correct padding
' independent of font selected.
' Open source, feel free to use if functions suit your needs.
'Bill Christiansen
[WindowSetup]
'NOMAINWIN
WindowWidth = 570 : WindowHeight = 454
UpperLeftX = INT((DisplayWidth-WindowWidth)/2)
UpperLeftY = INT((DisplayHeight-WindowHeight)/2)
width1 = 195
width2 = 195
width3 = 100
[ControlSetup]
Menu #main, "&File" , "E&xit", [quit]
graphicbox #main.graphicbox1, 1, 1, 1, 1
statictext #main.st1, "Choose a font and column alignment", 15, 5, 300, 20
statictext #main.st2, "Sort by column 1 or 2 by clicking header", 15, 150, 300, 20
button #main.button1, "Left",[button1.click],UL, 100, 70, 105, 25
button #main.button2, "Center",[button2.click],UL, 210, 70, 105, 25
button #main.button3, "Right",[button3.click],UL, 320, 70, 105, 25
button #main.button4, "Font",[button4.click],UL, 210, 40, 105, 25
button #main.col1, "Food Group +",[col1.click],UL, 15, 180, width1, 22
button #main.col2, "Item +",[col2.click],UL, 15+width1, 180, width2, 22
button #main.col3, "Price / kg",[col3.click],UL, 15+width1+width2,180, width3+40, 22
listbox #main.list1, list$(,[list1.click], 15, 199, 530, 200
Open "Multi-Column Listbox Demo" for Window as #main
print #main, "trapclose [quit]"
print #main, "font ms_sans_serif 10"
col1$ = "DES" 'initialise sort variable to descending
col2$ = "DES" 'will change to "ASC" when column header clicked
Dim data$(10,3)
Dim list$(10)
data$(1,1) = "Fruit" :data$(1,2) = "bananas" : data$(1,3) = "2.39"
data$(2,1) = "Fruit" :data$(2,2) = "oranges" : data$(2,3) = "4.49"
data$(3,1) = "Fruit" :data$(3,2) = "apples" : data$(3,3) = "2.49"
data$(4,1) = "Vegetable" :data$(4,2) = "potatoes" : data$(4,3) = "2.29"
data$(5,1) = "Vegetable" :data$(5,2) = "carrots" : data$(5,3) = "1.99"
data$(6,1) = "Vegetable" :data$(6,2) = "tomatoes" : data$(6,3) = "7.79"
data$(7,1) = "Meat" :data$(7,2) = "ground beef" : data$(7,3) = "10.99"
data$(8,1) = "Meat" :data$(8,2) = "chicken breast" : data$(8,3) = "17.49"
data$(9,1) = "Meat" :data$(9,2) = "Ham, fat free" : data$(9,3) = "21.50"
count = 9
format$ = "left"
chosenFont$ = "Arial 12 italic"
[FillList]
listFont$ = "font " + chosenFont$
print #main.list1, listFont$
for i = 1 to count
a$ = data$(i,1)
b$ = data$(i,2)
c$ = data$(i,3)
c$ = CurrencyFormatStr$(c$,listFont$,width3)
if format$ = "left" then
a$ = LeftFormatStr$(a$,listFont$,width1)
b$ = LeftFormatStr$(b$,listFont$,width2)
list$(i) = a$ + b$ + c$
print list$(i)
end if
if format$ = "center" then
a$ = CenterFormatStr$(a$,listFont$,width1)
b$ = CenterFormatStr$(b$,listFont$,width2)
list$(i) = a$ + b$ + c$
end if
if format$ = "right" then
a$ = RightFormatStr$(a$,listFont$,width1)
b$ = RightFormatStr$(b$,listFont$,width2)
list$(i) = a$ + b$ + c$
end if
'print list$(i)
next
print #main.list1, "reload"
[loop]
Wait
[quit]
close #main : END
[button1.click]
format$ = "left"
goto [FillList]
[button2.click]
format$ = "center"
goto [FillList]
[button3.click]
format$ = "right"
goto [FillList]
[button4.click]
'open a font dialog
currentFont$ = mid$(listFont$,6)
fontdialog currentFont$, chosenFont$
if chosenFont$ = "" then goto [loop]
goto [FillList]
[col1.click]
select case col1$
case "ASC"
sort data$(), 1, count , 1
print #main.col1, "Food Group +"
col1$ = "DES"
case "DES"
sort data$(),count,1, 1
print #main.col1, "Food Group -"
col1$ = "ASC"
end select
goto [FillList]
[col2.click]
select case col2$
case "ASC"
sort data$(), 1, count , 2
print #main.col2, "Item +"
col2$ = "DES"
case "DES"
sort data$(),count,1, 2
print #main.col2, "Item -"
col2$ = "ASC"
end select
goto [FillList]
[col3.click]
goto [loop]
[list1.click]
print #main.list1, "selection? selected$"
print selected$
goto [loop]
Function LeftFormatStr$(a$,listFont$,width)
print #main.graphicbox1, listFont$ 'give hidden graphics box the current font
onePad$ = " "
print #main.graphicbox1, "stringwidth? onePad$ PadWidth" 'find out how may pixels in a space
print #main.graphicbox1, "stringwidth? a$ FieldWidth" 'find out how many pixels in the string
padNum = (width-FieldWidth)/PadWidth
if padNum - int(padNum) >= 0.5 then padNum = padNum + 1 'calculate padding rounded to whole character
padNum = int(padNum)
if FieldWidth > width then 'reduce size of string if it's bigger than field
padNum = 0
while FieldWidth > width
length = len(a$) - 1
a$ = left$(a$,length)
print #main.graphicbox1, "stringwidth? a$ FieldWidth"
wend
end if
if padNum = 0 then [noPad]
a$ = a$ + space$(padNum)
[noPad]
LeftFormatStr$ = a$
end function
Function RightFormatStr$(a$,listFont$,width)
print #main.graphicbox1, listFont$
onePad$ = " "
print #main.graphicbox1, "stringwidth? onePad$ PadWidth"
print #main.graphicbox1, "stringwidth? a$ FieldWidth"
padNum = (width-FieldWidth)/PadWidth
if padNum - int(padNum) >= 0.5 then padNum = padNum + 1
padNum = int(padNum)
if FieldWidth > width then
padNum = 0
while FieldWidth > width
length = len(a$) - 1
a$ = left$(a$,length)
print #main.graphicbox1, "stringwidth? a$ FieldWidth"
wend
end if
if padNum = 0 then [noPad]
a$ = space$(padNum) + a$
[noPad]
RightFormatStr$ = a$
end function
Function CenterFormatStr$(a$,listFont$,width)
print #main.graphicbox1, listFont$
onePad$ = " "
print #main.graphicbox1, "stringwidth? onePad$ PadWidth"
print #main.graphicbox1, "stringwidth? a$ FieldWidth"
padNum = (width-FieldWidth)/PadWidth
padNum = padNum/2
padNum = int(padNum)
if FieldWidth > width then
padNum = 0
while FieldWidth > width
length = len(a$) - 1
a$ = left$(a$,length)
print #main.graphicbox1, "stringwidth? a$ FieldWidth"
wend
end if
if padNum = 0 then [noPad]
a$ = space$(padNum) + a$ + space$(padNum)
[noPad]
CenterFormatStr$ = a$
end function
Function CurrencyFormatStr$(a$,listFont$,width)
print #main.graphicbox1, listFont$
onePad$ = " "
c$ = "$" + Using("####.##",val(a$))
print #main.graphicbox1, "stringwidth? onePad$ PadWidth"
print #main.graphicbox1, "stringwidth? c$ FieldWidth"
padNum = (width-FieldWidth)/PadWidth
if padNum - int(padNum) >= 0.5 then padNum = padNum + 1
padNum = int(padNum)
if FieldWidth > width then
padNum = 0
while FieldWidth > width
length = len(a$) - 1
a$ = right$(a$,length)
print #main.graphicbox1, "stringwidth? a$ FieldWidth"
wend
end if
CurStr$ = space$(padNum) + "$" + Using("####.##",val(a$))
CurrencyFormatStr$ = CurStr$
End Function
