I enclose herewith a new edition of CSBox, where in we can add an item, delete an item or delete all items. Kindly check up and give your valuable suggestions. I don't know how to change "include" file to make the function to our semi-oop style.
Code: Select all
#include "minigui.ch"
PROC _DefineComboSearchBox( cCSBoxName,;
cCSBoxParent,;
cCSBoxCol,;
cCSBoxRow,;
cCSBoxWidth,;
cCSBoxHeight,;
cCSBoxValue,;
cFontName,;
nFontSize,;
cToolTip,;
nMaxLenght,;
lUpper,;
lLower,;
lNumeric,;
bLostFocus,;
bGotFocus,;
bEnter,;
lRightAlign,;
nHelpId,;
lBold,;
lItalic,;
lUnderline,;
aBackColor,;
aFontColor,;
lNoTabStop,;
aArray )
LOCAL cParentName := ''
DEFAULT cCSBoxWidth := 120
DEFAULT cCSBoxHeight := 24
DEFAULT cCSBoxValue := ""
DEFAULT bGotFocus := ""
DEFAULT bLostFocus := ""
DEFAULT nMaxLenght := 255
DEFAULT lUpper := .F.
DEFAULT lLower := .F.
DEFAULT lNumeric := .F.
DEFAULT bEnter := ""
IF _HMG_SYSDATA [ 264 ] = .T. // _HMG_BeginWindowActive
cParentName := _HMG_SYSDATA [ 223 ] // _HMG_ActiveFormName
ELSE
cParentName := cCSBoxParent
ENDIF
DEFINE TEXTBOX &cCSBoxName
PARENT &cCSBoxParent
ROW cCSBoxRow
COL cCSBoxCol
WIDTH cCSBoxWidth
HEIGHT cCSBoxHeight
VALUE cCSBoxValue
FONTNAME cFontName
FONTSIZE nFontSize
TOOLTIP cToolTip
MAXLENGTH nMaxLenght
UPPERCASE lUpper
LOWERCASE lLower
NUMERIC lNumeric
ONLOSTFOCUS bLostFocus
ONGOTFOCUS bGotFocus
ONENTER bEnter
ONCHANGE CreateCSBox( cParentName, cCSBoxName, aArray, cCSBoxRow, cCSBoxCol)
RIGHTALIGN lRightAlign
HELPID nHelpId
FONTBOLD lBold
FONTITALIC lItalic
FONTUNDERLINE lUnderline
BACKCOLOR aBackColor
FONTCOLOR aFontColor
TABSTOP lNoTabStop
END TEXTBOX
mVar := '_' + cParentName + '_' + cCSBoxName
_HMG_SYSDATA [ 17 ] [&mVar] := aclone(aArray)
RETURN // _DefineComboSearchBox()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.
STATIC PROC CreateCSBox( cParentName, cCSBoxName, aitems )
LOCAL nFormRow := thisWindow.row
LOCAL nFormCol := thisWindow.col
LOCAL nControlRow := this.row
LOCAL nControlCol := this.col
LOCAL nControlWidth := this.width
LOCAL nControlHeight := this.height
LOCAL cCurValue := this.value
LOCAL aResults := {}
LOCAL nContIndx := GetControlIndex( this.name, thiswindow.name )
LOCAL result := 0
LOCAL nItemNo := 0
LOCAL nListBoxHeight := 0
LOCAL caret := this.CaretPos
LOCAL cCSBxName := 'frm' + cCSBoxName
i := GetControlIndex ( cCSBoxName , cParentName)
aitems := _HMG_SYSDATA [ 17 ] [i]
IF !EMPTY(cCurValue)
IF _HMG_SYSDATA [ 23, nContIndx ] # -1 // _HMG_aControlContainerRow
nControlRow += _HMG_SYSDATA [ 23, nContIndx ] // _HMG_aControlContainerRow
nControlCol += _HMG_SYSDATA [ 24, nContIndx ] // _HMG_aControlContainerCol
ENDIF
FOR nItemNo := 1 TO LEN(aitems)
IF UPPER( aitems[ nItemNo ] ) == UPPER( cCurValue )
EXIT // item selected already
ENDIF
IF UPPER( LEFT( aitems[ nItemNo ], LEN( cCurValue ))) == UPPER(cCurValue)
AADD( aResults, aitems[ nItemNo ] )
ENDIF
NEXT nItemNo
IF LEN( aResults ) > 0
nListBoxHeight := MAX(MIN((LEN(aResults) * 16)+60,thiswindow.height - nControlRow - nControlHeight-10),40)
DEFINE WINDOW &cCSBxName ;
AT nFormRow+nControlRow+20, nFormCol+nControlCol ;
WIDTH nControlWidth+6 ;
HEIGHT nListBoxHeight+nControlHeight ;
TITLE '' ;
MODAL ;
NOCAPTION ;
NOSIZE
ON KEY UP OF This.Window ACTION _CSDoUpKey()
ON KEY DOWN OF This.Window ACTION _CSDoDownKey()
ON KEY ESCAPE OF This.Window ACTION _CSDoEscKey()
DEFINE TEXTBOX _cstext
ROW 3
COL 3
WIDTH nControlWidth
HEIGHT nControlHeight
FONTNAME this.fontname
FONTSIZE this.Fontsize
TOOLTIP this.tooltip
FONTBOLD this.fontbold
FONTITALIC this.fontitalic
FONTUNDERLINE this.fontunderline
BACKCOLOR this.backcolor
FONTCOLOR this.fontcolor
ON CHANGE _CSTextChanged( cParentName, aitems, cCSBoxName )
ON ENTER _CSItemSelected( cParentName, aitems, cCSBoxName )
END TEXTBOX
DEFINE LISTBOX _cslist
ROW nControlHeight+3
COL 3
WIDTH nControlWidth
HEIGHT nListBoxHeight
ITEMS aResults
ON DBLCLICK _CSItemSelected( cParentName, aitems, cCSBoxName )
VALUE 1
END LISTBOX
END WINDOW
SetProperty( cCSBxName, '_cstext', "VALUE", cCurValue )
SetProperty( cCSBxName, '_cstext', "CaretPos", caret )
ACTIVATE WINDOW &cCSBxName
ENDIF
ENDIF
RETURN // CreateCSBox()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
STATIC PROC _CSTextChanged( cParentName, aItems, cTxBName )
LOCAL cCurValue := GetProperty( ThisWindow.Name, '_cstext', "VALUE" )
LOCAL aResults := {}
LOCAL nItemNo := 0
LOCAL nListBoxHeight := 0
LOCAL nParentHeight := GetProperty(cParentName,"HEIGHT")
LOCAL nParentRow := GetProperty(cParentName,"ROW")
DoMethod( ThisWindow.Name, "_csList", 'DeleteAllItems' )
FOR nItemNo := 1 TO LEN(aitems)
IF UPPER( LEFT( aitems[ nItemNo ], LEN(cCurValue))) == UPPER(cCurValue)
AADD(aResults,aitems[ nItemNo ])
ENDIF
NEXT nItemNo
IF LEN(aResults) > 0
FOR nItemNo := 1 TO LEN(aResults)
DoMethod( ThisWindow.Name, "_csList", 'AddItem', aResults[ nItemNo ] )
NEXT i
SetProperty( ThisWindow.Name, "_csList", "VALUE", 1 )
ENDIF
nListBoxHeight := MAX(MIN((LEN(aResults) * 16)+6,(nParentHeight + nParentRow - ;
GetProperty( ThisWindow.Name, 'ROW' ) - ;
GetProperty( ThisWindow.Name, "_csText", 'ROW' ) - ;
GetProperty( ThisWindow.Name, "_csText", 'HEIGHT' ) - 14)), 40)
SetProperty( ThisWindow.Name, "_csList", "HEIGHT", nListBoxHeight )
SetProperty( ThisWindow.Name, "HEIGHT", nListBoxHeight + GetProperty( ThisWindow.Name, '_cstext', "HEIGHT" ) )
RETURN // _CSTextChanged()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
STATIC PROC _CSItemSelected( cParentName, aitems, cTxBName )
if GetProperty( ThisWindow.Name, "_csList", "VALUE" ) > 0
nListValue := GetProperty( ThisWindow.Name, '_csList', "VALUE" )
cListItem := GetProperty( ThisWindow.Name, '_csList', "ITEM", nListValue )
SetProperty( cParentName, cTxBName, "VALUE", cListItem )
SetProperty(cParentName,cTxBName,"CARETPOS",;
LEN( GetProperty( ThisWindow.Name, '_csList', "ITEM",;
GetProperty( ThisWindow.Name, '_csList', "VALUE" ) ) ) )
DoMethod( ThisWindow.Name, "Release" )
ENDIF
RETURN // _CSItemSelected()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
STATIC PROC _CSDoUpKey()
IF GetProperty( ThisWindow.Name, '_csList', "ItemCount" ) > 0 .AND. ;
GetProperty( ThisWindow.Name, '_csList', "VALUE" ) > 1
SetProperty( ThisWindow.Name, '_csList', "VALUE", GetProperty( ThisWindow.Name, '_csList', "VALUE" ) - 1 )
ENDIF
RETURN // _CSDoUpKey()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
STATIC PROC _CSDoDownKey()
IF GetProperty( ThisWindow.Name, '_csList', "ItemCount" ) > 0 .AND. ;
GetProperty( ThisWindow.Name, '_csList', "VALUE" ) < ;
GetProperty( ThisWindow.Name, '_csList', "ItemCount" )
SetProperty( ThisWindow.Name, '_csList', "VALUE", GetProperty( ThisWindow.Name, '_csList', "VALUE" ) + 1 )
ENDIF
RETURN // _CSDoDownKey()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
STATIC PROC _CSDoEscKey()
SetProperty( ThisWindow.Name, '_csText', "VALUE",'')
DoMethod( ThisWindow.Name, "Release" )
RETURN // _CSDoEscKey()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
function _CSBDeleteAllItems(cCSBoxName,cCSBoxParent)
local mvar
mVar := '_' + cCSBoxParent + '_' + cCSBoxName
_HMG_SYSDATA [ 17 ] [&mVar] := {}
return nil
function _CSBDeleteItem(cCSBoxName,cCSBoxParent,x)
local mvar
mVar := '_' + cCSBoxParent + '_' + cCSBoxName
adel(_HMG_SYSDATA [ 17 ] [&mvar],x)
asize(_HMG_SYSDATA [ 17 ] [&mvar],len(_HMG_SYSDATA [ 17 ] [&mvar]) - 1)
return nil
function _CSBAddItem(cCSBoxName,cCSBoxParent,x)
local mvar
mVar := '_' + cCSBoxParent + '_' + cCSBoxName
aadd(_HMG_SYSDATA [ 17 ] [&mvar],x)
return nil