TYPE EgridCoord
X1 AS LONG 'Right or left edge of rectange
Y1 AS LONG 'Top or bottom of rectange
X2 AS LONG 'Right or left edge of rectange
Y2 AS LONG 'Top or bottom of rectange
X3 AS LONG 'Temporary store the X1 value
Y3 AS LONG 'Temporary store the X2 value
X4 AS LONG 'Temporary store the Y1 value
Y4 AS LONG 'Temporary store the Y2 value
SX AS LONG 'Column to scroll to after navigation
SY AS LONG 'Row to scroll to after navigation
END TYPE
TYPE MergeCoord
X1P AS LONG 'Position of left most cell in merged cell for X1
X2P AS LONG 'Position of left most cell in merged cell for X2
Y1P AS LONG 'Position of top most cell in merged cell for Y1
Y2P AS LONG 'Position of top most cell in merged cell for Y2
X1R AS LONG 'Position of right most cell in merged cell for X1
X2R AS LONG 'Position of right most cell in merged cell for X2
Y1R AS LONG 'Position of bottom most cell in merged cell for Y1
Y2R AS LONG 'Position of bottom most cell in merged cell for Y2
X1M AS LONG 'X1 is merged
X2M AS LONG 'X2 is merged
Y1M AS LONG 'Y1 is merged
Y2M AS LONG 'Y2 is merged
END TYPE
GLOBAL RC() AS RECT 'Used by EGridNav to store selected rectangles
GLOBAL egHndl AS LONG 'Handle of current open EGrid
GLOBAL gSel AS LONG 'Number of range selections in the current EGrid
GLOBAL gUndo() AS LONG 'Used by EGridNav to store the state of the grid
GLOBAL egResult AS LONG 'General return long
GLOBAL egUndo AS INTEGER 'Track which Egrid State we are on
GLOBAL egNumUndo AS INTEGER 'Total Undo states saved
GLOBAL egMaxUndo AS INTEGER 'Maximum undo states
GLOBAL EndKey AS BYTE 'Store the toggle state of the End Key
GLOBAL GridChanges AS INTEGER 'Tracks changes to indicate if grid needs to be saved
GLOBAL g AS EgridCoord 'Store the current Rect coordinates and share with all
GLOBAL Speed AS EgridCoord 'Store the coordinates for Speed Data Entry
GLOBAL EnterKey AS BYTE 'Toggle Speed Entry
GLOBAL gChecked AS LONG 'number of checked boxes, mainly for a statusbar
GLOBAL F2Key AS BYTE 'Toggle the F2Key for Cell Edits
GLOBAL EgridStat AS BYTE 'Reset certain items of the grid when EgridNav is called; 0=Reset All; 1=MaxRows and MaxCols; 3=??
GLOBAL EGCC AS EgridCoord 'Store Cut/Copy Area
GLOBAL TimerID AS LONG 'ID For Cut/Copy Timer
GLOBAL CellEdit AS BYTE 'Track if a cell is being edited
GLOBAL egFN AS STRING 'Store the current form name on which the grid resides
GLOBAL egID AS LONG 'Store the current ID of the Grid
GLOBAL CP AS CellProfile 'User Type holding Cell Profile info from EGrid32
GLOBAL EGN AS EgridNotify PTR 'Holds current settings of grid
GLOBAL egMaxCol AS LONG 'The last visible column
GLOBAL egMaxRow AS LONG 'The last visible row
GLOBAL egMinCol AS LONG 'The first visible column
GLOBAL egMinRow AS LONG 'The first visible row
GLOBAL egCols AS LONG 'The Last Column (visible or not)
GLOBAL egRows AS LONG 'The Last Row (visible or not)
GLOBAL egShift AS LONG 'Shift key status
GLOBAL egControl AS LONG 'Control Key Status
GLOBAL egMC AS MergeCoord 'Provide coordinates of TL and BR cells in merged cell for a multi-cell selection
DECLARE FUNCTION EGRIDNAV(Cval&, FN AS STRING) AS LONG
DECLARE FUNCTION egGetClipBoardText() AS STRING
DECLARE FUNCTION egCELLHASTEXT(BYVAL X AS LONG, BYVAL Y AS LONG) AS BYTE
DECLARE FUNCTION egGETCELLTEXT(BYVAL X AS LONG, BYVAL Y AS LONG) AS STRING
DECLARE FUNCTION egGETCHECK(BYVAL X AS LONG, BYVAL Y AS LONG, XType AS BYTE) AS BYTE
DECLARE FUNCTION EgridMaxCols() AS LONG
DECLARE FUNCTION EgridMaxRows() AS LONG
DECLARE FUNCTION egSMR(Msg AS LONG, wparm AS LONG, lparm AS LONG) AS LONG
DECLARE SUB egGetRect()
DECLARE SUB egShowRect(Scroll AS BYTE)
DECLARE SUB EgridViewPort(BYVAL gRC AS RECT, vCols AS INTEGER, vRows AS INTEGER)
DECLARE SUB EGRIDPASTE()
DECLARE SUB EGRIDCUTCOPY(Del AS BYTE)
DECLARE SUB EGridDelete()
DECLARE SUB SaveUndo(After AS BYTE)
DECLARE SUB EGridUndo()
DECLARE SUB EGridRedo()
DECLARE SUB EgridUndoErase()
DECLARE SUB EGRIDROWS(InsDel AS INTEGER, Y1 AS LONG, Y2 AS LONG, UseUndo AS BYTE)
DECLARE SUB EgridSetCheck()
DECLARE SUB EgridSpeedEntry()
DECLARE SUB CLEARCUTCOPYFRAME()
DECLARE SUB egMerged()
DECLARE SUB egFixMerge()
DECLARE SUB egSM(Msg AS LONG, wparm AS LONG, lparm AS LONG)
DECLARE SUB EgridMinMaxColRow()
DECLARE SUB EgridHeaderText(ColID AS LONG, RowID AS LONG, Caption AS STRING, FColor AS LONG, HAlign AS STRING, VAlign AS STRING, SizeinInches AS SINGLE)
'--------------------------------- Grid Navigation -------------------------
'Return True if all functions have been handled manually
'Return False if more processing is needed by EGrid32
FUNCTION EGridNav(Cval&, FN AS STRING) AS LONG
LOCAL Selection AS LONG 'Current rectangle
LOCAL X AS LONG
LOCAL Y AS LONG
LOCAL TCell AS BYTE 'Control navigation parm
LOCAL CCell AS BYTE 'Control navigation parm
LOCAL LCell AS BYTE 'Control navigation parm
LOCAL gSTOP AS INTEGER 'Control navigation parm
LOCAL NCode AS LONG 'Windows event notification for grid
LOCAL Pt AS POINTAPI 'Cursor X/Y
LOCAL CHText AS INTEGER 'Cell Has Text
LOCAL CMerged AS INTEGER 'Cell is Merged
'------------------------
STATIC Expanding AS LONG 'rectangle expanding
STATIC vCols AS INTEGER
STATIC vRows AS INTEGER
STATIC xFN AS STRING 'Store the last Form Name for comparison
STATIC xID AS LONG 'Store the last Egrid ID for comparison
EZ_GetNotify CVal&, egHndl, egID, NCode
EGN = CVal&
egFN = FN
'------------------ Reset some values if it's not the current grid
IF xFN <> egFN OR (xID <> egID AND xFN = egFN) THEN ' OR EgridStat = 0
xFN = egFN 'Save the last form name
xID = egID
EgridMinMaxColRow
g.X1 = egMinCol
g.Y1 = egMinRow
g.X2 = g.X1
g.Y2 = g.Y1
g.SX = 1 : g.SY = 1
egFixMerge
g.SX = g.X1 : g.SY = g.Y1
egShowRect(1)
EGRIDUNDOERASE
GridChanges = 0
egUndo = 0
egNumUndo = 0
egMaxUndo = 100 : DIM gUndo(egMaxUndo+1)
EGCC.X1 = -1
EnterKey = 0
EndKey = 0
END IF
EgridStat = 1
egControl = EZ_GetKeyState(%EZK_CTRL, 1) AND 1 'Get Control key status
egShift = EZ_GetKeyState(%EZK_SHIFT, 1) AND 1 'Get Shift key status
'()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()
SELECT CASE NCode
'---------- Get the number of visible columns and rows
CASE %EGN_ABOUTDRAWINGCELLS
CALL EgridViewPort(@EGN.CurrRC,vCols, vRows)
'---------- Just before a cell is opened for edit
CASE %EGN_STARTEDEDITION
CellEdit = 1
CALL CLEARCUTCOPYFRAME()
'---------- Just before a cell edit is complete, save undo
CASE %EGN_FINISHEDIT
CALL SaveUndo(0)
INCR GridChanges
'---------- Just after a cell edit is complete, save undo
CASE %EGN_EDITIONCLOSED
CellEdit = 0
F2Key = 0
CALL SaveUndo(1)
'---------- Highlight columns and rows when header is clicked
CASE %EGN_HEADERLEFTCLICK
IF @EGN.CELL.X = 0 THEN 'User selected a Row Header - with shift held, range can be changed
IF egShift THEN
g.X1 = 1 : g.X2 = egMaxCol : g.Y2 = @EGN.CELL.Y 'Multiple Rows
ELSE
g.X1 = 1 : g.Y1 = @EGN.CELL.Y : g.X2 = egMaxCol : g.Y2 = g.Y1 'Single Row
END IF
ELSEIF @EGN.CELL.Y = 0 THEN 'User selected a Column Header - with shift held, range can be changed
IF egShift THEN
g.Y1 = 1 : g.X2 = @EGN.Cell.X : g.Y2 = egMaxRow 'Multiple Columns
ELSE
g.X1 = @EGN.Cell.X : g.Y1 = 1 : g.X2 = g.X1 : g.Y2 = egMaxRow 'Single Column
END IF
END IF
CALL egShowRect(0)
FUNCTION = %TRUE
'---------- Range is starting to be expanded with little tab at bottom right of selection
CASE %EGN_STARTEXPANDING
Expanding = 1
'---------- Create a Pop-up menu when a header is right-clicked
CASE %EGN_HEADERRIGHTCLICK
IF @EGN.CELL.X = 0 THEN 'User selected a row header
CALL GETCURSORPOS(Pt)
EZ_DoPopupMenu egFN, EZ_SetMouseXY(Pt.X, Pt.Y) , 1550, "Insert Rows|Delete Rows|", "S"
END IF
FUNCTION = %TRUE
EXIT FUNCTION
'---------- 'Create a pop up menu here
CASE %EGN_CELLRIGHTCLICK
CALL GETCURSORPOS(Pt)
EZ_DoPopupMenu egFN, EZ_SetMouseXY(Pt.X, Pt.Y) , 1500, "Cut|Copy|Paste|Delete|", "S"
FUNCTION = %TRUE
EXIT FUNCTION
'---------- Update the number of checkboxes checked - mainly for statusbar
CASE %EGN_CHECKBOXSTATECHANGED
IF @EGN.WPARAM > 0 THEN
INCR gChecked
ELSE
DECR gChecked
END IF
'----------
CASE %EGN_LEFTDOUBLECLICK 'Open a cell for edit when double click
IF CellEdit = 1 AND @EGN.Key = %FALSE THEN EXIT FUNCTION
IF @EGN.Cell.X > 0 AND @EGN.Cell.Y > 0 THEN
g.X1 = @EGN.Cell.X : g.Y1 = @EGN.Cell.Y
g.X2 = g.X1 : g.Y2 = g.Y1
egFixMerge
egShowRect(0)
CALL CLEARCUTCOPYFRAME()
egSM %EG_OPENEDITION, g.X1, g.Y1
F2Key = 1
FUNCTION = %TRUE
EXIT FUNCTION
END IF
'----------- 'Clear selections if clicked without Control or SHIFT pressed
CASE %EGN_CELLLEFTCLICK 'but only if the range is not being expanded with little tab
IF egControl=0 AND egShift=0 AND Expanding=0 AND CellEdit = 0 THEN
gSel = 1 : REDIM RC(gSel) AS GLOBAL RECT
END IF
'Make the selection with Left Click and Shift Held. Store Rect in RC()
IF egShift AND CellEdit = 0 THEN
g.X2 = @EGN.Cell.X
g.Y2 = @EGN.Cell.Y
g.SX = g.X2 : g.SY = g.Y2
egFixMerge
g.SX = egMC.X2P : g.SY = egMC.Y2P
CALL egShowRect(1)
FUNCTION = %TRUE
END IF
'---------- Range expanded with little tab at bottom right of selection
CASE %EGN_FINISHEXPANDING
g.X1 = @EGN.Selec.SX1 : g.Y1 = @EGN.Selec.SY1
g.X2 = @EGN.Selec.SX2 : g.Y2 = @EGN.Selec.SY2
egShowRect(0)
Expanding = 0
'---------- Clear selections with cursor without Control and Shift pressed
CASE %EGN_KEYDOWN
IF egShift=0 AND egControl= 0 AND CellEdit = 0 AND EndKey=0 THEN
SELECT CASE @EGN.Key
CASE %VK_UP
egMerged
IF egmc.Y1P - 1 > 0 THEN g.Y1 = egmc.Y1P - 1
g.Y2 = g.Y1
g.X2 = g.X1
egFixMerge
g.SX = egMC.X1P : g.SY = egMC.Y1P
CASE %VK_DOWN
egMerged
IF egMC.Y1R+1 <= egMaxRow THEN g.Y1 = egMC.Y1R+1
g.Y2 = g.Y1
g.X2 = g.X1
egFixMerge
g.SX = egMC.X1P : g.SY = egMC.Y1R
CASE %VK_LEFT
egMerged
IF egmc.X1P - 1 > 0 THEN g.X1 = egmc.X1P - 1
g.X2 = g.X1
g.Y2 = g.Y1
egFixMerge
g.SX = egMC.X1P : g.SY = egMC.Y1R
CASE %VK_RIGHT
egMerged
IF egmc.X1R+1 <= egMaxCol THEN g.X1 = egmc.X1R+1
g.X2 = g.X1
g.Y2 = g.Y1
CALL egFixMerge
g.SX = egMC.X1R : g.SY = egMC.Y1R
CASE ELSE
EXIT IF
END SELECT
egShowRect(1)
FUNCTION = %TRUE
EXIT FUNCTION
END IF
'The following code allows one to use the control-cursor to get to the end of columns or rows.
'Either to the end of a set of non-empty cells or the end of a set of empty cells.
'With the Shift pressed also, one can increase the selection. The Endkey can be pressed
'before the cursor to achieve the same movement.
'-----------------------------------------------------------------------------------------
IF egControl OR EndKey THEN
SELECT CASE @EGN.Key
'===============================(Control Up)======================================
CASE %VK_UP 'Control-Up OR End Up
IF g.Y2 = 1 OR F2Key THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
g.X3 = g.X1 : g.X4 = g.X2
g.Y3 = g.Y1 : g.Y4 = g.Y2
IF egShift THEN
egMerged
ELSE
g.Y2 = g.Y1
egMerged
g.Y2 = egmc.Y1R
END IF
TCell = egCELLHASTEXT(egmc.X2P,egmc.Y2P) 'Set the status of beginning cell contents
LCell = TCell
gStop = -1 'indicate first iteration
DO
egMerged
IF egmc.Y2P - 1 > 0 THEN g.Y2 = egmc.Y2P - 1
egMerged
CCell = egCELLHASTEXT(egmc.X2P,egmc.Y2P)
IF TCell = 0 AND CCell = 1 THEN
gStop = 2
ELSEIF TCell = 1 AND CCell = 1 AND LCell = 0 THEN
gStop = 3
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = -1 THEN
'Keep Going
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = 0 THEN
INCR g.Y2
gStop = 5
ELSEIF egmc.Y2P = 1 THEN
gStop = 1
ELSE
gStop = 0
END IF
LCell = CCell
IF gStop > 0 THEN
EXIT LOOP
END IF
LOOP
egMerged
IF egShift = 0 THEN
g.Y1 = g.Y2
g.X1 = g.X2
ELSEIF egShift THEN
'I dunno
END IF
CALL egFixMerge
g.SX = egMC.X2R : g.SY = egMC.Y2P
CALL egShowRect(1)
EndKey = 0
FUNCTION = %TRUE
EXIT FUNCTION
'================================(Control Down)====================================
CASE %VK_Down 'Control-Down OR End Down
IF g.Y2 = egMaxRow OR F2Key THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
g.X3 = g.X1 : g.X4 = g.X2
g.Y3 = g.Y1 : g.Y4 = g.Y2
IF egShift THEN
egMerged
ELSE
g.Y2 = g.Y1
g.X2 = g.X1
egMerged
END IF
TCell = egCELLHASTEXT(egmc.X2P,egmc.Y2P)
LCell = TCell
gStop = -1 'indicate first iteration
DO
egMerged
IF egmc.Y2R + 1 <= egMaxRow THEN g.Y2 = egmc.Y2R + 1
egMerged
CCell = egCELLHASTEXT(egmc.X2P,egmc.Y2P)
IF TCell = 0 AND CCell = 1 THEN
gStop = 2
ELSEIF TCell = 1 AND CCell = 1 AND LCell = 0 THEN
gStop = 3
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = -1 THEN
'Keep Going
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = 0 THEN
DECR g.Y2
gStop = 5
ELSEIF egmc.Y2R => egMaxRow THEN
gStop = 1
ELSE
gStop = 0
END IF
LCell = CCell
IF gStop > 0 THEN
EXIT LOOP
END IF
LOOP
egMerged
IF egShift = 0 THEN
g.Y1 = g.Y2
g.X1 = g.X2
ELSEIF egShift THEN
'I dunno
END IF
egFixMerge
g.SX = egMC.X2R : g.SY = egMC.Y2R
CALL egShowRect(1)
EndKey = 0
FUNCTION = %TRUE
EXIT FUNCTION
'===========================(Control Left)==================================
CASE %VK_Left 'Control-Left OR End Left
IF g.X2 = 1 OR F2Key THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
g.X3 = g.X1 : g.X4 = g.X2
g.Y3 = g.Y1 : g.Y4 = g.Y2
IF egshift THEN
egMerged
ELSE
g.X2 = g.X1
g.Y2 = g.Y1
egMerged
END IF
TCell = egCELLHASTEXT(egmc.X2P,egMC.Y2P)
LCell = TCell
gStop = -1 'indicate first iteration
DO
egMerged
IF egmc.X2P - 1 > 0 THEN g.X2 = egmc.X2P - 1
egMerged
CCell = egCELLHASTEXT(egmc.X2P,egMC.Y2P)
IF TCell = 0 AND CCell = 1 THEN
gStop = 2
ELSEIF TCell = 1 AND CCell = 1 AND LCell = 0 THEN
gStop = 3
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = -1 THEN
'Keep Going
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = 0 THEN
INCR g.X2
gStop = 5
ELSEIF egmc.X2P = 1 THEN
gStop = 1
ELSE
gStop = 0
END IF
LCell = CCell
IF gStop > 0 THEN
EXIT LOOP
END IF
gStop = 0
LOOP
egMerged
IF egShift = 0 THEN
g.X1 = g.X2
ELSEIF egshift THEN
'i dunno
END IF
egFixMerge
g.SX = egMC.X2P : g.SY = egMC.Y2P
CALL egShowRect(1)
EndKey = 0
FUNCTION = %TRUE
EXIT FUNCTION
'=================================(Control Right)========================
CASE %VK_Right 'Control-Right OR End Right
IF g.X2 = egMaxCol OR F2Key THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
IF egshift THEN
egMerged
ELSE
g.X2 = g.X1
g.Y2 = g.Y1
egMerged
END IF
TCell = egCELLHASTEXT(egmc.X2P,g.Y2)
LCell = TCell
gStop = -1 'indicate first iteration
DO
egMerged
IF egmc.X2R + 1 <= egMaxCol THEN g.X2 = egmc.X2R +1
egMerged
CCell = egCELLHASTEXT(egmc.X2P,g.Y2)
IF TCell = 0 AND CCell = 1 THEN
gStop = 2
ELSEIF TCell = 1 AND CCell = 1 AND LCell = 0 THEN
gStop = 3
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = -1 THEN
'Keep Going
ELSEIF TCell = 1 AND CCell = 0 AND LCell = 1 AND gStop = 0 THEN
DECR g.X2
gStop = 5
ELSEIF egmc.X2R => egMaxCol THEN
gStop = 1
ELSE
gStop = 0
END IF
LCell = CCell
IF gStop > 0 THEN
EXIT LOOP
END IF
LOOP
egMerged
IF egShift=0 THEN
g.X1 = g.X2
ELSE
'I dunno
END IF
egFixMerge
g.SX = egMC.X2R : g.SY = egMC.Y2P
CALL egShowRect(1)
EndKey = 0
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
END IF 'End of Control-Cursor
'-------------------------------(Extra Control Key Navigation)---------------------------------
IF egControl THEN 'Still in the keydown area
SELECT CASE @EGN.Key
CASE %VK_Home 'Control-Home moves to Cell A1
g.X2 = egMinCol: g.Y2 = egMinRow
IF egShift = 0 THEN 'with shift off, selection is not extended
g.X1 = g.X2 : g.Y1 = g.Y2
END IF
egFixMerge
g.SX = g.X2 : g.SY = g.Y2
CALL egShowRect(1)
CASE %VK_End 'Control-End moves to bottom right corner
g.X2 = egMaxCol : g.Y2 = egMaxRow
IF egShift = 0 THEN 'With shift, selection is extended
g.X1 = egMaxCol: g.Y1 = egMaxRow
END IF
egFixMerge
g.SX = g.X2 : g.SY = g.Y2
CALL egShowRect(1)
CASE 45 'User hit Ctr-Ins (insert rows)
CALL EGRIDROWS(1,0,0,1)
FUNCTION = %TRUE
EXIT FUNCTION
CASE 46 'User hit Ctrl-Del (delete rows)
CALL EGRIDROWS(-1,0,0,1)
FUNCTION = %TRUE
EXIT FUNCTION
CASE 67 'User hit Ctrl-C (copy)
IF F2Key = 0 THEN CALL EGridCutCopy(0)
EXIT FUNCTION
CASE 86 'User hit Ctrl-V (paste)
IF F2Key = 0 THEN CALL EGRIDPASTE()
EXIT FUNCTION
CASE 88 'User hit Ctrl-X (Cut)
IF F2Key = 0 THEN CALL EGRIDCUTCOPY(1)
EXIT FUNCTION
CASE 89 'User hit CTRL-Y (Redo)
CALL EGridRedo()
EXIT FUNCTION
CASE 90 'User hit Ctrl-Z (Undo)
CALL EgridUndo()
EXIT FUNCTION
END SELECT
END IF 'end of Control key code
'+++++++++++++++++++++ End of the Control Key navigation
'-------------------------------(Key Down Area Without Control Key or Shift Key)----------------------------
'Still in the keydown area
'------------------------ User hit Down when editing a cell
SELECT CASE @EGN.key
CASE %VK_Down
IF CellEdit = 1 THEN
CellEdit = 0
egSM %EG_CLOSEEDITION, %TRUE, 0
IF g.Y1 < egMaxRow THEN
g.Y1 = g.Y1 + 1 : g.Y2 = g.Y1
egFixMerge
g.SX = egMC.X1P : g.SY = EGMC.Y1P
CALL egShowRect(1)
END IF
FUNCTION = %TRUE
END IF
'------------------------ 'User hit UP when editing a cell
CASE %VK_Up
IF CellEdit = 1 THEN
CellEdit = 0
egSM %EG_CLOSEEDITION, %TRUE, 0
IF g.Y1 > 1 then
g.Y1 = g.Y1 - 1 : g.Y2 = g.Y1
egFixMerge
g.SX = egMC.X1P : g.SY = EGMC.Y1P
CALL egShowRect(1)
END IF
FUNCTION = %TRUE
END IF
'------------------------ 'User hit RIGHT when editing a cell
CASE %VK_Right
IF CellEdit = 1 AND F2Key = 0 THEN 'If they are editing a cell after pressing F2 then ignore
CellEdit = 0
egSM %EG_CLOSEEDITION, %TRUE, 0
IF g.X1 < egMaxCol THEN
g.X1 = g.X1 + 1 : g.X2 = g.X1
egFixMerge
g.SX = egMC.X1P : g.SY = EGMC.Y1P
CALL egShowRect(1)
END IF
FUNCTION = %TRUE
END IF
'------------------------ 'User hit LEFT when editing a cell
CASE %VK_LEFT
IF CellEdit = 1 AND F2Key = 0 THEN 'If they are editing a cell after pressing F2 then ignore
CellEdit = 0
egSM %EG_CLOSEEDITION, %TRUE, 0
IF g.X1 > 1 THEN
g.X1 = g.X1 - 1 : g.X2 = g.X1
egFixMerge
g.SX = egMC.X1P : g.SY = EGMC.Y1P
CALL egShowRect(1)
END IF
FUNCTION = %TRUE
END IF
'------------------------ 'User hit TAB
CASE 9
IF F2Key = 1 THEN EXIT FUNCTION
IF CellEdit = 1 THEN 'If they are editing a cell after pressing F2 then ignore
CellEdit = 0
egSM %EG_CLOSEEDITION, %TRUE, 0
END IF
egMerged
IF egShift THEN
IF egmc.X1P-1 > 0 THEN
g.X1 = egmc.X1P-1
g.X2 = g.X1
END IF
ELSE
IF egMC.X1R+1 <= egMaxCol THEN
g.X1 = egMC.X1R + 1 : g.X2 = g.X1
END IF
END IF
egFixMerge
g.SX = egMC.X1P : g.SY = EGMC.Y1P
CALL egShowRect(1)
FUNCTION = %TRUE
EXIT FUNCTION
'--------------------------(Speed Entry)---------------------
'Use a menu or a button to toggle this on or off and Call EgridSpeedEntry.
'Highlighting a single column before calling EgridSpeedEntry will move the cursor down after enter.
'Highlighting multiple columns before calling EgridSpeedEntry will move the cursor across the columns,
' and then down to the next row.
'If the cell is empty, the cursor will move to the next row
CASE 13 'User pressed ENTER while editing a Cell and Speed Entry is on
IF EnterKey = 0 THEN EXIT FUNCTION
IF CellEdit = 1 THEN
egSM %EG_CLOSEEDITION, %TRUE, 0
CellEdit = 0
END IF
'If you want to ignore cell contents during speed entry, make CHText=1
CHText = egCELLHASTEXT(g.X1,g.Y1) 'Cell Has Text
egMerged 'Cell Merged Status
IF CHText > 0 THEN
IF egMC.X1R < Speed.X2 THEN
g.X1 = egMC.X1R+1 : g.X2 = g.X1
ELSEIF egMC.X1R => Speed.X2 THEN
g.X1 = Speed.X1 : g.X2 = g.X1
g.Y1 = MIN(egMC.Y1R+1, egMaxRow)
g.Y2 = g.Y1
END IF
ELSEIF CHText = 0 THEN
g.X1 = Speed.X1 : g.X2 = g.X1
g.Y1 = MIN(egMC.Y1R+1, egMaxRow)
g.Y2 = g.Y1
END IF
egFixMerge
g.SX = g.X1 : g.SY = g.Y1
CALL egShowRect(1)
FUNCTION = %TRUE
EXIT FUNCTION
'------------------------ User pressed escape
CASE 27
CALL CLEARCUTCOPYFRAME()
'------------------------ 'User pressed the spacebar in a checkbox cell
CASE 32
IF CellEdit = 0 AND (egSMR( %EG_GETCOLUMNFUNCTION, g.X1, 0) = %EG_CheckBox OR egSMR( %EG_GETCONTROLTYPE, g.X1, g.Y1) = %EG_CheckBox) THEN
CALL EGridSetCheck
END IF
'------------------------ 'Page Up - With shift held the selection range can be changed
CASE 33
IF egControl THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
g.Y2 = MAX(g.Y2 - vRows+1,egMinRow)
IF egShift = 0 THEN
g.Y1 = g.Y2
g.X1 = g.X2
END IF
egFixMerge
g.SY = g.Y2
egShowRect(1)
FUNCTION = %TRUE
EXIT FUNCTION
'------------------------ 'Page Down - With shift held the selection range can be changed
CASE 34
IF egControl THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
g.Y2 = MIN(g.Y2 + vRows-1,egMaxRow)
IF egShift = 0 THEN
g.Y1 = g.Y2
g.X1 = g.X2
END IF
egFixMerge
g.SY = g.Y2
egShowRect(1)
FUNCTION = %TRUE
EXIT FUNCTION
'------------------------ 'Delete contents from all the simulated selections.
CASE 46
IF ISFALSE(egControl) THEN
CALL EGridDelete
FUNCTION = %TRUE
EXIT FUNCTION
END IF
'------------------------ 'F2 - Switch between cell navigate and grid navigate
CASE 113
IF F2Key = 1 THEN
F2Key = 0 'User has switched to grid navigation
ELSE
F2Key = 1 'User has switched to cell navigation
END IF
FUNCTION = %TRUE
EXIT FUNCTION
'------------------------ 'Home - Move to beginning of Row
CASE 36
IF egControl=0 AND F2Key = 0 THEN
g.X2 = egMinCol
IF egShift = 0 THEN 'Shift is off, no range extension
g.X1 = g.X2
g.Y1 = g.Y2
END IF
egFixMerge
egShowRect(1)
END IF
END SELECT
'Still in the Key Down Area
'everything below should have the shift key pressed, the control not pressed and not editing a cell
IF egShift = 0 OR egControl OR F2Key THEN EXIT FUNCTION
SELECT CASE @EGN.Key 'Test if beyond boundaries
CASE %VK_UP
g.Y3 = g.Y1 : g.Y4 = g.Y2
egMerged
IF egmc.Y2P - 1 > 0 THEN g.Y2 = egmc.Y2P - 1
egFixMerge
g.SX = g.X2 : g.SY = g.Y2
egShowRect(1)
CASE %VK_DOWN
g.Y3 = g.Y1 : g.Y4 = g.Y2
egMerged
IF egmc.Y2R + 1 <= egMaxRow THEN g.Y2 = egmc.Y2R + 1
egFixMerge
g.SX = g.X2 : g.SY = g.Y2
egShowRect(1)
CASE %VK_LEFT
g.X3 = g.X1 : g.X4 = g.X2
egMerged
IF egmc.X2P - 1 > 0 THEN g.X2 = egmc.X2P - 1
IF g.X4 > g.X3 AND g.X2 < g.X1 THEN g.X1 = g.X4
egFixMerge
g.SX = g.X2 : g.SY = g.Y2
CALL egShowRect(1)
CASE %VK_RIGHT
g.X3 = g.X1 : g.X4 = g.X2
egMerged
IF egmc.X2R + 1 <= egMaxCol THEN g.X2 = egMC.X2R + 1
egFixMerge
g.SX = g.X2 : g.SY = g.Y2
egShowRect(1)
CASE ELSE
EXIT FUNCTION
END SELECT
FUNCTION = %TRUE
EXIT FUNCTION
'=============================(Key is Released)================================================================
CASE %EGN_KeyUp
'------------------- 'EndKey toggle
'It is best to display the Endkey status on the status bar
IF @EGN.Key = 35 AND egControl=0 THEN
IF EndKey = 1 THEN
EndKey = 0
ELSE
EndKey = 1
END IF
END IF
FUNCTION = %TRUE
EXIT FUNCTION
'------------------- 'Store current cell in RC() if Control and Shift not pressed
IF egControl = 0 AND egShift = 0 THEN
SELECT CASE @EGN.Key
CASE %VK_UP, %VK_DOWN, %VK_LEFT, %VK_RIGHT
gSel = 1 : REDIM RC(gSel) AS GLOBAL RECT
CALL egGetRect()
EXIT FUNCTION
END SELECT
END IF
'=============================(Mouse Button Release)=======================================
CASE %EGN_RELEASEMOUSEBUTTON
IF @EGN.key = %WM_RBUTTONUP THEN
END IF
IF @EGN.key = %WM_LBUTTONUP THEN
IF egControl THEN ' Add selections when Control is pressed using mouse
INCR gSel : REDIM PRESERVE RC(0 TO gSel) AS GLOBAL RECT
egSM %EG_INTERNALSELECT, 0, 0
egSM %EG_GETINTERNALSELECTION, VARPTR(RC(gSel)), 0
ELSEIF egShift THEN
'Do Nothing - Don't fall into the ELSE trap
ELSE ' Else, remove all selections.
gSel = 1 : REDIM RC(gSel) AS GLOBAL RECT ' add the current cell back into the array
CALL egGetRect()
Call egShowRect(0)
END IF
END IF
egSM %EG_REFRESHALL, 0, 0
CASE %EGN_ABOUTREFRESHING
STATIC C AS INTEGER
IF EGCC.X1 > 0 THEN
egSM %EG_INTERNALSELECTTL, EGCC.X1, EGCC.Y1
egSM %EG_INTERNALSELECTBR, EGCC.X2, EGCC.Y2
egSM %EG_SIMULATESELECTION, RGB(255,0,0), %EG_MOVINGFRAME OR %EG_DottedFrame OR %EG_NOOVERLAY OR %EG_FORCEFRAME
END IF
'----------------- Draw all selections stored.
CASE %EGN_ALLCELLSDRAWN
FOR Selection = 1 TO gSel
egSM %EG_INTERNALSELECTTL, RC(Selection).NLEFT, RC(Selection).NTOP
egSM %EG_INTERNALSELECTBR, RC(Selection).NRIGHT, RC(Selection).NBOTTOM
egSM %EG_SIMULATESELECTION, 0, 0
NEXT Selection
CASE ELSE
END SELECT
END FUNCTION
'---------------
'-------------------------(egMerged)----------------------------------------------
'Test if Cell is merged
'Store values in egMC UDT
'egMC.X1P = Position of left most cell in merged cells for X1
'egMC.X2P = Position of left most cell in merged cells for X2
'egMC.Y1P = Position of top most cell in merged cells for Y1
'egMC.Y2P = Position of top most cell in merged cells for Y2
'egMC.X1R = Position of right most cell in merged cells for X1 (range)
'egMC.X2R = Position of right most cell in merged cells for X2 (range)
'egMC.Y1R = Position of bottom most cell in merged cells for Y1 (range)
'egMC.Y2R = Position of bottom most cell in merged cells for Y2 (range)
' If corner is not merged (range=0), return the Position value
'egMC.X1M = merge status for X1
'egMC.X2M = merge status for X2
'egMC.Y1M = merge status for Y1
'egMC.Y2M = merge status for Y2
SUB egMERGED()
'Top left corner
egSM %EG_INTERNALSELECTCELL, g.X1, g.Y1
egSM %EG_GETCELLPROFILE, VARPTR(CP), SIZEOF(CP)
IF CP.XRange > 0 THEN
egMC.X1P = CP.XPos
egMC.X1R = CP.XPos + CP.XRange
ELSE
egMC.X1P = g.X1
egMC.X1R = g.X1
END IF
IF CP.YRange > 0 THEN
egMC.Y1P = CP.YPos
egMC.Y1R = CP.YPos + CP.YRange
ELSE
egMC.Y1P = g.Y1
egMC.Y1R = g.Y1
END IF
'bottom right corner
egSM %EG_INTERNALSELECTCELL, g.X2, g.Y2
egSM %EG_GETCELLPROFILE, VARPTR(CP), SIZEOF(CP)
IF CP.XRange > 0 THEN
egMC.X2P = CP.XPos
egMC.X2R = CP.XPos + CP.XRange
ELSE
egMC.X2P = g.X2
egMC.X2R = g.X2
END IF
IF CP.YRange > 0 THEN
egMC.Y2P = CP.YPos
egMC.Y2R = CP.YPos + CP.YRange
ELSE
egMC.Y2P = g.Y2
egMC.Y2R = g.Y2
END IF
'Bottom left corner
egSM %EG_INTERNALSELECTCELL, g.X1, g.Y2
egSM %EG_GETCELLPROFILE, VARPTR(CP), SIZEOF(CP)
IF CP.XRange > 0 THEN
egMC.X1P = CP.XPos
egMC.X1R = CP.XPos + CP.XRange
END IF
IF CP.YRange > 0 THEN
egMC.Y1P = CP.YPos
egMC.Y1R = CP.YPos + CP.YRange
END IF
'Top right corner
egSM %EG_INTERNALSELECTCELL, g.X2, g.Y1
egSM %EG_GETCELLPROFILE, VARPTR(CP), SIZEOF(CP)
IF CP.XRange > 0 THEN
egMC.X2P = CP.XPos
egMC.X2R = CP.XPos + CP.XRange
END IF
IF CP.YRange > 0 THEN
egMC.Y2P = CP.YPos
egMC.Y2R = CP.YPos + CP.YRange
END IF
'Merge Status -----------------
egMC.X1M = 0 : egMC.X2M = 0
egMC.Y1M = 0 : egMC.Y2M = 0
IF egMC.X1P <> egMC.X1R THEN egMC.X1M = 1
IF egMC.X2P <> egMC.X2R THEN egMC.X2M = 1
IF egMC.Y1P <> egMC.Y1R THEN egMC.Y1M = 1
IF egMC.Y2P <> egMC.Y2R THEN egMC.Y2M = 1
END SUB
'----------------------------------- egFixMerge -------------------
'Fix any partially selected merged cells
'I tried using Elias' EG_FIXSELECTION - it was buggy
SUB egFixMerge
CALL egMerged
IF g.X1 > g.X2 THEN
g.X1 = egmc.X1R
g.X2 = egmc.X2P
ELSEIF g.X1 <= g.X2 THEN
g.X1 = egmc.X1P
g.X2 = egmc.X2R
END IF
IF g.Y1 > g.Y2 THEN
g.Y1 = egmc.Y1R
g.Y2 = egmc.Y2P
ELSEIF g.Y1 <= g.Y2 THEN
g.Y1 = egmc.Y1P
g.Y2 = egmc.Y2R
END IF
END SUB
'------------------------------------------(Toggle Checkboxes)-------------------------
'called when a user presses the spacebar in a checkbox cell
'multiple checkboxes can be selected prior to calling
SUB EgridSetCheck()
LOCAL X AS LONG
LOCAL Y AS LONG
LOCAL X1 AS LONG
LOCAL Y1 AS LONG
LOCAL X2 AS LONG
LOCAL Y2 AS LONG
LOCAL Checked AS LONG
LOCAL XType AS LONG '99=no checkbox; 0=cell checkbox; 1=Column checkbox
X1 = MIN(g.X1,g.X2) : Y1 = MIN(g.Y1,g.Y2)
X2 = MAX(g.X2,g.X1) : Y2 = MAX(g.Y2,g.X1)
CALL SaveUndo(0)
FOR X = X1 TO X2
FOR Y = Y1 TO Y2
XType = 99
IF egSMR( %EG_GETHIDEROW, Y, 0) THEN
XType = 88
ELSEIF egSMR(%EG_GETCOLUMNFUNCTION, X, 0) = %EG_CheckBox THEN
Xtype=1
ELSEIF egSMR(%EG_GETCONTROLTYPE, X, Y) = %EG_CheckBox THEN
XType=0
END IF
IF Xtype < 10 THEN
egSM %EG_INTERNALSELECTCELL, X, Y
Checked = egSMR(%EG_GETCHECK, X, Y) 'Current Checked status
IF Checked > 0 THEN
Checked = 0
ELSE
Checked = 1
END IF
egSM %EG_SETCHECK, Checked, XType
IF Checked = 1 THEN INCR gChecked
IF Checked = 0 THEN DECR gChecked
END IF
NEXT Y
NEXT X
egSM %EG_REFRESHALL, 0, 0
CALL SaveUndo(1)
END SUB
'------------------(Get the Checked Status of a Checkbox and return the Type of Checkbox)----
'XType is 99=no checkbox; 0=cell checkbox; 1=Column checkbox
FUNCTION egGETCHECK(BYVAL X AS LONG, BYVAL Y AS LONG, XType AS BYTE) AS BYTE
XType = 99
IF egSMR(%EG_GETCOLUMNFUNCTION, X, 0) = %EG_CheckBox THEN
XType=1
ELSEIF egSMR(%EG_GETCONTROLTYPE, X, Y) = %EG_CheckBox THEN
XType=0
END IF
egGETCHECK = 0
IF XType <> 99 THEN
IF egSMR(%EG_GETCHECK, X, Y) THEN egGETCHECK = 1 'Current Checked status
END IF
END FUNCTION
'----------------------------(Get Rectangle)-----------------------------
'Get the visible selection, store it in RC() and set the coordinates in g.?? UDT
SUB egGetRect()
egSM %EG_INTERNALSELECT, 0, 0
egSM %EG_GETINTERNALSELECTION, VARPTR(RC(gSel)), 0
g.X1 = RC(gSel).nLeft : g.Y1 = RC(gSel).nTop
g.X2 = RC(gSel).nRight: g.Y2 = RC(gSel).nBottom
END SUB
'--------------------------------(Show Rectangle)--------------------------------
'This will save a single rectangle and make it visible
'Specify which X and Y cell you want to scroll to before
' calling this using: g.SX and g.SY
SUB egShowRect(Scroll AS BYTE)
LOCAL jj AS EgridCoord
jj.X1 = MIN(g.X1,g.X2)
jj.X2 = MAX(g.X1,g.X2)
jj.Y1 = MIN(g.Y1,G.Y2)
jj.Y2 = MAX(g.Y1,g.Y2)
egSM %EG_INTERNALSELECTTL, JJ.X1, JJ.Y1
egSM %EG_INTERNALSELECTBR, JJ.X2, JJ.Y2
egSM %EG_INTERNTOVISIBLE, 0, 0
gSel = 1 : REDIM RC(gSel) AS GLOBAL RECT
SETRECT RC(gSel), jj.X1, jj.Y1, jj.X2, jj.Y2
IF Scroll = 1 THEN
IF g.SX < 1 THEN g.SX = g.X2
IF g.SY < 1 THEN g.SY = g.Y2
egSM %EG_SCROLLXTOCELL, g.X1, 0
egSM %EG_SCROLLYTOCELL, 0, G.Y1
egSM %EG_SCROLLXTOCELL, g.X2, 0
egSM %EG_SCROLLYTOCELL, 0, G.Y2
egSM %EG_SCROLLXTOCELL, g.SX, 0
egSM %EG_SCROLLYTOCELL, 0, g.SY
END IF
egSM %EG_REFRESHALL, 0, 0
END SUB
'-------------
'-----------------------(Get Visible Rows and Columns)--------------------------
'Get the visible columns and rows from the current grid
'Helps with Page Up and Page Down
SUB EgridViewPort(BYVAL gRC AS RECT, vCols AS INTEGER, vRows AS INTEGER)
vCols = gRC.nRight - gRC.nLeft + 1 'Visible Columns returned
vRows = gRC.nBottom - gRC.nTop + 1 'Visible Rows returned
END SUB
'------------------------------(Delete Ranges)-----------------------------------
'Delete all the range selections
'Read Only cells will be ignored
SUB EGridDelete
LOCAL Sel AS LONG, X AS LONG, Y AS LONG
CALL SaveUndo(0)
FOR Sel = 1 TO gSel
FOR X = RC(Sel).Nleft TO RC(Sel).NRight
FOR Y = RC(Sel).NTop TO RC(Sel).NBottom
IF egSMR(%EG_GETREADONLY, X, Y) = 0 AND egSMR(%EG_GETCOLUMNREADONLY, X, 0) = 0 THEN
egSM %EG_InternalSelectCell, X,Y
egSM %EG_DELETECONTENTS, %EG_TEXT OR %EG_FORMULA, 0
INCR GridChanges
END IF
NEXT Y
NEXT X
NEXT Sel
egSM %EG_REFRESHALL, 0, 0
CALL SaveUndo(1)
END SUB
'-------------------------------------------(PASTE)---------------------------
'This is compatible with Excel - text only
'You may paste from: A single column to multiple columns
' A single row to multiple rows
' A single cell to multiple cells
' Multiple columns and rows to a single cell
' Dependant on the destination rectangle
SUB EgridPaste()
LOCAL ClipText AS STRING
LOCAL X1 AS LONG
LOCAL Y1 AS LONG
LOCAL X2 AS LONG
LOCAL Y2 AS LONG
LOCAL pX2 AS LONG
LOCAL pY2 AS LONG
LOCAL X AS LONG
LOCAL Y AS LONG
LOCAL PCols AS LONG
LOCAL PRows AS LONG
LOCAL sDel AS STRING
LOCAL Count AS LONG
LOCAL A AS STRING
LOCAL N AS LONG
LOCAL L AS LONG
LOCAL Z AS LONG
LOCAL SelCols AS LONG
LOCAL SelRows AS LONG
LOCAL PasteMode AS INTEGER
ClipText = egGetClipBoardText()
IF ClipText = "" THEN EXIT SUB
X1 = MIN(g.X1,g.X2) : Y1 = MIN(g.Y1,g.Y2)
X2 = MAX(g.X2,g.X1) : Y2 = MAX(g.Y2,g.Y1)
SelCols = X2 - X1 +1
SelRows = Y2 - Y1 +1
PRows = TALLY(ClipText,ANY $LF)
sDel = $TAB & $LF
Count = TALLY(ClipText, ANY sDel) 'Number of Cells
PCols = Count \ PRows 'number of columns
IF (X1 + PCols -1) > egMaxCol OR (Y1 + PRows -1) > egMaxRow THEN
egResult = EZ_MSGBOX(egFN, "Data cannot be pasted beyond the boundaries of the sheet{!}","Pasting beyond boundaries","")
EXIT SUB
END IF
'Determine how the data can be pasted
IF PCols > 1 AND PRows > 1 THEN 'Paste all cells starting at top left of selection
PasteMode = 1
pX2 = X1+PCols-1 : pY2 = Y1+PRows-1
ELSEIF PCols = 1 AND PRows = 1 THEN 'Paste a single cell to all the selected cells
PasteMode = 2
pX2 = g.X2 : pY2 = g.Y2
ELSEIF PCols = 1 AND PRows > 1 THEN 'Paste a single Column into multiple columns
PasteMode = 3
pX2 = g.X2 : pY2 = Y1+PRows-1
ELSEIF PCols > 1 AND PRows = 1 THEN 'Paste a Single Row into multiple rows
PasteMode = 4
pX2 = X1+PCols-1 : pY2 = g.Y2
END IF
'Don't paste into protected cells
FOR X = X1 TO pX2
FOR Y = Y1 TO pY2
IF egSMR(%EG_GETREADONLY, X, Y) <> 0 OR egSMR(%EG_GETCOLUMNREADONLY, X, 0) <> 0 THEN
egResult = EZ_MSGBOX(egFN, "At least one of the cells in the range is protected{!}","Pasting Into Protected Cells","")
EXIT SUB
END IF
NEXT Y
NEXT X
INCR GridChanges
CALL SaveUndo(0)
sDel = $TAB & CHR$(13) & CHR$(10)
X = X1 : Y = Y1
L = 1
SELECT CASE PasteMode
CASE 1 'Paste all cells starting at top left of selection
FOR Z = 1 TO Count
N = INSTR(L,ClipText,ANY sDel)
A = REMOVE$(MID$(ClipText,L,N-L),ANY sDel)
egSM %EG_INTERNALSELECTCELL, X, Y
egSM %EG_SETCELLTEXTWF, STRPTR(A), LEN(A)
IF MID$(ClipText,N,1) = $TAB THEN
INCR X
L = N + 1
ELSEIF MID$(ClipText,N,1) = CHR$(13) THEN
INCR Y
L = N + 2
X = X1
END IF
NEXT Z
CASE 2 'Paste a single cell to all the selected cells
N = INSTR(L,ClipText,ANY sDel)
A = REMOVE$(MID$(ClipText,L,N-L),ANY sDel)
FOR Y = Y1 TO Y2
FOR X = X1 TO X2
egSM %EG_INTERNALSELECTCELL, X, Y
egSM %EG_SETCELLTEXTWF, STRPTR(A), LEN(A)
NEXT X
NEXT Y
CASE 3 'Paste a single Column into multiple columns
FOR X = X1 TO X2
Y = Y1
L = 1
FOR Z = 1 TO Count
N = INSTR(L,ClipText,ANY sDel)
A = REMOVE$(MID$(ClipText,L,N-L),ANY sDel)
egSM %EG_INTERNALSELECTCELL, X, Y
egSM %EG_SETCELLTEXTWF, STRPTR(A), LEN(A)
IF MID$(ClipText,N,1) = $TAB THEN
'We shouldn't have tabs
ELSEIF MID$(ClipText,N,1) = CHR$(13) THEN
INCR Y
L = N + 2
END IF
NEXT Z
NEXT X
CASE 4 'Paste a Single Row into multiple rows
FOR Y = Y1 TO Y2
X = X1
L = 1
FOR Z = 1 TO Count
N = INSTR(L,ClipText,ANY sDel)
A = REMOVE$(MID$(ClipText,L,N-L),ANY sDel)
egSM %EG_INTERNALSELECTCELL, X, Y
egSM %EG_SETCELLTEXTWF, STRPTR(A), LEN(A)
IF MID$(ClipText,N,1) = $TAB THEN
INCR X
L = N + 1
ELSEIF MID$(ClipText,N,1) = CHR$(13) THEN
'We shouldn't have any linefeeds
END IF
NEXT Z
NEXT Y
CASE ELSE
END SELECT
'Highlight the area that was pasted
g.X1 = X1 : g.Y1 = Y1 : g.X2 = pX2 : g.Y2 = pY2
CALL egShowRect(0)
CALL SaveUndo(1)
END SUB
'--------------------------------------(Get Clipboard Text)-------------------------------
FUNCTION egGetClipBoardText() AS STRING
LOCAL A AS STRING, ClipResult AS LONG
'Changed the code to use the new clipboard commands in PB 9 instead of the API
CLIPBOARD GET TEXT TO A ,ClipResult
IF ClipResult <> 0 THEN
egGetClipBoardText = A
ELSE
egGetClipBoardText = ""
END IF
'----------------------- Use this code directly with API -----------
' LOCAL hMem AS DWORD
' LOCAL lpMem AS ASCIIZ PTR
' IF ISCLIPBOARDFORMATAVAILABLE(%CF_TEXT) THEN '%CF_Text is API constant for text data with LF$
' IF ISFALSE(OPENCLIPBOARD(%NULL)) THEN EXIT FUNCTION
' hMem = GETCLIPBOARDDATA(%CF_TEXT)
' lpMem = GLOBALLOCK(hMem)
' FUNCTION = @lpMem
' GLOBALUNLOCK hMem
' CLOSECLIPBOARD
' ELSE
' FUNCTION = ""
' END IF
END FUNCTION
'--------------------------------(Cut and Copy)----------------------------------
'If Del is TRUE then it will delete the cells after sending to the clipboard
SUB EGRIDCUTCOPY(Del AS BYTE)
LOCAL X AS LONG
LOCAL Y AS LONG
LOCAL CutTxt AS STRING
LOCAL X1 AS LONG
LOCAL Y1 AS LONG
LOCAL X2 AS LONG
LOCAL Y2 AS LONG
LOCAL NewRow AS BYTE
LOCAL CC AS INTEGER
LOCAL hTimer AS DWORD
IF gSel > 1 THEN
egResult = EZ_MSGBOX(egFN, "Please select only one range at a time for this command to work{!}","Multiple Ranges Not Allowed","")
EXIT SUB
END IF
X1 = MIN(g.X1,g.X2) : Y1 = MIN(g.Y1,g.Y2)
X2 = MAX(g.X2,g.X1) : Y2 = MAX(g.Y2,g.Y1)
FOR Y = Y1 TO Y2 'Put the text in a single string
NewRow = 1
CC = 0
FOR X = X1 TO X2
IF CC > 0 AND NewRow = 0 THEN 'Add tab before next cell
CutTxt = CutTxt & CHR$(9)
END IF
CutTxt = CutTxt & egGETCELLTEXT(X,Y)
NewRow = 0
INCR CC
NEXT Y
CutTxt = CutTxt & CHR$(13,10) 'Add linefeed before next row
NEXT X
EZ_SetClipboardFormat 0 'Set the clipboard for Text
EZ_SetClipboard CutTxt
IF EGCC.X1 > 0 THEN CALL ClearCutCopyFrame()
EGCC.X1 = g.X1 : EGCC.Y1 = g.Y1
EGCC.X2 = g.X2 : EGCC.Y2 = g.Y2
EZ_StartTimer egFN, TimerID, 0.2
IF Del = %TRUE THEN
'Don't cut protected cells
FOR X = X1 TO X2
FOR Y = Y1 TO Y2
IF egSMR(%EG_GETREADONLY, X, Y) <> 0 OR egSMR(%EG_GETCOLUMNREADONLY, X, 0) <> 0 THEN
egResult = EZ_MSGBOX(egFN, "At least one of the cells in the range is protected{!}","Deleting Protected Cells","")
EXIT SUB
END IF
NEXT Y
NEXT X
INCR GridChanges
CALL SaveUndo(0)
egSM %EG_INTERNALSELECT ,0, 0
egSM %EG_DELETECONTENTS, %EG_TEXT OR %EG_FORMULA, 0
CALL SaveUndo(1)
END IF
egSM %EG_REFRESHALL, 0, 0
END SUB
'-------------------------------(Save Undo)-------------------------------------
'Used by EGridNav to save the state of the grid. Call before and after changes
'It dynamically erases grid states that are no longer needed
'You will need to erase any leftover grid states by calling EgridUndoErase before closing app
SUB SaveUndo(After AS BYTE)
LOCAL j AS INTEGER
IF egUndo + 1 > egMaxUndo THEN
CALL GLOBALFREE(gUndo(1))
ARRAY DELETE gUndo(1), 0
END IF
IF After = 0 THEN
egUndo = MIN(egUndo+1,egMaxUndo)
IF gUndo(egUndo) THEN
CALL GLOBALFREE(gUndo(egUndo))
gUndo(egUndo) = 0
END IF
FOR j = egUndo+1 TO egNumUndo
IF gUndo(j) THEN CALL GLOBALFREE(gUndo(j))
gUndo(j) = 0
NEXT j
egNumUndo = egUndo
gUndo(egUndo) = Grid_GetDataStream(egHndl,%EG_COMPRESSED )
ELSE
IF egUndo + 1 > (egMaxUndo+1) THEN
CALL GLOBALFREE(gUndo(1))
ARRAY DELETE gUndo(1), 0
END IF
INCR egNumUndo
gUndo(egNumUndo) = Grid_GetDataStream(egHndl)
END IF
END SUB
'-----------------------------(UNDO)---------------------------------
SUB EGridUndo
LOCAL VL AS LONG, HL AS LONG, MLC AS LONG
IF egUndo > 0 THEN
IF gUndo(0) = 1 THEN DECR egUndo
gUndo(0) = -1
HL = egSMR(%EG_GETLOCKHORZSIZES, 0, 0)
VL = egSMR(%EG_GETLOCKVERTSIZES, 0, 0)
MLC = egSMR(%EG_GETMARGINLINESCOLOR, 0, 0)
Grid_SetDataStream(egHndl, gUndo(egUndo),%EG_APPLYPROPERTIES OR %EG_RESTORESELECTION OR %EG_RESTOREPOSITION)
egSM %EG_SETMODIFY, %TRUE, 0
'-----------------------------------------------------------------------------------------------
'For some reason I'm having problems with Egrid32 remembering the following settings on the grid
'The GetMarginLineColor doesn't work - Put in your own color until Elias fixes this
egSM %EG_SETLOCKHORZSIZES, HL, 0
egSM %EG_SETLOCKVERTSIZES, VL, 0
egSM %EG_SETMARGINLINESCOLOR, Cadet_Blue, 0
'-----------------------------------------------------------------------------------------------
DECR egUndo
gSel = 1 : REDIM RC(gSel) AS GLOBAL RECT
CALL egGetRect()
egShowRect(1)
END IF
END SUB
'----------------------------(REDO)----------------------------------
SUB EGridRedo
LOCAL HL AS LONG
LOCAL VL AS LONG
IF egNumUndo > egUndo THEN
IF gUndo(0) = -1 THEN INCR egUndo
gUndo(0) = 1
INCR egUndo
HL = egSMR(%EG_GETLOCKHORZSIZES, 0, 0)
VL = egSMR(%EG_GETLOCKVERTSIZES, 0, 0)
Grid_SetDataStream(egHndl, gUndo(egUndo),%EG_APPLYPROPERTIES OR %EG_RESTORESELECTION OR %EG_RESTOREPOSITION)
egSM %EG_SETMODIFY, %TRUE, 0
egSM %EG_SETLOCKHORZSIZES, HL, 0
egSM %EG_SETLOCKVERTSIZES, VL, 0
gSel = 1 : REDIM RC(gSel) AS GLOBAL RECT
CALL egGetRect()
egShowRect(0)
END IF
END SUB
'---------------------------(Erase All the Grid States after Closing the Grid)----------------
'-------------------- Call this before closing your application to free up all undo's --------
SUB EgridUndoErase
LOCAL X AS LONG
FOR X = 1 TO egNumUndo
IF gUndo(X) THEN CALL GLOBALFREE(gUndo(X))
gUndo(X) = 0
NEXT X
egUndo = 0
egNumUndo = 0
END SUB
'----------------------------------(Insert or Delete Rows)--------------------------------
SUB EGRIDROWS(InsDel AS INTEGER, Y1 AS LONG, Y2 AS LONG, UseUndo AS BYTE)
'Positive value inserts rows; negative value deletes rows
'IF Y1 and Y2 are <> 0 then use them instead of g.Y1 and g.Y2
LOCAL Y AS LONG
LOCAL X AS LONG
LOCAL RowCnt AS LONG
IF gSel > 1 THEN
MSGBOX "You must select a single range for this operation"
EXIT SUB
END IF
IF Y1 = 0 AND Y2 = 0 THEN
Y1 = g.Y1 : Y2 = g.Y2
END IF
RowCnt = Y2 - Y1 + 1
IF InsDel > 0 THEN 'Make sure no data will be lost
FOR Y = egMaxRow-RowCnt+1 TO egMaxRow
FOR X = 1 TO egMaxCol
IF egCELLHASTEXT(X,Y) THEN
egResult = EZ_MSGBOX(egFN, "Nonblank cells cannot be shifted off the boundaries of the sheet{!}","Insert Error","")
EXIT SUB
END IF
NEXT X
NEXT Y
END IF
INCR GridChanges
IF UseUndo > 0 THEN CALL SaveUndo(0)
egSM %EG_SETAMOUNT, RowCnt, 0
IF InsDel < 0 THEN
egSM %EG_DELETEROW, Y1, %FALSE
ELSEIF InsDel > 0 THEN
egSM %EG_INSERTROW, Y1, %FALSE
END IF
egSM %EG_SETAMOUNT, 1, 0
CALL egShowRect(0) 'Select the same rows
IF UseUndo > 0 THEN CALL SaveUndo(1)
END SUB
'-------------------------------------(Does the Cell have contents?)-------------------------
FUNCTION egCELLHASTEXT(BYVAL X AS LONG, BYVAL Y AS LONG) AS BYTE
LOCAL CellFlags&
CellFlags& = egSMR(%EG_GETCELLFLAGS,X,Y)
IF (CellFlags& AND %EG_HasText) = %EG_HasText THEN egCELLHASTEXT = 1
END FUNCTION
'------------------------------------------(Get Cell Text)---------------------------
'Send the Coordinates of the cell and get cell text in return
FUNCTION egGETCELLTEXT(BYVAL X AS LONG, BYVAL Y AS LONG) AS STRING
LOCAL ST AS StringType
egSM %EG_INTERNALSELECTCELL, X, Y
egSM %EG_GETCELLTEXT, 0, VARPTR(ST)
egGETCELLTEXT = PEEK$(ST.Sptr, ST.Length)
END FUNCTION
'--------------------------------(Toggle Speed Entry)----------------------------------------
'Call this to toggle speed entry on and off
SUB EGRIDSPEEDENTRY()
EnterKey = ABS(EnterKey -1)
IF EnterKey > 0 THEN Speed.X1 = MIN(g.X1,g.X2) : Speed.X2 = MAX(g.X2,g.X1)
END SUB
'Stop the cut/copy frame display
SUB CLEARCUTCOPYFRAME()
EZ_StopTimer egFN, TimerID
EGCC.X1 = -1
egSM %EG_REFRESHALL, 0, 0
END SUB
'------------------------- Get Row and Column Info --------------------
'Find the last non-hidden row and column
SUB EgridMinMaxColRow()
DIM X AS LONG, Y AS LONG
egMaxCol = egSMR(%EG_GETMAXCOLUMNS, 0, 0)
egCols = egMaxCol 'visible or not
'IF the last column is hidden then make max cols one less
DO
IF egSMR(%EG_GETHIDECOLUMN, egMaxCol, 0) THEN
egMaxCol = egMaxCol - 1
ELSE
EXIT LOOP
END IF
LOOP
egMinCol = 1
DO
IF egSMR(%EG_GETHIDECOLUMN, egMinCol, 0) THEN
egMinCol = egMinCol + 1
ELSE
EXIT LOOP
END IF
LOOP
egMaxRow = egSMR(%EG_GetMaxRows, 0, 0)
egRows = egMaxRow 'visible or not
'If the last row is hidden then make max rows one less
DO
IF egSMR(%EG_GETHIDEROW, egMaxRow, 0) THEN
egMaxRow = egMaxRow - 1
ELSE
EXIT LOOP
END IF
LOOP
egMinRow = 1
DO
IF egSMR(%EG_GETHIDEROW, egMinRow, 0) THEN
egMinRow = egMinRow + 1
ELSE
EXIT LOOP
END IF
LOOP
END SUB
'Return the last column not hidden
FUNCTION EgridMaxCols() AS LONG
LOCAL MaxCols AS LONG
MaxCols = egSMR(%EG_GETMAXCOLUMNS, 0, 0)
'IF the last column is hidden then make max rows one less
DO
IF egSMR(%EG_GETHIDECOLUMN, MaxCols, 0) THEN
MaxCols = MaxCols - 1
ELSE
EXIT LOOP
END IF
LOOP
EgridMaxCols = MaxCols
END FUNCTION
'Return the last row not hidden
FUNCTION EgridMaxRows() AS LONG
LOCAL MaxRows AS LONG
MaxRows = egSMR(%EG_GetMaxRows, 0, 0)
'If the last row is hidden then make max rows one less
DO
IF egSMR(%EG_GETHIDEROW, MaxRows, 0) THEN
MaxRows = MaxRows - 1
ELSE
EXIT LOOP
END IF
LOOP
EgridMaxRows = MaxRows
END FUNCTION
'Send a message to the grid and return the response
'I simply got tired of typing out the whole command with the form name and ID
FUNCTION egSMR(Msg AS LONG, wparm AS LONG, lparm AS LONG) AS LONG
egSMR = EZ_SendMessageR(egFN, egID, Msg, wparm, lparm)
END FUNCTION
'Send a message to the grid
SUB egSM(Msg AS LONG, wparm AS LONG, lparm AS LONG)
EZ_SendMessage(egFN, egID, Msg, wparm, lparm)
END SUB
'---------------------------------- Header Formatting -------------------------------
'Format Column or Row Headers
SUB EgridHeaderText(ColID AS LONG, RowID AS LONG, Caption AS STRING, FColor AS LONG, HAlign AS STRING, VAlign AS STRING, SizeinInches AS SINGLE)
LOCAL MyText AS STRING, ACom AS STRING, SizeinPixels AS LONG
MyText = Caption
HAlign = UCASE$(HAlign) 'Left, Right, Center
VAlign = UCASE$(VAlign) 'Top, Bottom, Center
egSM %EG_INTERNALSELECTTL, ColID, RowID
egSM %EG_SETCELLTEXT, STRPTR(MyText), LEN(MyText)
ACom = "CELL.HALIGN(" & STR$(ColID) & "," & STR$(RowID) & ")=" & HAlign
egSM %EG_SETSTRINGDATA, STRPTR(ACom), LEN(ACom)
ACom = "CELL.VALIGN(" & STR$(ColID) & "," & STR$(RowID) & ")=" & VAlign
egSM %EG_SETSTRINGDATA, STRPTR(ACom), LEN(ACom)
egSM %EG_SETCELLFONTCOLOR, FColor, 0
egSM %EG_SETCELLBOLDMODE, %TRUE, 0
egSM %EG_SETSPECIALSETTINGS, %TRUE, 0
IF SizeinInches > 0 THEN
SizeinPixels = Grid_XInches2Pixels(SizeinInches)
IF ColID > 0 THEN
egSM %EG_SETCOLUMNSIZE, ColID, SizeinPixels
ELSEIF RowID > 0 THEN
egSM %EG_SETROWSIZE, RowID, SizeinPixels
END IF
END IF
END SUB
UBBFriend: Email This Page to Someone!
Computer Workshop User Forums
posted 04-02-2009 03:03 PM
posted 04-02-2009 05:25 PM
posted 04-14-2009 04:03 PM
