--lists4.exw..adding a 'delete' button, and evading a 'bug'.
The following example is just a continuation of the last program. It adds a delete feature to the database, so that individual entries which have been selected in the listbox can be removed.
Please note that this example has modified the read-from-file procedure. This eliminates the need to create an empty file, if no file exists, by using a different test to determine if there is a file to read from, or not.
It has also been changed, with another test, so that it is no longer necessary to create a 'dummy' blank entry in the listbox.
..oops ! Our last program example uncovered a very strange 'bug'. If one entered an item of exactly 12 characters, saved it to the list, and then hi-lighted this item exactly twice, the program would crash. In order to get around this 'bug' we decided to insert a dummy space character if the line was 12 characters long, as a temporary cure. Though this bug may have been resolved by now, we've left it's 'cure' in this example ..;-) The 'fix' for this is in yellow.
--lists4.exw
-- lists4.exw: by Ad Rienks
-- Added a delete routine, contributed by Ferlin Scarborough
-- with lot's of 'trickery', so put yer thinkin caps on!
include win32lib.ew
constant
Win = create(Window, "List +++", 0, Default, Default, 160, 220, 0),
List1 = create(List, "", Win, 10, 10, 130, 58, LBS_NOINTEGRALHEIGHT),
Label1 = create(LText, "", Win, 10, 75, 130, 20, 0),
Sle1 = create(EditText, "", Win, 10, 96, 130, 20, 0),
btnAdd = create(PushButton, "Add", Win, 10, 126, 60, 25, 0),
btnSave = create(PushButton, "Save", Win, 80, 126, 60, 25, 0),
btnDel = create(PushButton, "Delete", Win, 10, 156, 60, 25, 0)
-- ^^ and the still newer Delete button.
atom Handle -- declare 2 variables we use for file handling.
object line
procedure onLoad_Win( integer self, integer event, sequence params )
-- from a file, this time, with a difference !
-- Note that we use a completely different way to check for a file's
-- existence here. Since (Handle) becomes -1 if the file does not
-- exist, it will skip the 'read' entirely if this is true.
integer count
Handle = open("mydata2.txt", "r") -- open the file,
if Handle != -1 then -- and if successfully opened,
while 1 do -- get each line,
line = gets(Handle)
if atom(line) then -- until end of file.
exit
end if
line = line[1..length(line)-1] -- remove line-feed we add below,
if length(line)=12 then
line = line & ' '
end if
addItem( List1, line ) -- and "park" it in the listbox.
end while
close( Handle )
end if
-- check if the list is not empty
-- Note that, because of a new check here, we no longer need
-- a 'dummy' line in the list.
count = getCount(List1)
if count >= 0 then
setIndex(List1, count) -- point to the last item.
setText(Label1, getItem(List1, count)) -- show it also.
end if
setFocus(Sle1)
end procedure -- onLoad_Win
procedure onChange_List1( integer self, integer event, sequence params )
-- list item will be shown in the static line.
integer what
what = getIndex(List1)
if what >= 0 then
setText(Label1, getItem(List1, what))
end if
end procedure -- onChange_List1
procedure onClick_btnAdd( integer self, integer event, sequence params )
integer junk
sequence list_entry list_entry = getText(Sle1)
list_entry = getText(Sle1)
if length( list_entry ) = 0 then
junk = message_box("Type some text into the box first!",
"Empty entry!", MB_TASKMODAL + MB_ICONWARNING)
else
if length(entry) = 12 then -- this is how we catch the bug,
list_entry = list_entry & ' ' -- until a better solution is found.
end if
addItem(List1, list_entry)
setText(Label1, list_entry)
setText(Sle1, {})
setIndex(List1, getCount(List1) )
end if
setFocus( Sle1 )
end procedure -- onClick_BtnAdd
procedure onClick_btnSave( integer self, integer event, sequence params )
-- to save our simple database to a file.
integer listlen
listlen = getCount(List1) -- first, how many lines are in it ?
if listlen > 0 then -- no use to save an empty database.
Handle = open("mydata2.txt", "w")
for i = 1 to listlen do
line = getItem(List1,i)
if length(line) = 13 then
if equal(line[ 13 ], ' ') then -- if 13th char. is a space,
line = line[1..12] -- it's our 'fix', so remove it,
end if
end if
line = line & '\n' -- add a line-feed so we can read it, and,
puts(Handle, line) -- write the line to the file.
end for
close(Handle)
end if
end procedure -- onClick_btnSave
global procedure onClick_btnDel( integer self, integer event, sequence params )
sequence lineitem
integer itemnum, junk, counter
if getCount(List1) > 0 then -- skip routine if list is empty
-- first, lets find out what we're 'trying' to delete
itemnum = getIndex(List1)
lineitem = getItem(List1, itemnum)
-- start up a confirmation message box.
junk = message_box("Are you sure you want to DELETE\n" & lineitem,
"Confirm Delete of Item!",
MB_ICONQUESTION + MB_YESNO + MB_TASKMODAL)
if junk = IDYES then
-- ^^ this line tests the results of the message_box function.
junk = deleteItem(List1, itemnum)
counter = getCount(List1)
if counter > 0 then
setIndex(List1, counter)
setText(Label1, getItem(List1, counter))
else
setText(Label1, {} )
end if
end if
end if
setFocus(Sle1)
end procedure -- end of onClick_btnDel
onOpen[Win] = routine_id("onLoad_Win")
onChange[List1] = routine_id("onChange_List1")
onClick[btnAdd] = routine_id("onClick_btnAdd")
onClick[btnSave] = routine_id("onClick_btnSave")
-- ^^ our latest event handler.
WinMain(Win,Normal)
-- end --
A 'note' about the _ NOW FIXED _ bug.
...the cause of the bug.
-- an extract fron the Euphoria mailing list.
From: Robert Craig
Subject: Re: Win32Lib bug
I've found the cause of the 12-character string bug in win32lib.ew.
In getItem() we have:
iLength = sendMessage( id, msg, item, 0 )
-- extra line I added:
iLength = iLength+1 -- temporary fix, - David?
-- NEW! 0.14c
if iLength = 0 then
warnErr( "Get item text length is zero." )
return ""
end if
-- allocate a buffer
buffer = allocate( iLength ) -- not quite enough space!
-- get the message, based on control type
if window_class[ id ] = LISTBOX then msg = LB_GETTEXT
elsif window_class[ id ] = COMBO then msg = CB_GETLBTEXT
end if
-- move the text to a buffer
ok = sendMessage( id, msg, item, buffer )
I found that the buffer allocated above was one character too small.
It did not allow for the 0 that C always adds to strings (but Euphoria
doesn't require). As a result, Windows would write the extra 0, sometimes
corrupting the next block of storage. If the string was an exact multiple
of 4 in length (such as 12) then Euphoria would allocate exactly the
number of bytes requested, but if it wasn't, Euphoria would round up
to the next multiple of 4 bytes, thereby protecting against the extra 0.
Maybe the fix should just be:
buffer = allocate(iLength+1)
instead. I don't know. David should consider it.
There are other calls to SendMessage that should also be checked.
Regards,
Rob Craig
Rapid Deployment Software
http://members.aol.com/FilesEu/
------------------------------
Date: Fri, 20 Nov 1998 12:38:41 -0800
From: "Cuny, David"
Subject: Re: Win32Lib bug
Robert Craig wrote:
> I've found the cause of the 12-character string
> bug in win32lib.ew.
...
> iLength = iLength+1
When you mentioned that you changed allocate() and it got rid of the bug, I
had a suspicion that under-allocated strings were the culprit - especially
after I went through the structures and didn't see any more that seemed
under-allocated.
I'll look at the invocations of allot, allocate, fetch and store, and make
sure they are all accounting for the extra byte.
Thanks again!
-- David Cuny..end of lesson.