simple adding machine
the program has 20 lines of view using a listbox as a template.
this is a on going project, something i have wanted a long since i first used computers.
any special features will be found under the help button.
here is the discussion are started prior to this listing
I used the sample code from the source code section that was placed by Erik Christensen as a template.
some notes from Erik at that location
thanks to borje hagsten and lance edmonds for their inspirational influence on the present code.
the code skeleton was generated by ezgui freeware dialog designer
by christopher r. boss see web site at ezgui.com.
unused code has been removed to improve clarity.
Any minor or otherwise updates should make it first to
the program has 20 lines of view using a listbox as a template.
this is a on going project, something i have wanted a long since i first used computers.
any special features will be found under the help button.
here is the discussion are started prior to this listing
I used the sample code from the source code section that was placed by Erik Christensen as a template.
some notes from Erik at that location
thanks to borje hagsten and lance edmonds for their inspirational influence on the present code.
the code skeleton was generated by ezgui freeware dialog designer
by christopher r. boss see web site at ezgui.com.
unused code has been removed to improve clarity.
Any minor or otherwise updates should make it first to
Code:
'compiled with pbwin 8.04
'paulcalc.bas
#COMPILE EXE
#REGISTER NONE
'#DIM ALL
%NOANIMATE = 1
%NOCOMBO = 1
%NODRAGLIST = 1
%NOHEADER = 1
%NOIMAGELIST = 1
%NOLISTVIEW = 1
%NOSTATUSBAR = 1
%NOTABCONTROL = 1
%NOTOOLBAR = 1
%NOTOOLTIPS = 1
%NOTREEVIEW = 1
%NOUPDOWN = 1
#INCLUDE "win32api.inc"
#INCLUDE "commctrl.inc"
'
%ListBox = 100
%TextOfListItems = 105
%RowHeaderList = 110
%ExitButton = 115
%HelpButton = 116
%OnTopButton =114
%DimmerButton = 117
%DimmerDimButton = 118
%DimmerBrightButton = 119
%DimmerBrighterButton = 113
%itemcount = 120
%VertScrollbar = 135
%EditDescript = 145
'
%EditLabel = 400
%EditText = 410
%EditOK = 415
%EditCancel = 420
%Totalsum = 425
%Edittext1 = 421
%Edittext2 = 422
' --------------------------------------------------
DECLARE SUB ShowListDialog(BYVAL hParent&)
DECLARE CALLBACK FUNCTION ListDialogProc
DECLARE CALLBACK FUNCTION EditDialogProc
DECLARE SUB EditCellForm(BYVAL hParent&)
DECLARE CALLBACK FUNCTION CBF_ListBox()
DECLARE CALLBACK FUNCTION CBF_HeaderBox()
DECLARE CALLBACK FUNCTION CBF_Exit()
DECLARE FUNCTION CBF_Exxit() AS STRING
DECLARE FUNCTION Clearcells() AS STRING
DECLARE FUNCTION beginClearcells() AS STRING
DECLARE FUNCTION SetClipboardText (BYVAL sText AS STRING) AS LONG
DECLARE CALLBACK FUNCTION CBF_Help()
DECLARE CALLBACK FUNCTION CBF_OnTop()
DECLARE CALLBACK FUNCTION CBF_Dimmer()
DECLARE CALLBACK FUNCTION CBF_Dimmerdim()
DECLARE CALLBACK FUNCTION CBF_Dimmerbright()
DECLARE CALLBACK FUNCTION CBF_Dimmerbrighter()
DECLARE CALLBACK FUNCTION CBF_EditText()
DECLARE CALLBACK FUNCTION CBF_EditOK()
DECLARE CALLBACK FUNCTION CBF_EditCancel()
DECLARE SUB UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
' --------------------------------------------------
'DECLARE MakeFont(FONT AS STRING, PointSize AS LONG) AS LONG
GLOBAL Brush&
GLOBAL hListForm& ' Dialog handle
GLOBAL hEditForm& ' Dialog handle
GLOBAL Rows AS LONG ' Total number of rows in array
GLOBAL PageRows AS LONG ' Number of rows on a page
GLOBAL DataArray() AS STRING' One dimensional text array to be displayed
GLOBAL siY AS SCROLLINFO
GLOBAL PrevKey AS LONG ' Previously pressed key
GLOBAL gOldSubClassList&
GLOBAL gOldSubClassEdit&
GLOBAL PresCursPos AS LONG ' Present cursor position in grid list box
GLOBAL CursCorr AS LONG ' Correction used to place cursor correctly
GLOBAL SelY AS LONG ' Row selected
GLOBAL XCR!,YCR! ' conversion factors from pixels to dialog units
GLOBAL XMaxScr AS LONG
GLOBAL YMaxScr AS LONG
GLOBAL Gtotalsum AS CURRENCYX 'DOUBLE
GLOBAL Gtotalcount AS LONG
GLOBAL gAutoinsertnew AS LONG
GLOBAL hFONT AS LONG
GLOBAL hGTFONT AS LONG
GLOBAL gDimmer AS LONG
GLOBAL gOntop AS LONG
GLOBAL gpaulsyprevpos AS LONG
GLOBAL gOldcellvalue AS STRING
FUNCTION MakeFont(BYVAL FFont AS STRING, BYVAL PointSize AS LONG) AS LONG
LOCAL hDC AS LONG
LOCAL CyPixels AS LONG
hDC = GetDC(%HWND_DESKTOP)
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
ReleaseDC %HWND_DESKTOP, hDC
PointSize = (PointSize * CyPixels) \ 72
FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
%ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
%DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY FFont)
END FUNCTION
' --------------------------------------------------
'
FUNCTION PBMAIN
LOCAL hDC AS LONG
LOCAL Count&
LOCAL CC1 AS INIT_COMMON_CONTROLSEX
gautoinsertnew=-1&
CC1.dwSize=SIZEOF(CC1)
CC1.dwICC=%ICC_WIN95_CLASSES
InitCommonControlsEX CC1
Brush&=CreateSolidBrush(RGB(196,196,196)) ' light grey
ShowListDialog 0
CALL beginclearcells()
IF gAutoinsertnew =-1& THEN
CALL prepareforedit
END IF
DO
DIALOG DOEVENTS TO Count&
IF SLOWDOWNCOUNT& MOD 10000 =0 THEN SLEEP 1:SLOWDOWNCOUNT&=0
INCR SLOWDOWNCOUNT&
LOOP UNTIL Count&=0
DeleteObject Brush&
END FUNCTION
' --------------------------------------------------
'
FUNCTION XDU(XPct AS SINGLE) AS LONG ' X transformation function just for this program
XDU=XPct*430*0.01/XCR!
END FUNCTION
'
FUNCTION YDU(YPct AS SINGLE) AS LONG ' Y transformation function just for this program
YDU=YPct*543*0.01/1.90
END FUNCTION
'
SUB ShowListDialog(BYVAL hParent&)
LOCAL Style&, ExStyle&,hCtl&,i&,j&
LOCAL X&,Y&,X1&,Y1&,hDlg&,res&
LOCAL hSYSMENU AS LONG
XMaxScr=GetSystemMetrics(%SM_CXFULLSCREEN)
IF XMaxScr >800 THEN XMaxScr=800
YMaxScr=GetSystemMetrics(%SM_CYFULLSCREEN)
IF YMaxScr >543 THEN YMaxScr=543
X&=300: Y&=200
DIALOG NEW 0,"",,,X&,Y&, %WS_VISIBLE, TO hDlg&
DIALOG UNITS hDlg&, X&, Y& TO PIXELS X1&, Y1&
DIALOG END hDlg&
XCR!=X1&*10000/X&: XCR!=XCR!/10000
YCR!=Y1&*10000/Y&: YCR!=YCR!/10000
'
' Specification of size of array.
' You may test other size.
Rows=99999
'
' The listbox routines are made for array no less than (20)
Rows=MAX(20,Rows)
REDIM DataArray(1:Rows)
' Fill array with data
FOR j&=1 TO Rows
DataArray(j&)=""
NEXT
Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_EX_TOPMOST
ExStyle& = 0
DIALOG NEW hParent&, "Adding machine", 0, 0,XDU(58),YDU(73.5), Style&, ExStyle& TO hListForm&
CONTROL ADD LISTBOX, hListForm&,%ListBox, , XDU(.25),YDU(4.65),XDU(42.5),YDU(69.4), _
%WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_BORDER OR %WS_TABSTOP CALL CBF_ListBox
CONTROL ADD SCROLLBAR, hListForm&,%VertScrollbar,"" , XDU(56.1),YDU(4.65),XDU(2.5),YDU(65.2), _
%WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
CONTROL ADD LISTBOX, hListForm&, %RowHeaderList, ,XDU(43.00),YDU(4.65),XDU(12.5),YDU(69.4), _
%WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_BORDER OR %WS_TABSTOP CALL CBF_HeaderBox
CONTROL ADD BUTTON, hListForm&, %ExitButton, "&X",XDU(.25),YDU(70),XDU(5),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Exit
CONTROL ADD BUTTON, hListForm&, %HelpButton, "&Help",XDU(5.25),YDU(70),XDU(7),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Help
CONTROL ADD BUTTON, hListForm&, %DimmerbrightButton, "Bright",XDU(12.25),YDU(70),XDU(9),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Dimmerbright
CONTROL ADD BUTTON, hListForm&, %DimmerbrighterButton, "+",XDU(21.25),YDU(70),XDU(3),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Dimmerbrighter
CONTROL ADD BUTTON, hListForm&, %DimmerDimButton,"Clear",XDU(24.25),YDU(70),XDU(8),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Dimmerdim
CONTROL ADD BUTTON, hListForm&, %DimmerButton, "-",XDU(32.25),YDU(70),XDU(3),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Dimmer
CONTROL ADD BUTTON, hListForm&, %OntopButton, "top",XDU(36),YDU(70),XDU(6.5),YDU(3.43), _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_ontop
CONTROL ADD LABEL, hListForm&, %itemcount,"", XDU(45),YDU(0.0),XDU(10),YDU(2.35), _
%WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
CONTROL ADD TEXTBOX, hListForm&, %Totalsum,"", XDU(.25),YDU(.00),XDU(42.5),YDU(4.2), %SS_RIGHT OR %ES_READONLY OR %WS_BORDER, %WS_EX_WINDOWEDGE
hFONT = GetStockObject(%SYSTEM_FIXED_FONT)
'hGTFONT = MakeFont("Courier New Bold",12)
'remove the close box in the gui
EnableMenuItem GetSystemMenu(hlistform&, 0), %SC_CLOSE, %MF_BYCOMMAND OR %MF_GRAYED
DIALOG SHOW MODELESS hListForm& , CALL ListDialogProc
CONTROL SEND hListForm&,%ListBox,%WM_SETFONT,hFONT,%TRUE
CONTROL SEND hListForm&,%RowHeaderList,%WM_SETFONT,hFONT,%TRUE
CONTROL SEND hListForm&,%Totalsum,%WM_SETFONT,hFONT,%TRUE
gtotalsum=0.0@@
gtotalcount=0&
FOR j&=1 TO Rows
IF LEN(TRIM$(dataarray(j&))) THEN INCR gtotalcount:gtotalsum=gtotalsum+VAL(REMOVE$(DataArray(j&),","))
NEXT
CONTROL SET TEXT hListForm&, %Totalsum, FORMAT$(gtotalsum,"#,.00")
CONTROL SET TEXT hListForm&, %itemcount, FORMAT$(gtotalcount,"#,0")
GDimmer=100
END SUB
' --------------------------------------------------
'
CALLBACK FUNCTION ListDialogProc
LOCAL hCtl&,j&,Result&
SELECT CASE CBMSG
CASE %WM_INITDIALOG
CONTROL HANDLE CBHNDL, %ListBox TO hCtl&
gOldSubClassList = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassListKeys))
'
' Number of rows in a displayed page
PageRows=20
'
' The scrollbar control bits are based on a fine example
' by Lance Edmonds in the source code forum.
'
' Define vertical scrollbar
siY.cbSize = SIZEOF(siY)
siY.fMask = %SIF_ALL ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
siY.nMin = 1
siY.nMax = Rows
siY.nPage = PageRows
siY.nPos = 1
CONTROL SEND CBHNDL, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
'
' Fill window with data
CALL UpdateWindowAndScrollbar (siY.nPos)
CASE %WM_VSCROLL
SELECT CASE LOWRD(CBWPARAM)
CASE %SB_LINEDOWN : INCR siY.nPos
CASE %SB_PAGEDOWN : siY.nPos = siY.nPos + siY.nPage - 1
CASE %SB_LINEUP : DECR siY.nPos
CASE %SB_PAGEUP : siY.nPos = siY.nPos - siY.nPage + 1
CASE %SB_THUMBTRACK,%SB_THUMBPOSITION
' This code allows for tracking above the 16-bit limit (65536) of HIWRD
' Proposed by Borje Hagsten
siY.cbSize = SIZEOF(siY)
siY.fMask = %SIF_TRACKPOS
CONTROL SEND CBHNDL, %VertScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siY)
siY.nPos = siY.nTrackPos
CASE ELSE : EXIT FUNCTION
END SELECT
' Ensure that position is within range
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
' Reset previous key flag
PrevKey = 0
' MSGBOX STR$(siy.npos)
CALL UpdateWindowAndScrollbar (siY.nPos)
CASE %WM_DESTROY
' Important! Remove the subclassing
SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassList
' -----------------------------------------------
CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
%WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
' Control colors
SELECT CASE GetDlgCtrlID(CBLPARAM)
CASE %RowHeaderList
SetTextColor CBWPARAM, RGB(0,0,0)
SetBkColor CBWPARAM, RGB(196,196,196)
FUNCTION=Brush&
CASE ELSE
FUNCTION=0
END SELECT
CASE ELSE
END SELECT
' Enable redrawing of listbox
CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%TRUE,0 TO Result&
END FUNCTION
' --------------------------------------------------
CALLBACK FUNCTION SubClassListKeys
' Subclass callback function for processing key messages.
' Inspired by Lance Edmonds who provided a fine example in the Source Code Forum
' Completed after valuable feedback by Semen Matusovski and Borje Hagsten.
LOCAL Result&
'
SELECT CASE CBMSG
' The %WM_GETDLGCODE message is sent to the dialog box procedure
' associated with a control. Normally, Windows handles all arrow-key
' and TAB-key input to the control.
' By responding to the %WM_GETDLGCODE message, an application can
' take control of a particular type of input and process the input itself.
CASE %WM_GETDLGCODE
' Specifies that the only extra key we want to be available is
' the ENTER key (= %VK_RETURN) (chr$(13)).
' This particular expression was proposed by Borje Hagsten
IF CBWPARAM = %VK_RETURN THEN
FUNCTION = %DLGC_WANTALLKEYS : EXIT FUNCTION
END IF
CASE %WM_KEYDOWN ' Keys at time of pressing
' The statements below for UP, DOWN, LEFT and RIGHT move are adjusted for
' the "internal" automatic movement produced by the listbox.
SELECT CASE CBWPARAM
CASE %VK_LEFT,%VK_UP
IF PrevKey=%VK_UP THEN
IF PresCursPos <= 1 THEN DECR siY.nPos : CursCorr=1
ELSEIF PrevKey<>%VK_DOWN THEN
IF PresCursPos = 0 THEN DECR siY.nPos : CursCorr=1
END IF
CASE %VK_RIGHT,%VK_DOWN
IF PrevKey=%VK_DOWN THEN
IF PresCursPos >= PageRows - 2 THEN INCR siY.nPos : CursCorr=-1
ELSEIF PrevKey<>%VK_UP THEN
IF PresCursPos = PageRows - 1 THEN INCR siY.nPos : CursCorr=-1
END IF
' The selection movements for PGUP and PGDN are the "internal" automatic listbox movements.
' You may improve them.
CASE %VK_PGUP : siY.nPos = siY.nPos - siY.nPage + 1
CASE %VK_PGDN : siY.nPos = siY.nPos + siY.nPage - 1
'
CASE %VK_HOME : siY.nPos = 0
CASE %VK_END : siY.nPos = Rows
CASE ELSE
END SELECT
PrevKey = CBWPARAM
' Ensure that positions are within range
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
CALL UpdateWindowAndScrollbar (siY.nPos)
CASE %WM_KEYUP ' Keys at time of release (not used)
SELECT CASE CBWPARAM ' Holds the code of the key.
' Specify what action should be taken for each key code.
CASE %VK_F2,%VK_INSERT ' The F2 or Insert key was pressed to edit a line
' Ensure that a cell is selected before editing.
' Otherwise you will have a fatal error !
CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 TO Result&
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, Result&,-1
CALL PrepareForEdit
EXIT FUNCTION
CASE %WM_CHAR ' Any character key at time of pressing
REM REMARKED OUT BY PAUL PURVIS
REM SELECT CASE CBWPARAM ' Holds the code of the key.
REM ' Specify what action should be taken for each key code.
REM CASE 13 ' ENTER pressed
REM ' Ensure that a cell is selected before editing.
REM ' Otherwise you will have a fatal error !
REM CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 TO Result&
REM CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, Result&,-1
REM CALL PrepareForEdit
REM EXIT FUNCTION
REM
REM END SELECT
' Specify what action should be taken for each key code.
CASE 88 ' x key pressed
CALL cbf_exxit()
EXIT FUNCTION
CASE 69 ' e key pressed
CALL clearcells()
EXIT FUNCTION
CASE 67 ' c key pressed
'copies only the grandtotal to the clipboard
CALL SetClipboardText(TRIM$(REMOVE$(STR$(gtotalsum), ANY ", ")))
EXIT FUNCTION
CASE 78 ' n key pressed
'copies the grandtotal to the clipboad with a cr and lf added
CALL SetClipboardText(TRIM$(REMOVE$(STR$(gtotalsum), ANY ", "))+$CRLF)
EXIT FUNCTION
CASE ELSE ' No action to be taken here for the other keys.
END SELECT
IF gAutoinsertnew =1& THEN
'msgbox str$(prescurspos)
INCR siy.npos
'IF PresCursPos+1 >= (PageRows - 1) THEN decr siY.nPos : CursCorr=-1
'incr siy.npos
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
CALL UpdateWindowAndScrollbar (siY.nPos)
CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 TO Result&
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, Result&,-1
CALL PrepareForEdit
EXIT FUNCTION
END IF
END SELECT
' Pass the message on to the original window procedure... the DDT engine!
FUNCTION = CallWindowProc(gOldSubClassList, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION
' --------------------------------------------------
SUB UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
' Updates the listbox data to be presented after scrolling.
LOCAL j&,Res&
STATIC yPrevPos AS LONG ' previous y-position (remember between calls)
CONTROL SEND hListForm&,%ListBox,%LB_GETCURSEL,0,0 TO PresCursPos
IF yPos<>yPrevPos THEN ' Moved
CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%FALSE,0 TO Res&
' Update vertical scroll bar
siY.fMask = %SIF_POS
CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
CONTROL SEND hListForm&,%RowHeaderList,%LB_RESETCONTENT,0,0
CONTROL SEND hListForm&,%ListBox,%LB_RESETCONTENT,0,0
FOR j&=yPos TO yPos + PageRows - 1
' Update row header list
LISTBOX ADD hListForm&,%RowHeaderList,STR$(j&)
' Update window data
LISTBOX ADD hListForm&,%ListBox,DataArray(j&)
NEXT
END IF
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL,PresCursPos+CursCorr,0
IF PrevKey = 0 THEN ' Deselect cursor at list position zero
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL,0,0
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL,-1,0
END IF
CursCorr = 0 ' Reset correction of selection position
' New "previous" position to be remembered for the next update call
yPrevPos=yPos
END SUB
' ------------------------------------------------
CALLBACK FUNCTION CBF_ListBox
DIM J AS LONG
IF CBCTLMSG=%LBN_DBLCLK THEN CALL PrepareForEdit
END FUNCTION
' ------------------------------------------------
SUB PrepareForEdit
LOCAL buffer AS ASCIIZ * 28 '256
LOCAL CVal&
LOCAL tempstring AS STRING 'added by paul purvis
LOCAL tempstring2 AS STRING 'added by paul purvis
LOCAL J AS LONG
' Return Current Selection in CVal&
CONTROL SEND hListForm&,%ListBox, %LB_GETCURSEL, 0,0 TO CVal&
' Get array index corresponding to selected cell
SelY = siY.nPos + CVal&
gOLDCELLvalue=TRIM$(dataarray(sely))
REM -----------------------------------------------------------------------------------------------------------------------------------
backtoeditcellform: 'added by paul purvis
dataarray(sely)=TRIM$(REMOVE$(dataarray(sely),","))
CALL EditCellForm(hListForm&) ' Edit cell - new text to data array
'beginning of block added by paul purvis
dataarray(sely)=TRIM$(REMOVE$(dataarray(sely),ANY ", "))
tempstring=dataarray(sely)
IF TALLY(tempstring,"-")>0 THEN
IF (LEFT$(tempstring,1)="-") THEN tempstring=RIGHT$(tempstring,(LEN(tempstring)-1))
IF (RIGHT$(tempstring,1)="-") THEN tempstring=LEFT$(tempstring,(LEN(tempstring)-1))
IF TALLY(tempstring,"-")>0 THEN GOTO backtoeditcellform
tempstring="-"+tempstring
END IF
dataarray(sely)=tempstring
IF TALLY(tempstring,".")>0 THEN
IF TALLY(tempstring,".") > 1 THEN GOTO backtoeditcellform
IF INSTR(tempstring,".") < (LEN(tempstring)-2) THEN GOTO backtoeditcellform
END IF
tempstring2=TRIM$(REMOVE$(tempstring, ANY "-0123456789."))
IF LEN(tempstring2)>0 THEN GOTO backtoeditcellform
IF (VAL(dataarray(sely)) > 1000000000000.00@@) OR (VAL(dataarray(sely)) < -1000000000000.00@@) THEN GOTO backtoeditcellform
IF LEN(dataarray(sely))=0 THEN
dataarray(sely)=""
ELSE
IF VAL(dataarray(sely))=0@@ THEN
dataarray(sely)="0.00"
ELSE
IF TALLY(dataarray(sely),".")=0 THEN dataarray(sely)=TRIM$(STR$(VAL(dataarray(sely))*.01@@))
END IF
END IF
IF LEN(dataarray(sely))>0 THEN tempstring=FORMAT$(VAL(dataarray(sely)),"#,.00")
dataarray(sely)=RIGHT$(" "+tempstring,22)
'ending of block added by paul purvis
buffer = DataArray(SelY) ' new text from data array to buffer
' Update ListBox with new text
CONTROL SEND hListForm&,%ListBox,%LB_DELETESTRING,CVal&,0
CONTROL SEND hListForm&,%ListBox,%LB_INSERTSTRING,CVal&,VARPTR(buffer)
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, CVal&,-1
gtotalsum=0.0@@
gtotalcount=0&
FOR j=1 TO Rows
IF LEN(TRIM$(dataarray(j&))) THEN INCR gtotalcount:gtotalsum=gtotalsum+VAL(REMOVE$(DataArray(j),","))
NEXT
CONTROL SET TEXT hListForm&, %Totalsum, FORMAT$(gtotalsum,"#,.00")
CONTROL SET TEXT hListForm&, %itemcount, FORMAT$(gtotalcount,"#,0")
gAutoinsertnew=0&
IF SELY<rows THEN
IF LEN(TRIM$(dataarray(sely))) THEN IF LEN(TRIM$(dataarray(sely+1)))=0 THEN gAutoinsertnew=1&:gpaulsyprevpos=cval&
END IF
END SUB
FUNCTION CBF_Exxit AS STRING
LOCAL res&
res&=MSGBOX ("Are you sure that you want"+$CRLF+"to exit the adding machine?",_
%MB_YESNO OR %MB_ICONERROR OR %MB_DEFBUTTON2 OR %MB_TASKMODAL ,"Exit adding machine?")
IF res&=%IDYES THEN
res&=MSGBOX ("Entries will be lost"+$CRLF+"Are double sure you want"+$CRLF+"to exit the adding machine?",_
%MB_YESNO OR %MB_ICONERROR OR %MB_DEFBUTTON2 OR %MB_TASKMODAL,"Exit adding machine?")
IF res&=%IDYES THEN DIALOG END hListForm&
END IF
END FUNCTION
FUNCTION clearcells AS STRING
LOCAL res&
res&=MSGBOX ("Clear all numbers in adding machine?",_
%MB_YESNO OR %MB_ICONWARNING OR %MB_DEFBUTTON2 OR %MB_TASKMODAL ,"Clear adding machine?")
IF res&=%IDYES THEN
res&=MSGBOX ("ALL ENTRIES WILL BE LOST!"+$CRLF+"Are double sure you want?",_
%MB_YESNO OR %MB_ICONWARNING OR %MB_DEFBUTTON2 OR %MB_TASKMODAL,"Clear adding machine?")
IF res&<>%IDYES THEN EXIT FUNCTION
gtotalsum=0.0@@
FOR gtotalcount=1 TO Rows
dataarray(gtotalcount)=""
NEXT
gtotalcount=0&
siY.nMin = 1
siY.nMax = Rows
siY.nPage = PageRows
siY.nPos = rows-pagerows+1
prescurspos= 0
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
CALL UpdateWindowAndScrollbar (siY.nPos)
CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 TO Result&
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, Result&,-1
siY.nMin = 1
siY.nMax = Rows
siY.nPage = PageRows
siY.nPos = 1
prescurspos= 0
curscorr=1
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
CALL UpdateWindowAndScrollbar (siY.nPos)
CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 TO Result&
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, 0,-1
CONTROL SET TEXT hListForm&, %Totalsum, FORMAT$(gtotalsum,"#,.00")
CONTROL SET TEXT hListForm&, %itemcount, FORMAT$(gtotalcount,"#,0")
END IF
END FUNCTION
FUNCTION beginclearcells AS STRING
gtotalsum=0.0@@
FOR gtotalcount=1 TO Rows
dataarray(gtotalcount)=""
NEXT
gtotalcount=0&
siY.nMin = 1
siY.nMax = Rows
siY.nPage = PageRows
siY.nPos = rows-pagerows+1
prescurspos= 0
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
CALL UpdateWindowAndScrollbar (siY.nPos)
CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 TO Result&
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, Result&,-1
siY.nMin = 1
siY.nMax = Rows
siY.nPage = PageRows
siY.nPos = 1
prescurspos= 0
curscorr=1
siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
CALL UpdateWindowAndScrollbar (siY.nPos)
CONTROL SEND hListForm&,%ListBox,%LB_GETCARETINDEX,0,0 'TO 0
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL, 0,-1
CONTROL SET TEXT hListForm&, %Totalsum, FORMAT$(gtotalsum,"#,.00")
CONTROL SET TEXT hListForm&, %itemcount, FORMAT$(gtotalcount,"#,0")
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_HeaderBox
' set focus to %ListBox
CONTROL SET FOCUS hListForm&, %ListBox
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_Exit
LOCAL res&
res&=MSGBOX ("Are you sure that you want"+$CRLF+"to exit the adding machine?",_
%MB_YESNO OR %MB_ICONERROR OR %MB_DEFBUTTON2 OR %MB_TASKMODAL,"Exit adding machine?")
IF res&=%IDYES THEN
res&=MSGBOX ("Entries will be lost"+$CRLF+"Are double sure you want"+$CRLF+"to exit the adding machine?",_
%MB_YESNO OR %MB_ICONERROR OR %MB_DEFBUTTON2 OR %MB_TASKMODAL ,"Exit adding machine?")
IF res&=%IDYES THEN DIALOG END hListForm&
END IF
END FUNCTION
CALLBACK FUNCTION CBF_Help
MSGBOX "F2, Insert, or Double-Click to add/edit."+$CRLF+_
"E to erase numbers adding machine"+$CRLF+_
"C to copy grandtotal to the clipboard"+$CRLF+_
"N to as above with a carriage return and line feed."+$CRLF+_
"X or alt-X to quit",_
%MB_TASKMODAL OR %MB_ICONINFORMATION ,"Adding machine help"
END FUNCTION
CALLBACK FUNCTION CBF_Dimmerbright
gDimmer=100&
SetWindowLong(CBHNDL, %GWL_EXSTYLE, GetWindowLong(CBHNDL, %GWL_EXSTYLE) OR %WS_EX_LAYERED)
SetLayeredWindowAttributes(CBHNDL, 0, (255 * gDimmer) / 100, %LWA_ALPHA)
END FUNCTION
CALLBACK FUNCTION CBF_Dimmerdim
gDimmer=50&
SetWindowLong(CBHNDL, %GWL_EXSTYLE, GetWindowLong(CBHNDL, %GWL_EXSTYLE) OR %WS_EX_LAYERED)
SetLayeredWindowAttributes(CBHNDL, 0, (255 * gDimmer) / 100, %LWA_ALPHA)
END FUNCTION
CALLBACK FUNCTION CBF_DimmerBrighter
IF Gdimmer<20 THEN gdimmer=gdimmer+2& ELSE gDimmer=gdimmer+5&
IF gDimmer> 100& THEN gDimmer=100&
SetWindowLong(CBHNDL, %GWL_EXSTYLE, GetWindowLong(CBHNDL, %GWL_EXSTYLE) OR %WS_EX_LAYERED)
SetLayeredWindowAttributes(CBHNDL, 0, (255 * gDimmer) / 100, %LWA_ALPHA)
END FUNCTION
CALLBACK FUNCTION CBF_Dimmer
IF gdimmer<21 THEN gdimmer=gdimmer-2& ELSE gDimmer=gdimmer-5&
IF gDimmer< 6& THEN gDimmer=6&
SetWindowLong(CBHNDL, %GWL_EXSTYLE, GetWindowLong(CBHNDL, %GWL_EXSTYLE) OR %WS_EX_LAYERED)
SetLayeredWindowAttributes(CBHNDL, 0, (255 * gDimmer) / 100, %LWA_ALPHA)
END FUNCTION
CALLBACK FUNCTION CBF_onTop
IF GOnTop THEN
gontop=0&
CONTROL SET TEXT CBHNDL, %OntopBUTTON, "top"
ELSE
gontop=1&
CONTROL SET TEXT CBHNDL, %OntopBUTTON, "TOP"
END IF
END FUNCTION
'
' ------------------------------------------------
' Code section for editing of cell text
' ------------------------------------------------
'
SUB EditCellForm(BYVAL hListForm&) ' make and display edit form
LOCAL Style&, ExStyle&
Style& = %WS_POPUP OR %DS_MODALFRAME ' OR %WS_CAPTION 'OR %DS_CENTER
ExStyle& = 0
DIALOG NEW hListForm&, "Edit item "+STR$(SelY), -1, 12, 164, 28, Style&, ExStyle& TO hEditForm&
CONTROL ADD TEXTBOX, hEditForm&, %EditText, DataArray(SelY), 6, 2, 90, 12, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP,%WS_EX_CLIENTEDGE
' The following two statements deselect the text and place caret at the end of the text.
CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1 ' select all text
CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,-1,-1 ' deselect text
CONTROL ADD BUTTON, hEditForm&, %EditOK, "&OK", 110, 1, 20, 12, _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditOK
CONTROL ADD BUTTON, hEditForm&, %EditCancel, "&Cancel", 132, 1, 30, 12, _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditCancel
CONTROL SEND hEditForm&,%EditText,%WM_SETFONT,hFONT,%TRUE
CONTROL ADD LABEL, hEditForm&, %Edittext1,gOLDCELLVALUE, 7,17,87,12, %SS_LEFT
CONTROL ADD LABEL, hEditForm&, %Edittext2,"Item "+TRIM$(STR$(SELY)), 96,17,68,12, %SS_RIGHT
CONTROL SEND hEditForm&,%EditText1,%WM_SETFONT,hFONT,%TRUE
CONTROL SEND hEditForm&,%EditText2,%WM_SETFONT,hFONT,%TRUE
DIALOG SHOW MODAL hEditForm&, CALL EditDialogProc
END SUB
' ------------------------------------------------
CALLBACK FUNCTION EditDialogProc
LOCAL hCtl&,j&,Result&
SELECT CASE CBMSG
CASE %WM_INITDIALOG
CONTROL HANDLE CBHNDL, %EditText TO hCtl&
gOldSubClassEdit& = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassEditKeys))
CASE %WM_DESTROY
' Important! Remove the subclassing
SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassEdit&
CASE ELSE
END SELECT
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION SubClassEditKeys
' Subclass callback function for processing key messages in edit control (textbox).
' Completed after valuable feedback by Semen Matusovski and Borje Hagsten.
LOCAL Result&
'
SELECT CASE CBMSG
'
' The %WM_GETDLGCODE message is sent to the dialog box procedure
' associated with a control. Normally, Windows handles all arrow-key
' and TAB-key input to the control.
' By responding to the %WM_GETDLGCODE message, an application can
' take control of a particular type of input and process the input itself.
CASE %WM_GETDLGCODE
' Specifies that we want all keys entered in the textbox to be
' available here.
FUNCTION = %DLGC_WANTALLKEYS: EXIT FUNCTION
CASE %WM_KEYDOWN ' Keys at time of pressing (not used here)
CASE %WM_KEYUP ' Keys at time of release (not used here)
CASE %WM_CHAR ' Any character key at time of pressing
SELECT CASE CBWPARAM ' Holds the code of the key.
' Specify what action should be taken for each key code.
CASE 13 ' ENTER pressed
CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelY)
CONTROL SEND hListForm&,%ListBox,%LB_SETCURSEL,-1,0 ' deselect cell
DIALOG END hEditForm&
EXIT FUNCTION
CASE 27 ' ESCAPE pressed
DIALOG END hEditForm&
EXIT FUNCTION
CASE ELSE ' No action to be taken here for the other keys.
END SELECT
END SELECT
' Pass the message on to the original window procedure... the DDT engine!
FUNCTION = CallWindowProc(gOldSubClassEdit&, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_EditOK
' update data array with edited text
CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelY)
DIALOG END hEditForm&
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_EditCancel
DIALOG END hEditForm&
END FUNCTION
FUNCTION SetClipboardText (BYVAL sText AS STRING) AS LONG
LOCAL hData AS LONG
LOCAL hGlob AS LONG
' ** Create a global memory object and copy the data into it
hData = GlobalAlloc(%GMEM_MOVEABLE, LEN(sText)+1)
hGlob = GlobalLock(hData)
POKE$ hGlob, sText + CHR$(0)
GlobalUnlock hData
' ** Open the clipboard
IF ISFALSE(OpenClipboard(%Null)) THEN
GlobalFree hData
? "Can't reach clipboard!!", %mb_taskmodal, "Warning"
EXIT FUNCTION
END IF
' ** Paste the data into the clipboard
EmptyClipboard
FUNCTION = SetClipboardData(%CF_TEXT, hData)
CloseClipboard
END FUNCTION