|
This is a Euphoria created list box that enables font changes, variables columns, color text, blinking,
and left, right, or center text justification in each column. Below is a screenshot. Obviously, this is
a static image, but in a real-life situation, whereever you see a reference to blink in the text, the text
in that line and column blinks at a rate of approximately 3 times per second. Unlike standard windows
list boxes, it can handle an infinite number of lines, limited only by your system memory.
------------------------ Nel32 Win32 Library --------------------------
--
-- Copyright (c) Northeastern Engineering
--
-- Multiple attribute Color list box (Single instance version)
--
----------------------------------------------------------------------
--
-- Version 1.0
--
-- Originator : Thomas C. Janes, President, NEL
-- Address : Ilion, New York 13357
-- Release Date : September 3, 2007
-- Email address : portals@verizon.net
-- Copyright Owner : Northeastern Engineering Labs
--
-- This software is released to the public domain under the following
-- provisions:
--
-- If this program source code is changed in any way, then the person
-- making such alterations is required, by law, to remove the name of
-- the author and any other information that may indentify him as the
-- originator of this software. Failure to do so could lead to civil
-- prosecution.
--
-- This software is provided without warrantee, and it is distributed
-- 'as-is'. The user agrees to assumes all liability for its failure
-- to perform properly in accordance with the information included in
-- this file or described elsewhere.
--
----------------------------------------------------------------------
--
-- Command table
--
-- CLB_APPENDITEM(New_line)
-- CLB_UPDATEITEM(Index_number, New_Line)
-- CLB_DELETEITEM(Index_number)
-- CLB_CLEARLISTS()
-- CLB_INSERTITEM(Index_number, New_line)
-- CLB_ADDBLINK(Column_number,Column_data)
-- CLB_ADDCOLOR(Column_number,Column_data,{R,G,B})
-- CLB_CALLBACK(Repaint_Callback)
-- CLB_GETSELTEXT(Index_number)
-- CLB_BACKGROUND({R,G,B})
-- CLB_SETWHEEL(Lines)
-- CLB_SETSELECT(Index_number)
-- CLB_GETSELECT()
-- CLB_SCROLLWIDTH(Scroll_Width)
-- CLB_WINDOWSPEC(Left,Top,Width,Height)
-- CLB_SETPARENT(Parent_Window)
-- CLB_SETFONT(Face,Pitch,Attributes)
-- CLB_SETSCROLLBKG({R,G,B})
-- CLB_SETSCRPAGE(Paging_size)
-- CLB_ACTIVATE()
-- CLB_ADDCOLUMN(Column_tab)
-- CLB_GETRECORD(Index_number)
-- CLB_ENABLELINE(Flag)
-- CLB_SETJUSTIFY(Column_number,Justification) [Left,Right,Center]
--
----------------------------------------------------------------------
include nel32_000.ew
without warning
without trace
without type_check
----------------------------------------------------------------------
-- Constants
----------------------------------------------------------------------
constant
Black = createPen({PS_SOLID,1,{0,0,0}}),
drawStyle = Combine({WS_CHILD,WS_VISIBLE})
global constant
LEFT = 0,
CENTER = 1,
RIGHT = 2
----------------------------------------------------------------------
-- Sequences
----------------------------------------------------------------------
sequence
Ssize,
CLB_FILE,
CLB_DIMENSION,
CLB_SIZE,
CLB_TEXTHILITE,
CLB_SELHILITE,
CLB_COLUMN,
CLB_BLINK,
CLB_COLOR,
CLB_POSITION,
CLB_SCROLLBKG,
CLB_BKGND,
CLB_JUSTIFY
----------------------------------------------------------------------
-- Integers
----------------------------------------------------------------------
integer
WinColor,
Select,
Unselect,
cur_line,
last_line,
sel_line,
time_set,
blink_status,
index,
CLB_FONT,
CLB_FONTHEIGHT,
CLB_WHEEL_LINES,
CLB_WIDTHSCROLL,
CLB_PARENT,
CLB_LINES,
Top,
Left,
Width,
Height,
Scratchpad,
CLB_WINDOW,
CLB_SCROLLBAR,
Activated,
SelPen,
MaxLines,
OFFSETX
global integer
CLB_APPENDITEM,
CLB_UPDATEITEM,
CLB_DELETEITEM,
CLB_CLEARLISTS,
CLB_INSERTITEM,
CLB_ADDBLINK,
CLB_ADDCOLOR,
CLB_ADDFORMAT,
CLB_CALLBACK,
CLB_GETSELTEXT,
CLB_SETWHEEL,
CLB_SETSELECT,
CLB_GETSELECT,
CLB_SCROLLWIDTH,
CLB_WINDOWSPEC,
CLB_SETPARENT,
CLB_SETFONT,
CLB_SETSCROLLBKG,
CLB_SETSCRPAGE,
CLB_ACTIVATE,
CLB_BACKGROUND,
CLB_ADDCOLUMN,
CLB_ROUTINE,
CLB_GETRECORD,
CLB_ENABLELINE,
CLB_SETJUSTIFY
----------------------------------------------------------------------
-- Atoms
----------------------------------------------------------------------
atom
dbl_time
----------------------------------------------------------------------
-- Variable initialization
----------------------------------------------------------------------
CLB_APPENDITEM = 501
CLB_UPDATEITEM = 502
CLB_DELETEITEM = 503
CLB_CLEARLISTS = 504
CLB_INSERTITEM = 505
CLB_ADDBLINK = 506
CLB_ADDCOLOR = 507
CLB_CALLBACK = 509
CLB_GETSELTEXT = 510
CLB_BACKGROUND = 511
CLB_SETWHEEL = 512
CLB_SETSELECT = 513
CLB_GETSELECT = 514
CLB_SCROLLWIDTH = 515
CLB_WINDOWSPEC = 516
CLB_SETPARENT = 517
CLB_SETFONT = 518
CLB_SETSCROLLBKG = 519
CLB_SETSCRPAGE = 520
CLB_ACTIVATE = 521
CLB_ADDCOLUMN = 522
CLB_GETRECORD = 523
CLB_ENABLELINE = 524
CLB_SETJUSTIFY = 525
Activated = FALSE
CLB_JUSTIFY = {}
CLB_LINES = FALSE
CLB_FONTHEIGHT = 15
CLB_ROUTINE = 0
Scratchpad = 0
CLB_WINDOW = 0
CLB_SCROLLBAR = 0
CLB_WHEEL_LINES = 1
CLB_PARENT = 0
CLB_WIDTHSCROLL = 13
dbl_time = 0
CLB_BKGND = {#C0,#C0,#C0}
CLB_TEXTHILITE = {255,255,255}
CLB_SELHILITE = {0,0,155}
CLB_SCROLLBKG = {#C0,#C0,#C0}
CLB_DIMENSION = {}
CLB_FILE = {}
cur_line = 0
last_line = 0
sel_line = 0
time_set = 0
CLB_COLUMN = {}
index = 1
blink_status = 0
CLB_BLINK = {}
CLB_COLOR = {}
CLB_FONT = createFont({"arial",11,Normal}),11,Normal})
Select = createBrush({BS_SOLID,CLB_SELHILITE,0})
SelPen = createPen({0,1,CLB_SELHILITE})
WinColor = createPen({0,1,CLB_BKGND})
Unselect = createBrush({BS_SOLID,CLB_BKGND,0})
OFFSETX = 0
------------------------------------------------------------------------
-- Drawlines
------------------------------------------------------------------------
procedure DrawLines()
for y = 1 to MaxLines do
absLine({Scratchpad,CLB_SIZE[1],
y*CLB_FONTHEIGHT+6,
CLB_SIZE[3],
y*CLB_FONTHEIGHT+6,Black})
end for
for y = 1 to length(CLB_COLUMN) do
absLine({Scratchpad,CLB_COLUMN[y]-5,
CLB_SIZE[1],
CLB_COLUMN[y]-5,
CLB_SIZE[4],Black})
end for
end procedure
------------------------------------------------------------------------
-- CLB_Refresh display
------------------------------------------------------------------------
procedure CLB_Refresh(integer a, sequence b, sequence c)
if CLB_LINES = TRUE then DrawLines() end if
bitBlt({CLB_WINDOW,-1,0,CLB_SIZE[3]-OFFSETX,
CLB_SIZE[4],
Scratchpad,0,5,SRCCOPY})
end procedure
------------------------------------------------------------------------
---- DrawRect
------------------------------------------------------------------------
procedure DrawRect(integer l, object c, integer b)
rectangle({Scratchpad,-1,((l-1)*CLB_FONTHEIGHT)+6,
CLB_SIZE[3],
l*CLB_FONTHEIGHT+6,c,b})
end procedure
------------------------------------------------------------------------
---- DrawChar
------------------------------------------------------------------------
procedure DrawChar(integer c, integer l, integer r,
object color,integer flag)
integer start, stop
sequence size
if flag = 1 then
if c = 1 then
rectangle({Scratchpad,-1,((l-1)*CLB_FONTHEIGHT)+6,
CLB_COLUMN[1],
l*CLB_FONTHEIGHT+6,
WinColor,Unselect})
end if
start = CLB_COLUMN[c]
if c = length(CLB_COLUMN) then stop = CLB_SIZE[3]
else stop = CLB_COLUMN[c+1] end if
rectangle({Scratchpad,start,((l-1)*CLB_FONTHEIGHT)+6,
stop,l*CLB_FONTHEIGHT+6,WinColor,Unselect})
end if
start = CLB_COLUMN[c]
for x = 1 to length(CLB_JUSTIFY) do
if c = CLB_JUSTIFY[x][1] then
if CLB_JUSTIFY[x][2] = 1 then -- Center
size = getTextExtent({CLB_WINDOW,CLB_FILE[r][c],CLB_FONT})
if c = length(CLB_COLUMN) then
start = floor(((CLB_SIZE[4]-10) - CLB_COLUMN[c])/2)
else
start = floor(((CLB_COLUMN[c+1]-10) - CLB_COLUMN[c])/2)
end if
start = CLB_COLUMN[c] + (start - floor(size[1]/2))
elsif CLB_JUSTIFY[x][2] = 2 then -- Right
size = getTextExtent({CLB_WINDOW,CLB_FILE[r][c],CLB_FONT})
if c = length(CLB_COLUMN) then start = (CLB_SIZE[4]-10) - size[1]
else start = (CLB_COLUMN[c+1]-10) - size[1] end if
end if
end if
end for
textOut({Scratchpad,start,(l*CLB_FONTHEIGHT)+3,CLB_FILE[r][c],color})
end procedure
------------------------------------------------------------------------
---- Update selection line
------------------------------------------------------------------------
procedure Write_line(integer i,integer line, integer rkd)
object a,b
integer start, stop
a = WinColor
b = Unselect
if i = 0 then
a = SelPen
b = Select
end if
rectangle({Scratchpad,-1,((line-1)*CLB_FONTHEIGHT)+6,
CLB_SIZE[3],line*CLB_FONTHEIGHT+6,a,b})
for x = 1 to length(CLB_COLUMN) do
if i = 0 then DrawChar(x,line,rkd,{255,255,255,{TRANSPARENT}},0)
else
DrawChar(x,line,rkd,{0,0,0,{TRANSPARENT}},0)
for z = 1 to length(CLB_COLOR) do
if x = CLB_COLOR[z][1] then
if match(CLB_COLOR[z][2],CLB_FILE[rkd][x]) then -- Alt color
DrawChar(x,line,rkd,CLB_COLOR[z][3],0)
end if
end if
end for
end if
end for
end procedure
------------------------------------------------------------------------
---- Set Display position
------------------------------------------------------------------------
procedure Set_Display(integer a, sequence b, sequence c)
if length(CLB_FILE) <= MaxLines then
a = MaxLines
if OFFSETX > 0 then
showWindow({CLB_SCROLLBAR,FALSE})
OFFSETX = 0
end if
else
a = length(CLB_FILE) - (MaxLines - 2)
if OFFSETX = 0 then
showWindow({CLB_SCROLLBAR,TRUE})
OFFSETX = CLB_WIDTHSCROLL+3
end if
end if
if b[1] > 0 and b[1] < a then
index = b[1]
a = b[1]
for i = 1 to MaxLines do
if a < length(CLB_FILE)+1 then
if a = sel_line then
Write_line(0,i,sel_line)
cur_line = i
else Write_line(1,i,a) end if
a += 1
end if
end for
end if
setScrollPos({CLB_SCROLLBAR,b[1]})
if CLB_LINES = TRUE then DrawLines() end if
CLB_Refresh(0,{},{})
end procedure
------------------------------------------------------------------------
---- Get mouse actions
------------------------------------------------------------------------
procedure Get_Position(integer a, sequence b, sequence c)
atom j
integer idx
if b[1] = WM_LBUTTONDOWN and time_set = 1 then
j = time()
if j - dbl_time < .2 then call_proc(CLB_ROUTINE,{sel_line}) end if
time_set = 0
end if
if sel_line < length(CLB_FILE) then
if b[1] = WM_LBUTTONDOWN and time_set = 0 then
if sel_line > 0 then
Write_line(1,cur_line,sel_line)
end if
dbl_time = time()
time_set = 1
a = 0
if length(CLB_FILE) > MaxLines then idx = MaxLines
else idx = length(CLB_FILE) end if
for x = 1 to idx do
a += CLB_FONTHEIGHT
if a > b[4] then
cur_line = x
exit
end if
end for
sel_line = (cur_line-1) + index
Write_line(0,cur_line,sel_line)
CLB_Refresh(0,{},{})
end if
end if
end procedure
------------------------------------------------------------------------
---- Timed cell blink routine
------------------------------------------------------------------------
procedure blink_it(integer a, sequence b, sequence c)
integer i,idx
sequence junk
if blink_status = 0 then blink_status = 1
else blink_status = 0 end if
i = 1
if length(CLB_FILE) > MaxLines then idx = index + MaxLines
else idx = length(CLB_FILE) end if
for x = index to idx do
if x < length(CLB_FILE)+1 then
for w = 1 to length(CLB_COLUMN) do
for y = 1 to length(CLB_BLINK) do
if w = CLB_BLINK[y][1] then
if match(CLB_BLINK[y][2],CLB_FILE[x][w]) then -- Blink
if blink_status = 0 then
if x = sel_line then junk = CLB_SELHILITE
else junk = CLB_BLINK[y][3] end if
junk = append(junk,{TRANSPARENT})
DrawChar(w,i,x,junk,0)
else
if x = sel_line then junk = CLB_TEXTHILITE
else junk = CLB_BKGND end if
junk = append(junk,{TRANSPARENT})
DrawChar(w,i,x,junk,0)
end if
end if
end if
end for
end for
i += 1
end if
end for
CLB_Refresh(0,{},{})
end procedure
------------------------------------------------------------------------
---- Mouse wheel actions
------------------------------------------------------------------------
procedure Wheel(integer a, sequence b, sequence c)
sequence Main
Main = getWindowRect({CLB_PARENT,CLB_WINDOW})
if b[3] > Main[1] and b[3] < Main[3] and
b[4] > Main[2] and b[4] < Main[4] then
if b[2] = -1 then b[2] = CLB_WHEEL_LINES * -1
else b[2] = CLB_WHEEL_LINES end if
if index + b[2] > 0 and
index + b[2] < length(CLB_FILE) and
length(CLB_FILE) > MaxLines then
Set_Display(0,{index + b[2]},{})
end if
end if
end procedure
------------------------------------------------------------------------
-- CLB Command interpretor
--
-- Usage: CLB_Message(cmd,{handle,data...})
------------------------------------------------------------------------
global function CLB_Message(object s)
integer i
sequence t
if s[1] = CLB_WINDOWSPEC then -- {s[1],top,left,width,height}
CLB_DIMENSION = {s[2],s[3],s[4],s[5]}
CLB_SIZE = {0,0,0,0}
CLB_SIZE[3] = s[4]
CLB_SIZE[4] = s[5]
elsif s[1] = CLB_SETPARENT then -- {s[1],parent handle}
CLB_PARENT = s[2]
elsif s[1] = CLB_SCROLLWIDTH then -- {s[1],width}
CLB_WIDTHSCROLL = s[2]
elsif s[1] = CLB_CALLBACK then -- (s[1],callback routine_id}
if s[2] > 0 then
CLB_ROUTINE = s[2]
else
return -6 -- illegal callback address
end if
elsif s[1] = CLB_ACTIVATE then
if CLB_PARENT = 0 then
return -5 -- no parent specified
elsif length(CLB_DIMENSION) = 0 then
return -6 -- no sizes specified
else
CLB_WINDOW = createWindow({"",,
CLB_PARENT,
CLB_DIMENSION[1],
CLB_DIMENSION[2],
CLB_DIMENSION[3],
CLB_DIMENSION[4],
drawStyle,
WS_EX_CLIENTEDGE})
Scratchpad = createBitmap({CLB_DIMENSION[3],CLB_DIMENSION[4]})
Ssize = getClientRect({CLB_WINDOW})
CLB_SCROLLBAR = createControl({VertScroll,
"",,
CLB_WINDOW,
Ssize[3]-CLB_WIDTHSCROLL,
Ssize[2],CLB_WIDTHSCROLL,
Ssize[4],
0})
rectangle({Scratchpad,
0,
0,
CLB_DIMENSION[3],
CLB_DIMENSION[4]+5,
CLB_BKGND})
useFont({Scratchpad,CLB_FONT}) -- default font
setBkColor({Scratchpad,CLB_BKGND})
setBkColor({CLB_SCROLLBAR,CLB_SCROLLBKG})
setTimer({CLB_WINDOW,24,.3})
setScrollPage({CLB_SCROLLBAR,2})
onPaint(CLB_WINDOW,routine_id("CLB_Refresh"),{})),{})
onScroll(CLB_SCROLLBAR,routine_id("Set_Display"),{})),{})
onEvent(CLB_WINDOW,routine_id("Get_Position"),{})),{})
onTimer(24,routine_id("blink_it"),{})),{})
onWheel(CLB_PARENT,routine_id("Wheel"),{})),{})
CLB_FILE = {}
CLB_COLOR = {}
CLB_BLINK = {}
Activated = TRUE
CLB_FILE = getTextExtent({CLB_WINDOW,"ABC",CLB_FONT}),CLB_FONT})
CLB_FONTHEIGHT = CLB_FILE[2]
CLB_FILE = {}
MaxLines = floor(CLB_SIZE[4]/(CLB_FONTHEIGHT))
showWindow({CLB_SCROLLBAR,FALSE})
OFFSETX = 0
end if
end if
if Activated = TRUE then
if s[1] = CLB_APPENDITEM then -- (s[1], data)
if length(s[2]) < length(CLB_COLUMN) then
return -4 -- insufficient sequences for column total
end if
CLB_FILE = append(CLB_FILE,s[2])
elsif s[1] = CLB_UPDATEITEM then -- {s[1],rkd #,data}
if s[2] <= length(CLB_FILE) and s[2] > 0 then
CLB_FILE[s[2]] = s[3]
else
return -1 -- bad index number
end if
elsif s[1] = CLB_DELETEITEM then -- {s[1],rkd #}
if s[2] <= length(CLB_FILE) and s[2] > 0 then
CLB_FILE = CLB_FILE[1..s[2]-1] &
CLB_FILE[s[2]+1..length(CLB_FILE)]
else
return -1 -- bad index number
end if
elsif s[1] = CLB_CLEARLISTS then -- {s[1]}
CLB_FILE = {}
CLB_COLOR = {}
CLB_BLINK = {}
elsif s[1] = CLB_INSERTITEM then -- {s[1],rkd #,data}
if s[2] <= length(CLB_FILE) and s[2] > 0 then
CLB_FILE = CLB_FILE[1..s[2]-1] & s[3] &
CLB_FILE[s[2]..length(CLB_FILE)]
else
return -1
end if
elsif s[1] = CLB_ADDBLINK then -- {s[1], (0,col #,data)
CLB_BLINK = append(CLB_BLINK,{s[2],s[3],s[4]})
elsif s[1] = CLB_ADDCOLOR then -- {s[1], col #,data,{R,G,B}}
CLB_COLOR = append(CLB_COLOR,{s[2],s[3],s[4]})
elsif s[1] = CLB_GETSELTEXT then -- {s[1]}
if sel_line > 0 and sel_line <= length(CLB_FILE) then
return CLB_FILE[sel_line]
else
return -2 -- no selected text
end if
elsif s[1] = CLB_GETRECORD then -- {s[1],rkd #}
if s[2] > 0 and s[2] <= length(CLB_FILE) then
return CLB_FILE[s[2]]
else
return -2 -- no selected text
end if
elsif s[1] = CLB_ENABLELINE then -- {s[1],flag}
if find(s[2],{0,1}) then
CLB_LINES = s[2]
else
return -8 -- must be 0 or 1
end if
elsif s[1] = CLB_BACKGROUND then -- {s[1],{R,G,B}}
CLB_BKGND = s[2]
setBkColor({Scratchpad,CLB_BKGND})
destroyPen({WinColor})
destroyBrush({Unselect})
WinColor = createPen({0,1,CLB_BKGND})
Unselect = createBrush({BS_SOLID,CLB_BKGND,0})
rectangle({Scratchpad,0,0,CLB_DIMENSION[3],
CLB_DIMENSION[4]+5,
CLB_BKGND})
elsif s[1] = CLB_SETSCROLLBKG then -- {s[1], {R,G,B})
CLB_SCROLLBKG = s[2]
setBkColor({CLB_SCROLLBAR,s[2]})
elsif s[1] = CLB_SETWHEEL then -- (s[1],lines}
CLB_WHEEL_LINES = s[2]
elsif s[1] = CLB_SETJUSTIFY then -- (s[1],col #,j}
if find(s[3],{1,2}) then
CLB_JUSTIFY = append(CLB_JUSTIFY,{s[2],s[3]})
else
return -9 -- Bad justificaton code
end if
elsif s[1] = CLB_SETSELECT then -- {s[1],rkd #}
if s[2] <= length(CLB_FILE) then
sel_line = s[2]
end if
elsif s[1] = CLB_GETSELECT then
if sel_line > 0 and sel_line <= length(CLB_FILE) then
return sel_line
else
return -3 -- nothing selected
end if
elsif s[1] = CLB_ADDCOLUMN then
if length(CLB_COLUMN) = 0 then
CLB_COLUMN = append(CLB_COLUMN,s[2])
else
for x = 1 to length(CLB_COLUMN) do
if x = length(CLB_COLUMN) then
CLB_COLUMN = append(CLB_COLUMN,s[2])
exit
end if
if s[2] < CLB_COLUMN[x] then
CLB_COLUMN = CLB_COLUMN[1..x-1] & s[2] &
CLB_COLUMN[x..length(CLB_COLUMN)]
exit
end if
end for
end if
elsif s[1] = CLB_SETFONT then -- {s[1],face,pitch,attributes}
i = createFont({s[2],s[3],s[4]})
t = getTextExtent({CLB_WINDOW,"A",i}),i})
CLB_FONTHEIGHT = t[2]+2
MaxLines = floor(CLB_SIZE[4]/(CLB_FONTHEIGHT))
CLB_FONT = i
useFont({Scratchpad,i}) -- default font
end if
if length(CLB_FILE) > MaxLines then
setScrollRange({CLB_SCROLLBAR,1,length(CLB_FILE)-MaxLines+1})
else
setScrollRange({CLB_SCROLLBAR,1,1})
setScrollPos({CLB_SCROLLBAR,1})
index = 1
end if
Set_Display(0,{index},{})
return 0
end if
return 0
end function
|