Quickie on responding to 'delete key'

[AdrianFox]

How do I simply respond to the delete key from a window?   I am using the following code:

Code Select Expand

SUB d1_handler
SELECT @MESSAGE

'new code for delete key response  DOES NOT WORK
case @IDCHAR
key=@CODE
if (key=127) 'INITIALLY SET FOR esc KEY as 27
gosub deleteline
ENDIF
'end of new code for key press

It works fine with the escape key (27) or space bar (32) but unless I am mistaken and have the wrong code for the del key (127) then for some reason it will not respond.

(My eventual purpose is to get a highlighted line in a list box to respond to the delete key and erase the entry.)

SOLUTION:

         

Code Select Expand

case @IDKEYDOWN
key=@CODE
if (key=0x2E) 'Virtual key code not Ascii code of 127
gosub deleteline
ENDIF

[GWS]

Hi,

The virtual key code for Delete is 0x2E in Hexadecimal (46 in Decimal).

Haven't tried it though.

Graham

[AdrianFox]

SOLVED.  Apologies to Graham!  You just need to put the code as 0x2E NOT in Ascii as 127.  Then use @IDKEYDOWN not @IDCHAR then all works fine.


Thanks Graham, but 46 doesn't work either. (or rather that is the lower case 'n')  I think you will find it is next to 'delete' on the table which does give 127 as the ASCII code. I've tried several in the ASCII table in the Appendix (IWB Users File Help)  but no success yet.  It works up to 122 which is lower case 'z', and even 126 which is '~', but no success with 127.

[GWS]

This works ..

Code Select Expand


autodefine "off"

def w:window
INT wstyle,run

wstyle = @minbox
' open a window ..
openwindow w,-600,0,600,400,wstyle,0,"IWBasic",&messages
setwindowcolor w,rgb(250,250,190)
centerwindow w

' add the controls ..
control w,@BUTTON,"Quit",400,180,100,30,0,10

run = 1

WAITUNTIL run = 0
stoptimer w
closewindow w
END

sub messages(),int
select @class
case @idclosewindow
run = 0
case @idcontrol
if @controlID = 10 then run = 0
case @IDKEYUP
if @wparam = 0x2E then run = 0
endselect
return 0
endsub



It's the difference between ASCII codes and Virtual Keycodes ..

all the best,

Graham

[AdrianFox]

Thanks Graham.  That gives me two choices now of what to use.  As you will see I managed to find a way with @IDKEYDOWN but as you say the virtual scan code is the 'key' (so to speak) and not to use the Ascii code for these keys.

[LarryMc]

Adrian
You say your goal is to be able to delete a selected line in a list box when you hit the DEL key.
You do understand that the up/down key messages apply to the window/control that has focus.
you have put the trapping of the DEL key in the windows handler which means the window has to have the focus for it to work.

Leaving the trap where you have it means the following would happen.
1. you click on a line in the list box to select the line.
2. you press DEL
3. NOTHING HAPPENS because the listbox has focus
4. you click on the window to gain focus
5. you press DEL
6. your routine to delete the line is called.

I don't think that is what you are looking for.

Quick tutorial:
windows and controls are both 'windows' and have message handlers
what you really need is to have your trapping code in the handler that belongs to the listbox.
that is done by subclassing the listbox control so you can gain access to its handler.

[AdrianFox]

   I just came back to the forum having discovered EXACTLY what you have just said, Larry.  I found I could only get the delete key to work when focus was returned to the Window, and of course, that lost focus on the Listbox which prevented the item I want to delete being selected  etc etc!
I'm glad you say I can trap the key in a similar way for the control. But I'm not sure what you mean by "that is done by subclassing the listbox control so you can gain access to its handler."   Will I find that in the Users guide section on Listbox controls?  I'm currently just using the following code to respond to the list box control :

               

Code Select Expand

CASE ListBox_1

IF @IDLBUTTONDN 'THIS WORKS ok
POS=GETSELECTED(D1,ListBox_1)
MYSTRING=GETSTRING(D1,ListBox_1,POS)
setcontroltext d1,4,mystring 'READ STRING IN ListBox AND PUT IN EDIT box

endif


Here is the code for the whole of the program I am trying to modify if you can follow my attempts at coding and sometimes strange comments on the code.     Please ignore certain idiocies like a listbox being called 'Combo_1 etc. as I started with a combo box and changed it to a Listbox when I realised that was what I needed. 

Code Select Expand


'NEW VERSION TO ENABLE CHANGING FROM BEES TO GARDEN AND TO GENERAL DIARY
$main
'NEW EXAMPLE TO USE CALENDAR CONTROL AND HIDDEN LISTBOX
CONST COMBO_1 = 1
const edit_1=2
const edit_2=3
const editbox_3=4
const savebutton=5
const loadbutton=6
const saveme=7
const quitme=8
const clearscreen=9
const printme=10
const searchbutton=11
const diarypicbutton=20
const beepicbutton=21
const gardenpicbutton=22
const phonepicbutton=23
const shoppingpicbutton=24
const todopicbutton=25
const idcalendar=12
const clearbutton=13
CONST D1_MENUQUIT=14
const d1_menuGENERAL=15
const d1_menuabout=16
const d1_menuBees=17
const d1_menuGarden=18
CONST D1_MENUpHONE=19
const d1_menushopping=30
const d1_menutodo=31

def mystring[1000] as istring  'define string as 1000 characters long
def filename,searchstring as string
def pos,count,x,mypic,handle as int
DEF DIARYPIC,BEEPIC,GARDENPIC,PHONEPIC,SHOPPINGPIC,TODOPIC AS UINT
int m,d,y,date
string month, day, year,ChosenDate,mydate


def myfile as FILE
def buffer[25000]:istring
def mymem as memory
window d1
openwindow d1,0,0,1020,502,@SIZE|@MINBOX|@MAXBOX|@CAPTION|@SYSMENU,0,"Calendar Lists",&d1_handler
CONTROL d1,@EDIT,"",15,16,640,150,@cteditleft|@cteditmulti|@vscroll,editbox_3

CONTROL d1,@LISTBOX,"",15,300,640,140,@ctliststandard|@CTLISTSort|@CTLISTNOTIFY|@CTLISTTABS|@VSCROLL,COMBO_1
CONTROL d1,@edit,"",855,196,120,30,@cteditleft|@CTEDITAUTOH,edit_1 'search term goes here
CONTROL d1,@BUTTON,"Delete",755,136,90,20,0x50000000,edit_2
CONTROL d1,@BUTTON,"Quit",755,232,90,20,0x50000000,quitme
CONTROL d1,@BUTTON,"Clear",870,232,90,20,0x50000000,clearbutton
CONTROL d1,@BUTTON,"Search",755,196,90,20,0x50000000,searchbutton
CONTROL d1,@BUTTON,"Save As",755,46,90,20,0x50000000,savebutton
CONTROL d1,@BUTTON,"Save",755,76,90,20,0x50000000,saveme
CONTROL d1,@BUTTON,"Load",755,16,90,20,0x50000000,loadbutton
CONTROL d1,@BUTTON,"New",755,106,90,20,0x50000000,clearscreen
CONTROL d1,@BUTTON,"Print",755,166,90,20,0x50000000,printme
CONTROL d1,@BUTTON,"",15,170,100,100,@CTLBTNBITMAP,diarypicbutton 'DIARY PICTURE BUTTON
CONTROL d1,@BUTTON,"",125,170,100,100,@CTLBTNBITMAP,BEEpicbutton 'BEE PICTURE BUTTON
CONTROL d1,@BUTTON,"",235,170,100,100,@CTLBTNBITMAP,GARDENpicbutton 'GARDEN PICTURE BUTTON
CONTROL d1,@BUTTON,"",345,170,100,100,@CTLBTNBITMAP,PHONEpicbutton 'PHONE PICTURE BUTTON
CONTROL D1,@BUTTON,"",455,170,100,100,@CTLBTNBITMAP,SHOPPINGpicbutton' shopping list button
CONTROL D1,@BUTTON,"",565,170,100,100,@CTLBTNBITMAP,TODOpicbutton' TODO list button
CalendarControl d1,755,266,250,200,@border,0,IDCALENDAR

'ccGetMinimumRect d1,IDCALENDAR,rcTemp

'ccSetColor d1,IDCALENDAR,MCSC_MONTHBK,RGB(255,16,44)





SETCONTROLNOTIFY(d1,4,0,1)'enables enter in the text box
setcontrolnotify(d1,2,0,1) 'enables enter in search box

centerwindow d1
SETLBCOLWIDTH d1,combo_1, 300

SetFont d1,"Georgia",12,400,0
SetWindowColor d1, RGB(0,0,255)
FrontPen d1, RGB(255,255,255)
backpen d1,RGB(0,0,255)
SetFont d1,"Georgia",11,600,0,COMBO_1
SetFont d1,"Georgia",11,600,0,editbox_3
CONTROLCMD d1, editbox_3, @EDSETLIMITTEXT, 999
SetFont d1,"System",12,700,0,idcalendar

'SetControlColor d1,idcalendar,RGB(255,255,255),RGB(255,73,44)

SetControlColor d1,COMBO_1,RGB(0,64,128),RGB(0,255,255)
SetControlColor d1,editbox_3,RGB(0,64,128),RGB(255,255,0)
setcontrolcolor d1,edit_2,RGB(255,255,0),rgb(57,1,126)'  edit_2 is actually a BUTTON
setfont d1,"MS Sans Serif",10,700,0,edit_2
setcontrolcolor d1,loadbutton,RGB(255,255,0),rgb(57,1,126)'  load
setfont d1,"MS Sans Serif",10,700,0,loadbutton
setcontrolcolor d1,savebutton,RGB(255,255,0),rgb(57,1,126)'  save color
setfont d1,"MS Sans Serif",10,700,0,savebutton
setcontrolcolor d1,saveme,RGB(255,255,0),rgb(57,1,126)'  direct save
setfont d1,"MS Sans Serif",10,700,0,saveme
setcontrolcolor d1,clearscreen,RGB(255,255,0),rgb(57,1,126)'  clearscreen is actually for NEW
setfont d1,"MS Sans Serif",10,700,0,clearscreen
setcontrolcolor d1,printme,RGB(255,255,0),rgb(57,1,126)'  print
setfont d1,"MS Sans Serif",10,700,0,printme
setcontrolcolor d1,searchbutton,RGB(255,255,0),rgb(57,1,126)'  search button
setfont d1,"MS Sans Serif",10,700,0,searchbutton
setcontrolcolor d1,quitme,RGB(255,255,0),rgb(57,1,126)'  quit BUTTON
setfont d1,"MS Sans Serif",10,700,0,quitme
'MYPIC= LOADIMAGE(2,@IMGSCALABLE)
'SHOWIMAGE d1,mypic, @IMGscalable, 855, 16,150,130

hIcon = LOADIMAGE(1, @IMGicon)

SETICON d1, hIcon

'SET BUTTON BITMAP FILE IMAGES HERE
DIARYPIC= LoadImage (1001,@IMGBITMAP)
SetControlText d1, 20, "1001"
BEEPIC= LoadImage (1002,@IMGBITMAP)
SetControlText d1, 21, "1002"
GARDENPIC= LoadImage (1003,@IMGBITMAP)
SetControlText d1, 22, "1003"
PHONEPIC= LoadImage (1004,@IMGBITMAP)
SetControlText d1, 23, "1004"
SHOPPINGPIC= LoadImage (1005,@IMGBITMAP)
SetControlText d1, 24, "1005"
TODOPIC= LoadImage (1007,@IMGBITMAP)
SetControlText d1, 25, "1007"





'START MENU ITEMS HERE

BEGINMENU D1
MENUTITLE "Menu"
Menuitem "General Diary",0,d1_menuGENERAL
Menuitem "Bees Diary",0,d1_menuBees
Menuitem "Garden Diary",0,d1_menuGarden
MENUITEM "Phone List",0,d1_menuPhone
menuitem "Shopping List",0,d1_menuShopping
menuitem "Todo List",0,d1_menuToDo
MENUITEM "Quit",0, D1_MENUQUIT
menutitle "About"
menuitem "About",0,d1_menuabout
ENDMENU
gosub openGeneralfile
sETFOCUS D1,4  'PUT CURSOR IN EDIT BOX disabled setfocus so delete key will work
'DELETESTRING D1,COMBO_1,0  'WILL THIS WORK ON FIRST ENTRIES?
'above line may have been deleting first line of diary box
'MENU HANDLER ROUTINES HERE
onmenupick d1,d1_menuquit,&quitmenow
onmenupick d1,d1_menuGENERAL,&OpenGeneralFile
onmenupick d1,d1_menuBees,&OpenBeesFile
onmenupick d1,d1_menuGarden,&OpenGardenFile
onmenupick d1,d1_menuPhone,&OpenPhoneFile
onmenupick d1,d1_menuShopping,&OpenShoppingFile
ONMENUPICK d1,d1_menutodo,&OpenTodoFile
onmenupick d1,d1_menuabout,&about



waituntil d1=0

SUB d1_handler
SELECT @MESSAGE

'new code for delete key response  DOES NOT WORK
'case @IDCHAR
case @idkeydown  'works just like @idchar
key=@CODE
if (key=0x2E) 'INITIALLY SET FOR del KEY
gosub deleteline
ENDIF
'end of new code for key press

CASE @IDCLOSEWINDOW
gosub quitmenow

CASE @IDCONTROL
'calendar handler here
CONST MCN_SELECT = (MCN_FIRST + 4)
if @controlid=idcalendar
if @notifycode=MCN_SELECT Then  
'CALENDAR CONTROL HANDLING BELOW
 'reads the calendar control and sets the date into verbose fashion and displays on screen when clicked
SETCONTROLTEXT D1,EDITBOX_3,""
SETSELECTED D1,cOMBO_1,-1  'PUTTING CLEAR SELECTION HERE AVOIDS SELECTION WHEN NOT WANTED
ccGetCurSel d1,idcalendar,m,d,y
gosub monthdefine  'SUB gives a name to each month.  Not so easy to do with days
mydate=str$(d)+" "+month+" "+str$(y)
setcontroltext d1,edit_1,""  'clear the screen in search box first
setcontroltext d1,editbox_3,""  'do same in the edit box
setfocus d1,editbox_3



'IS FOLLOWING NECESSARY? DOESN'T PRINT DATE AT ALL WITHOUT IT IF DATE ENTRY MISSING IN LISTBOX
CONTROLCMD d1,editbox_3, @RTREPLACESEL, mydate  'this works fine to put text at cursor position
setfocus d1,edit_1
gosub searchfordate(pos)
'SETCONTROLTEXT D1, EDITBOX_3,MYSTRING 'CHECKING STRING HERE RESULTS IN DISAPPEARING SCREEN

setfocus d1,EDITBOX_3:CONTROLCMD d1,editbox_3,@EDSETSELECTION,-3,-3: 'THIS WORKS..NEEDS THE SETFOCUS COMMAND FIRST
'RATHER CUMBERSOME WAY OF CHECKING AMOUNT OF TEXT IN EDIT BOX SO REMOVES STRING FOR DATE ONLY OR SHORT ENTRY
'CHECKSTRING=GETCONTROLTEXT D1,EDITBOX_3: IF LEN(CHECKSTRING)<18:SETSELECTED D1,COMBO_1,-1:ENDIF
'NOT NECESSARY TO PUT THIS CONDITIONAL THERE AS LONG AS CLEARS SELECTION AT START OF CALENDAR SELECTION
endif
endif
'end of calendar handler



           IF @CONTROLID = 4 'if the edit box
               SELECT @NOTIFYCODE
                   CASE @ENENTERKEY
                       gosub newentry
deletestring d1,combo_1,-1
                        ENDSELECT
           ENDIF
'respond to search box enter key here
IF @CONTROLID = 2 'if the search box
               SELECT @NOTIFYCODE
                   CASE @ENENTERKEY
                       gosub searchme(POS)

                        ENDSELECT
           ENDIF


SELECT @CONTROLID


CASE COMBO_1


IF @IDLBUTTONDN 'THIS WORKS WELL ON SINGLE CLICK IF LEFT BUTTON CLICKED
POS=GETSELECTED(D1,COMBO_1)
MYSTRING=GETSTRING(D1,COMBO_1,POS)
setcontroltext d1,4,mystring 'READ STRING IN COMBO AND PUT IN EDIT

endif



case savebutton  'to save file
IF @NOTIFYCODE = 0
gosub savefile
               endif

case clearbutton  'to clear search box and edit box
IF @NOTIFYCODE = 0
gosub clearme

               endif

case clearscreen  'to start new file on clicking NEW
IF @NOTIFYCODE = 0
'gosub warning
gosub startnewfile
               endif

case saveme  'to save file directly
IF @NOTIFYCODE = 0
gosub directSAVE
               endif

case printme  'to print file
IF @NOTIFYCODE = 0
gosub printmenow
               endif

case quitme
if @notifycode=0
gosub quitmenow
endif
case loadbutton  'to load file
IF @NOTIFYCODE = 0
setcontroltext d1,editbox_3,""
IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF
gosub openoldfile
               endif

case searchbutton  'to search file
IF @NOTIFYCODE = 0
gosub searchme(pos)
               endif

'RESPONSE TO BITMAP BUTTONS STARTS HERE

case DiaryPicbutton  'to open diary file
IF @NOTIFYCODE = 0
gosub OpenGeneralFile
               endif

case BeePicbutton  'to open diary file
IF @NOTIFYCODE = 0
gosub OpenBeesFile
               endif

case GardenPicbutton  'to open diary file
IF @NOTIFYCODE = 0
gosub OpenGardenFile
               endif

case PhonePicbutton  'to open diary file
IF @NOTIFYCODE = 0
gosub OpenPhoneFile
               endif

case SHOPPINGPicbutton  'to open SHOPPING file
IF @NOTIFYCODE = 0
gosub OpenSHOPPINGFile
               endif

case ToDoPicbutton  'to open todo file
IF @NOTIFYCODE = 0
gosub OpenToDoFile
               endif

case edit_2 'delete key
IF @NOTIFYCODe = 0
pos=gETSELECTED d1, combo_1
deletestring d1,combo_1,pos
setcontroltext d1,4,""

SETSELECTED D1,COMBO_1,POS
endif
/* respond to control notifications here */

ENDSELECT
ENDSELECT
RETURN
ENDSUB

sub updatecombo
mystring=getcontroltext(d1,combo_1):

addstring d1,combo_1,mystring


setcontroltext d1,combo_1,""
setcontroltext d1,4,mystring 'print it to the edit box too
return
ENDSUB

SUB newentry
pos=gETSELECTED d1, combo_1
mystring=getcontroltext(d1,editbox_3)
deletestring d1,combo_1,pos  'NOT SURE IF THIS IS STILL USED. CHECK LATER
addstring d1,combo_1,mystring
setcontroltext d1,4,""
deletestring d1,combo_1,-1  'USING 0 HERE DELETES THE ENTRY JUST MADE



RETURN
ENDSUB


sub savefile

closefile myfile
IF MESSAGEBOX(D1,"Choose a new file to save your work?","SAVE FILE?",@mb_yesno) =@idyes

count=0
count=GETSTRINGCOUNT (D1,COMBO_1)'COUNT NUMBER OF STRINGS IN LIST BOX
mystring=""

filter = "Diary List Files |*.lst|All Files|*.*||"

filename = filerequest("Save As New File",d1,0,filter,"lst",0,"")
if(len(filename) > 0)
if (openfile(myfile,filename,"W")=0)



for x =0 to count 'position of first string is 0 in a combobox
mystring=GETSTRING (d1, COMBO_1, x)
WRITE myfile, mystring
next x
closefile myfile

endif
endif
endif
'gosub backupAndOpenFile THIS IS BIT CAUSING MAJOR PROBLEMS
RETURN
endsub


sub openoldfile  'note can't call this sub openfile as it is a reserved word THIS IS LOAD
'CLEAR THE LIST BOX FIRST BEFORE LOADING
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x

'NOW DO THE OPEN FILE PROCEDURE
filter = "List Files (*.lst)|*.lst|All Files|*.*||"  'filters only for files ending in 'lst' PLUS ALL
filename=filerequest("Load File",d1,1,filter,"*.lst",0,"") ' opens the file request dialog
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
deletestring d1,combo_1,0  'for some reason I need to delete the first line which is blank, this works ok
  CLOSEFILE myfile
ENDIF
endif
MOVE D1, 25,270
PRINT D1, "Open File is "+ filename+"                "
RETURN
endsub


sub directSAVE
'setcontroltext d1,editbox_3,filename  'SHOWS FILENAME IS PASSED TO THIS SUB
closefile myfile
'IF MESSAGEBOX(D1,"Choose a new file to save your work?","SAVE FILE?",@mb_yesno) =@idyes

count=0
count=GETSTRINGCOUNT (D1,COMBO_1)'COUNT NUMBER OF STRINGS IN LIST BOX
mystring=""
'filter = "List Files (*.lst)|*.lst||"
'filename = filerequest("Save File",d1,0,filter,"*.lst")
if filename="":filename="saved.lst":endif
if(len(filename) > 0)
if (openfile(myfile,filename,"W")=0)



for x =0 to count 'position of first string is 0 in a combobox
mystring=GETSTRING (d1, COMBO_1, x)
WRITE myfile, mystring
next x
closefile myfile

'endif
endif
endif

RETURN
ENDSUB
/*
sub backupAndOpenFile  'INVESTIGATE EXACTLY WHAT THIS DOES AND WHERE. NOT SURE IT IS NEEDED
'MAY CONFUSE THINGS IN THIS NEW VERSION
closefile myfile
'IF MESSAGEBOX(D1,"Choose a new file to save your work?","SAVE FILE?",@mb_yesno) =@idyes

count=0
count=GETSTRINGCOUNT (D1,COMBO_1)'COUNT NUMBER OF STRINGS IN LIST BOX
mystring=""
filter = "List Files (*.lst)|*.lst||"
'filename = filerequest("Save File",d1,0,filter,"*.lst")
filename="diary.lst"
if(len(filename) > 0)
if (openfile(myfile,filename,"W")=0)



for x =0 to count 'position of first string is 0 in a combobox
mystring=GETSTRING (d1, COMBO_1, x)
WRITE myfile, mystring
next x
closefile myfile


endif
endif

RETURN
ENDSUB
*/
sub openlastfile  'sub to load whatever was last saved from original version
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x

'NOW DO THE OPEN FILE PROCEDURE
filter = "List Files (*.lst)|*.lst||"  'filters only for files ending in 'lst'
'filename=filerequest("Load File",d1,1,filter,"*.lst") ' opens the file request dialog
filename="diary.lst"
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
'deletestring d1,combo_1,0  'for some reason I need to delete the first line which is blank, this works ok
  CLOSEFILE myfile
ENDIF
endif



RETURN
ENDSUB

sub startnewfile
gosub directsave
filename=""  'prevents saving new file over the old oneNo
MOVE D1, 25,270
PRINT D1, "No file currently open                                                                                                                                       "
count=0  'INITIALISE COUNT AS 0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen
'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
setcontroltext d1,editbox_3,""

RETURN
ENDSUB

sub printmenow
startpg = 1
endpg = 1
copies = 1
collate = 1
printer = PRTdialog(d1,startpg,endpg,copies,collate)
hprinter = OPENPRINTER(printer,"Document","TEXT")
if(hprinter)
count=GETSTRINGCOUNT (d1,combo_1)
for x=0 to count
buffer=buffer+"  "+"\n"+GETSTRING (d1, combo_1, x)
next x
WRITEPRINTER hprinter, buffer
CLOSEPRINTER hprinter
endif
RETURN
ENDSUB

sub searchme(pos as int)
count=0:mystring="":pos=0
count=GETSTRINGCOUNT (D1,COMBO_1)'COUNT NUMBER OF STRINGS IN LIST BOX
searchstring=""
searchstring=ucase$(getcontroltext d1,edit_1)  'this works
for x =0 to count 'position of first string is 0 in a combobox
mystring=GETSTRING (d1, COMBO_1, x)
POS=X
if instr(ucase$(mystring),searchstring)>0:setcontroltext d1,editbox_3,mystring:SETSELECTED D1,COMBO_1,POS:endif 'both terms must be UCASE
next x
'setcontroltext d1,editbox_3,mystring
'setcontroltext d1,edit_1,""  MAY NEED TO RESTORE THIS
return 0
endsub

sub monthdefine
if m=1
month="January"
elseif m=2
month="February"
elseif m=3
month="March"
elseif m=4
month="April"
elseif m=5
month="May"
elseif m=6
month="June"
elseif m=7
month="July"
elseif m=8
month="August"
elseif m=9
month="September"
elseif m=10
month="October"
elseif m=11
month="November"
elseif m=12
month="December"
endif
RETURN 0
endsub

sub searchfordate (pos as int)
count=0:MYSTRING="":pos=0
count=GETSTRINGCOUNT (D1,COMBO_1)'COUNT NUMBER OF STRINGS IN LIST BOX
searchstring=""
searchstring=ucase$(mydate)  'this works
for x =0 to count 'position of first string is 0 in a combobox
mystring=GETSTRING (d1, COMBO_1, x)
'below now works in setting correct string as selected.  Must be here not back at calendar bit
pos=x  'checks position of selected string for date
'if mystring="":gosub clearme:endif  'this clears screen regardless!
'if mystring="":SETSELECTED D1,COMBO_1,-1:endif 'clears selection every time
if instr(ucase$(mystring),searchstring)>0:setcontroltext d1,editbox_3,mystring:setselected d1,combo_1,pos:endif 'both terms must be UCASE

next x


'setcontroltext d1,editbox_3,str$(pos) 'trying to see what position is reached
'setcontroltext d1,editbox_3,mystring
'setcontroltext d1,edit_1,""

return 0
endsub

sub clearme
setcontroltext d1,editbox_3,""
setcontroltext d1,edit_1,""
SETSELECTED D1,COMBO_1,-1  'THIS SEEMS TO DO THE TRICK IN AVOIDING FIXED SELECTION
'setselected d1,combo_1,pos  DON'T WANT A SELECTED ITEM AFTER CLEAR AS PUTTING IN NEW ONE
SETFOCUS D1,4 'SET FOCUS IN MAIN EDIT BOX
return 0
ENDSUB

sub warning
if messagebox(d1,"Please save file before changing?", "Save File?",@mb_yesno)=@idyes

gosub savefile
endif
return 0
endsub

sub quitmenow
if messagebox(d1,"Really exit?", "Make sure you have saved any file",@mb_yesno)=@idyes
gosub directsave
DELETEIMAGE handle, @IMGSCALABLE
DELETEIMAGE DIARYPIC,@IMGBITMAP
DELETEIMAGE BEEPIC,@IMGBITMAP
DELETEIMAGE GARDENPIC,@IMGBITMAP
DELETEIMAGE PHONEPIC,@IMGBITMAP
DELETEIMAGE SHOPPINGPIC,@IMGBITMAP
deleteimage todopic,@imgbitmap
deleteimage hicon,@imgicon
freemem mymem
closefile myfile
closewindow d1
end
endif

return 0
endsub

sub about
messagebox(d1,"Calendar Listbox, Mousseaux Software 2011, www.loire-gites.eu/software", "Listbox Calendar",@mb_ok)
return 0
endsub

sub OpenGeneralFile
handle=0
IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF
'sub to load the general diary file and also on opening the program
filename="diary.lst"  'NAME OF GENERAL FILEREQUEST
'FIRST CLEAR THE CURRENT SCREEN AND ITEMS IN LIST BOX
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
'NOW START LOADING THE FILE CALLED DIARY.LST
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
  CLOSEFILE myfile
ENDIF
endif
'take out annoying empty line at start of listbox
DELETESTRING d1, combo_1, 0
'AT THIS POINT PAINT THE APPROPRIATE SCALEABLE IMAGE TO SCREEN AND ALSO PRINT TEXT ON SCREEN
handle=loadimage(2,@IMGSCALABLE)
showimage d1,handle,@imgscalable, 855,16,150,130
'now print name of diary file to window between the edit box and listbox
MOVE D1, 25,270
PRINT D1, "Open File is "+ filename+"                                                                                                                                                        "
return 0
endsub

sub OpenBeesFile
IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF
'sub to load the bees diary file
handle=0
'sub to load the bees diary file and also on opening the program
filename="bees.lst"  'NAME OF GENERAL FILEREQUEST
'FIRST CLEAR THE CURRENT SCREEN AND ITEMS IN LIST BOX
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
'NOW START LOADING THE FILE CALLED DIARY.LST
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
  CLOSEFILE myfile
ENDIF
endif
'take out annoying empty line at start of listbox
DELETESTRING d1, combo_1, 0  
'AT THIS POINT PAINT THE APPROPRIATE SCALEABLE IMAGE TO SCREEN AND ALSO PRINT TEXT ON SCREEN
handle=loadimage(3,@IMGSCALABLE)
showimage d1,handle,@imgscalable, 855,16,150,130
'now print name of diary file to window between the edit box and listbox
MOVE D1, 25,270
PRINT D1, "  Open File is "+ filename+"                                                                                                                                                    "

return 0
endsub

sub OpenGardenFile
IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF  'SAVES LAST FILE USED BEFORE THE CHANGE
'sub to load the garden diary file
handle=0
'sub to load the general diary file and also on opening the program
filename="garden.lst"  'NAME OF GENERAL FILEREQUEST
'FIRST CLEAR THE CURRENT SCREEN AND ITEMS IN LIST BOX
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
'NOW START LOADING THE FILE CALLED garden.LST
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
  CLOSEFILE myfile
ENDIF
endif
'take out annoying empty line at start of listbox
DELETESTRING d1, combo_1, 0
'AT THIS POINT PAINT THE APPROPRIATE SCALEABLE IMAGE TO SCREEN AND ALSO PRINT TEXT ON SCREEN
handle=loadimage(4,@IMGSCALABLE)
showimage d1,handle,@imgscalable, 855,16,150,130
'now print name of diary file to window between the edit box and listbox
MOVE D1, 25,270
PRINT D1, "Open File is "+ filename+"                                                                                                                                            "

return 0
endsub

sub openphonefile
IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF  'SAVES LAST FILE USED BEFORE THE CHANGE
'sub to load the garden diary file
handle=0
'sub to load the phone file
filename="phone.lst"  'NAME OF GENERAL FILEREQUEST
'FIRST CLEAR THE CURRENT SCREEN AND ITEMS IN LIST BOX
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
'NOW START LOADING THE FILE CALLED phone.LST
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
  CLOSEFILE myfile
ENDIF
endif
'take out annoying empty line at start of listbox
DELETESTRING d1, combo_1, 0
'AT THIS POINT PAINT THE APPROPRIATE SCALEABLE IMAGE TO SCREEN AND ALSO PRINT TEXT ON SCREEN
handle=loadimage(5,@IMGSCALABLE)
showimage d1,handle,@imgscalable, 855,16,150,130
'now print name of diary file to window between the edit box and listbox
MOVE D1, 25,270
PRINT D1, "Open File is "+ filename+"                                                                                                                                            "

return 0
endsub

SUB OPENSHOPPINGFILE

IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF  'SAVES LAST FILE USED BEFORE THE CHANGE
'sub to load the SHOPPING diary file
handle=0
'sub to load the phone file
filename="SHOPPING.lst"  'NAME OF GENERAL FILEREQUEST
'FIRST CLEAR THE CURRENT SCREEN AND ITEMS IN LIST BOX
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
'NOW START LOADING THE FILE CALLED SHOPPING.LST
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
  CLOSEFILE myfile
ENDIF
endif
'take out annoying empty line at start of listbox
DELETESTRING d1, combo_1, 0
'AT THIS POINT PAINT THE APPROPRIATE SCALEABLE IMAGE TO SCREEN AND ALSO PRINT TEXT ON SCREEN
handle=loadimage(1006,@IMGSCALABLE)
showimage d1,handle,@imgscalable, 855,16,150,130
'now print name of diary file to window between the edit box and listbox
MOVE D1, 25,270
PRINT D1, "Open File is "+ filename+"                                                                                                                                            "


RETURN 0
ENDSUB

sub OpenTodoFile
IF FILENAME<>"":GOSUB DIRECTSAVE:ENDIF  'SAVES LAST FILE USED BEFORE THE CHANGE
'sub to load the todo diary file
handle=0
'sub to load the phone file
filename="todo.lst"  'NAME OF GENERAL FILEREQUEST
'FIRST CLEAR THE CURRENT SCREEN AND ITEMS IN LIST BOX
count=0
count=GETSTRINGCOUNT (d1,combo_1)  'get number of strings on screen

'now delete them ALL
for x=0 to count
DELETESTRING d1, combo_1, 0  
next x
'NOW START LOADING THE FILE CALLED SHOPPING.LST
if (len(filename)>0) 'if there is a file that's more than zero
if (openfile(myfile,filename,"R")=0)  'open the file by name
do
   READ myfile,mystring
addstring d1,combo_1,mystring
UNTIL EOF(myfile)
  CLOSEFILE myfile
ENDIF
endif
'take out annoying empty line at start of listbox
DELETESTRING d1, combo_1, 0
'AT THIS POINT PAINT THE APPROPRIATE SCALEABLE IMAGE TO SCREEN AND ALSO PRINT TEXT ON SCREEN
handle=loadimage(1008,@IMGSCALABLE)
showimage d1,handle,@imgscalable, 855,16,150,130
'now print name of diary file to window between the edit box and listbox
MOVE D1, 25,270
PRINT D1, "Open File is "+ filename+"                                                                                                                                            "


return 0
ENDSUB

sub deleteline
messagebox(d1,"delete line here", "Make sure you have saved any file",@mb_yesno)
return 0
ENDSUB

[LarryMc]

You discovered the easier way (using the mouse instead of the DEL key).
Below is the way to do it with subclassing.
I remembered that I had done a subclass of a listbox to allow it to have a rightclick context menu so that was why I had subclassing on my mind.

Code Select Expand

$include "windowssdk.inc"
$include "commctrl.inc"

CONST LISTBOX_1 = 1000
$define SUBCLASS1_ID 54321 ' any unique number
window w1
openwindow w1,0,0,300,202,0x80CB0080,0,"Caption",&w1_handler
CONTROL w1,@LISTBOX,"ListBox1",13,10,173,155,0x50A10140,LISTBOX_1
SetWindowSubclass(GetControlhandle(w1,LISTBOX_1), &MySubclassProc, SUBCLASS1_ID, 0)
SendMessage(w1, LB_ADDSTRING, 0, "item 1", LISTBOX_1)
SendMessage(w1, LB_ADDSTRING, 0, "item 2", LISTBOX_1)
SendMessage(w1, LB_ADDSTRING, 0, "item 3", LISTBOX_1)
SendMessage(w1, LB_ADDSTRING, 0, "item 4", LISTBOX_1)
SendMessage(w1, LB_ADDSTRING, 0, "item 5", LISTBOX_1)
waituntil IsWindowClosed(w1)
end

SUB w1_handler(),int
SELECT @MESSAGE
CASE @IDcreate
CENTERWINDOW w1
CASE @IDCLOSEWINDOW
RemoveWindowSubclass(GetControlhandle(w1,LISTBOX_1), &MySubclassProc, SUBCLASS1_ID)
CLOSEwindow w1
CASE @IDCONTROL
SELECT @CONTROLID
CASE LISTBOX_1
/* respond to control notifications here */
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

sub MySubclassProc(HWND hWnd,UINT uMsg,WPARAM wParam,LPARAM lParam,UINT_PTR uIdSubclass,DWORD_PTR dwRefData)
Select uMsg
case @IDKEYUP
if (wparam=0x2E) /*Del Key from virtual table*/
deleteline()
ENDIF
Case WM_DESTROY
RemoveWindowSubclass(hWnd,&MySubclassProc,SUBCLASS1_ID)
EndSelect
Return DefSubclassProc(hWnd,uMsg,wParam,lParam)
EndSub

sub deleteline
int pos=GETSELECTED (w1, LISTBOX_1)
if pos then DELETESTRING(w1, LISTBOX_1, pos)
return
endsub

By all means use the easier way if it works for you.

[LarryMc]

I plugged in your mouse routine and did a little testing with program below.

first, you changed on me from deleting an entry to copying an entry.
the example below works  sorta
notice that when you left click inside the listbox the trap fires one time
after doing that look what happens when you leave the listbox by clicking in the window.
the trap fires multiple times.
if you're going to just copy then maybe the simple will work for you
if you're going to delete you need to use the subclass.

Code Select Expand

$include "windowssdk.inc"
openconsole
DEF w1:window
OPENWINDOW w1,0,0,350,200,@MINBOX,0,"Jukebox",&mainwindow
CONTROL w1,@listbox,"Play",20,20,100,120,@CTLISTNOTIFY ,11
SendMessage(w1, LB_ADDSTRING, 0, "item 1", 11)
SendMessage(w1, LB_ADDSTRING, 0, "item 2", 11)
SendMessage(w1, LB_ADDSTRING, 0, "item 3", 11)
SendMessage(w1, LB_ADDSTRING, 0, "item 4", 11)
SendMessage(w1, LB_ADDSTRING, 0, "item 5", 11)
waituntil iswindowclosed(w1)
closeconsole
end

SUB mainwindow(),int
select @message

   CASE @IDCLOSEWINDOW
      closewindow w1
case @IDKEYUP
int key=@wparam
if (key=0x2E) /*Del Key from virtual table*/
'gosub deleteline
?key
ENDIF
   CASE @IDCONTROL
      SELECT @CONTROLID
         CASE 11: 'listbox
IF @IDLBUTTONDN 'THIS WORKS ok
int POS=GETSELECTED(w1,11)
string MYSTRING=GETSTRING(w1,11,POS)
?"["+mystring+"]"

endif

      ENDSELECT

   CASE @IDCREATE
      CENTERWINDOW w1
ENDSELECT
RETURN 0
ENDSUB



[AdrianFox]

Wow.  Those replies were so quick!  I had been trawling the net looking at subclassing controls but ended up more confused than before as most of the examples were in C or VB!!
Having the code to follow and work through is an enormous help.
One little query on the first example you gave me... I noticed it wasn't possible to delete the first 'item1' entry but if you change the code to the below, you could.  I am not quite sure why!:
   

Code Select Expand

sub deleteline
int pos=GETSELECTED (w1, LISTBOX_1)
if pos>-1 then DELETESTRING(w1, LISTBOX_1, pos)  'changed to minus 1 position
return
endsub

Anyway, thanks again and I will find a good solution to what I want to do from your code.  (All I am trying to do is to delete an item from my listbox entries my selecting it and hitting 'delete' as most users would automatically do, rather than going to the delete button  I created in the window.  )

[LarryMc]

One little query on the first example you gave me... I noticed it wasn't possible to delete the first 'item1' entry but if you change the code to the below, you could.  I am not quite sure why!:

My bad. 
Items in Listboxes, Listviews, comboboxes are all zero based.
That's why you had to do the -1 thing which is the proper way.