17th April 2014
uGrid has been further developed and improved and is now at rev 0.97
Please see my posting of the above date for a link from which the latest version can be downloaded.
Cheers,
RichardL
Code: Select all
; ====================================
; An entry level Editable Grid written for an Amateur Radio
; project requiring a visible table editor, and then did a 'Topsy...'
;
; Name: MicroGrid
; Version: 0.93
; Author: RichardL
; Date: 20th January 2014
; OS: Windows
; PB ver 5.11
; Copyright: (c)Richard Leman 2013.
; License: Free to copy/use/plunder entirely at your own risk.
; ====================================
; Info - Where to get some nice Images for ImageCells http://cooltext.com/
; Rev 0.93 LARGER IMAGE CELLS
; Mod - uGridService() tidied up and much simplified
; Added - Grid and Title fonts may now be specified individually.
; Added - Option to specify the height of image cells. ALL cells on grid use this height.
; Added - Text and caret position adjusted to keep text centralised vertically
; Added - Demo shows all above working.
; Known bugs/deficiences/'in-the-works' :-
; - *** Better/More Callbacks.
; - ** Feedback - FLAT version... no border
; - ** Started uGridDeleteGadget()
; - * Centre/Right alignment conflicts with editor... may be removed.
; - * Move to PB 5.20 and tidy up.
EnableExplicit
;{ Procedure declarations
Declare uGridGetCellPtr(GadNum,Col.i,Row.i)
Declare uGridRefreshGrid(GadNum)
Declare uGridWriteCellText(GadNum,cx,cy,text.s)
Declare uGridCallback(uGridNum,uGMsg,uGW,uGL)
Declare uGridDrawCell(GadNum,*Q=0,Flag=0)
Declare FindField(String$,Search$,Sep$,CaseFlag=0)
;}
;{ Globals, constants, etc...
; Flags to control auto-sizing of CanvasGadget()
#uGrid_AutoSizeX = %00000001
#uGrid_AutoSizeY = %00000010
#uGrid_UseAuxH = %00000100
; Cell flags
; Use with uGridSetCellType()
#uGrid_CellDefault = %000000000000 ; 00 Alpha/Numeric Mixed case
#uGrid_CellNoEdit = %000000000010 ; 01 Cell data is no editable
#uGrid_CellUcase = %000000000100 ; 02 Characters are all UCASE
#uGrid_CellLCase = %000000001000 ; 03 Characters are all LCASE
#uGrid_CellNumOnly = %000000010000 ; 04 Numbers only 0-9
#uGrid_CellHexOnly = %000000100000 ; 05 Hex 0-9 A-F
#uGrid_CellFloat = %000001000000 ; 06 Float -nnn.nnn
#uGrid_CellList = %000010000000 ; 07 List Tom|Dick|Harry| etc
#uGrid_CellImageFlip = %000100000000 ; 08 Image, two state image button
; Used with uGridCellFlags()
#uGrid_CellAlignR = %000000000001 ; 00 Leave alone! Text Alignment. (Under threat from over-complication!)
#uGrid_CellAlignC = %000000000010 ; 01 Default is to left alignment.
#uGrid_CellToggle = %000000000100 ; 10 For cell type _CellImageFlip this bit defines image 0 / 1
; Callback flags
Enumeration 1
#uGridEvent_DeSelect ; User moved away, time to check his input?
#uGridEvent_SelecT ; A good time to preload a cell
#uGridEvent_GridLostFocus
#uGridEvent_RightKey ; User clicked on cell with right mouse button
#uGridEvent_TitleClick ; User clicked on titlebar
#uGridEvent_CellChar ; User types a key to go into cell contents
#uGridEvent_CellXY ; Cell under mouse
#uGridEvent_CellImageFlip ; User has changed state of two0state image cell
EndEnumeration
; Redraw options
#RD_HiLtC = %00001 ; Redraw the highlight box - Coloured
#RD_HiLtB = %00010 ; Redraw the highlight box - Backdrop
#RD_Text = %00100 ; Redraw the text
#RD_Caret = %01000 ; Redraw the Caret
#RD_Image = %10000 ; Redraw the Image
Global GridCount.i ; Number of grids
Global uGridCallbackFlag.i = 0
; Cell edit related variables
Global EdSwitch ; True if a cell is active for edits
Global EdWin ; Win# containing grid
Global EdGrid=-1 ; Grid# being edited
Global EdIndex ; Index to GRID in table
Global EdCellX ; Co-ords of cell
Global EdCellY
Global *EdCell = -1 ; Pointer to current cell's structure
Global EdKeepContent$ ; Original content... for ESC
Global EdCaretPos
Global EdCarX
Global EdCarY
Global EdCarH
Structure GRIDFEFAULTS
TitleBackColour.i
TitleTextColour.i
TextBackColour.i
TextColour.i
ListSelectColour.i
SelectColour.i
LineColour.i
GridFont.s
GridFontH.i
TitleFont.s
TitleFontH.i
ImageCellH.i
EditStart.i
EndStructure
Global uGridDefaults.GRIDFEFAULTS; Default values for user to setup before creating grid
; Default values that user can modified BEFORE
; creating a grid. Values are transferred to the new grid
; and defaults may then be changed for the next one.
With uGridDefaults
\TitleBackColour = RGB($E1,$F7,$FF)
\TitleTextColour = #Black
\TextBackColour = #White
\TextColour = #Blue
\SelectColour = #Blue
\ListSelectColour = #Blue
\LineColour = #Red
\GridFont = "Arial" ; Used for grid
\GridFontH = 8
\TitleFont = "Courier" ; Title
\TitleFontH = 12
\ImageCellH = 25
\EditStart = #PB_EventType_LeftDoubleClick ;#PB_EventType_LeftButtonDown
EndWith
Structure GRIDOPTIONS
GridWin.i ; The Window the grid is created in
GridPBNum.i ; PureBasic gadget number
GridColCount.i ; Number of columns
GridRowCount.i ; Number of rows
GridFlags.i ; Flags to control features of the grid
GridCellPointer.i ; Pointer to structure defining cell being edited
GridColTitle.s[32] ; Titles for columns. 32 seems big enough... could be set larger.
GridCellX.i[32] ; X position of print position in cell
GridColW.i[32] ; Cell width including L&R borders and one grid line (Total +5)
GridPixW.i ; Pixel width of grid including borders (NOT CanvasGadget() borders).
GridPixH.i ; Pixel height of grid.....
; Each GRID has (a) a backdrop image which includes the gridlines and titles
; and (b) an image with the current backdrop and the current grid data.
GridBackImage.i ; Image with Grid lines and Titles
GridDataImage.i ; Copy of BackImage with data drawn over it
; Default values copied into all cells when a new grid created
GridTitleBackColour.i
GridTitleTextColour.i
GridTextColour.i
GridTextBackColour.i
GridLineColour.i
GridSelectColour.i
GridListSelectColour.i
GridFont.s
GridFontH.i
GridFontNum.i
GridFontID.i
TitleFont.s
TitleFontH.i
TitleFontNum.i
TitleFontID.i
ImageCellH.i ; Alternative grid height, overrides using font height
GridEditStart.i ; Flag: SingleLeftClick / DoubleLeftClick
; Editing strings flags etc
GEP.s ; Scratchpad for CNTRL C / V / X
; Cell edit related variables
GridEditCell.i ; Pointer to structure defining the cell being edited
GridCaretPos.i ; Caret position (characters from left)
GridSortOrder.i
EndStructure
Global Dim uGrid.GRIDOPTIONS(1) ; Description of each GRID
Structure CellOptions
CellX.i ; Note: X,Y,W,H values relate to the PIXEL text position and size.
CellY.i ; within the edit selection box
CellW.i
CellH.i
CellTextDY.i ; Y pixs to centralise text in when cell H increased.
CellGX.i ; Cell's logical position within the grid
CellGY.i
CellType.i ; Text, Numeric, Hex etc...
CellFlags.i ; Bitwise flags: sort toggle, image toggle, etc...
CellContent.s
CellMaxChars.i
CellData.i ; User write/read data value
CellListString.s ; Optional cell string values
CellTextColour.i
CellBackColour.i
CellFontID.i
CellImage.i[2] ; Image# for toggle images. 0 & 1
CellHelp.s ; Help / comment string
EndStructure
Global uG.CellOptions ; Descriptions of each CELL
;}
Procedure uGridGetGridIndex(GadNum) ; Returns index into uGrid.GRIDOPIONS(n) (0 => GridCount-1) or -1 if not found
Protected n
For n = 0 To GridCount-1
If uGrid(n)\GridPBNum = GadNum
ProcedureReturn n
EndIf
Next
ProcedureReturn -1
EndProcedure
Procedure uGridSelectCell(GadNum,cx,cy) ; Set a cell to edit mode, show highlight etc...
Protected GI, *P, *CellDat.CellOptions
; Find index of uGrid in grid table (-1 if not found)
GI = uGridGetGridIndex(GadNum)
; uGrid NOT found
If GI = -1
MessageRequester("Programming error","Gadget# not found :"+Str(GadNum))
ProcedureReturn #False
EndIf
*P = uGridGetCellPtr(GadNum,cx,cy) ; Get pointer to cell
If *P
*CellDat.CellOptions = *P
If *CellDat\CellType & #uGrid_CellNoEdit ; Prevent focus going to a non-editable cell
ProcedureReturn #False
EndIf
; Save selected CELL co-ords etc...
EdWin = GetActiveWindow()
EdGrid = GadNum
*EdCell = *P ; Keep pointer to cell structure
EdCellX = cx ; Cell co-ords...
EdCellY = cy
EdCarX = GadgetX(GadNum)
EdCarY = GadgetY(GadNum)
EdCarH = uGrid(GI)\GridFontH
EdKeepContent$ = *CellDat\CellContent ; Keep a copy for Restore (=ESC)
EdCaretPos = Len(*CellDat\CellContent) ; Cursor position is end of current content
EdSwitch = #True ; Enable edits
SetActiveGadget(GadNum)
uGridDrawCell(GadNum,*CellDat,#RD_Text|#RD_HiLtC|#RD_Caret)
EndIf
EndProcedure
Procedure uGridDrawCell(GadNum,*Q=0,Flag=0) ; Draw Backdrop+Text / HighLightBox / Caret
; Gadnum : CanvesGadget.
; *Q : Pointer to cell's structure.
; Flags : Bitwise flags for what is to be drawn.
Static LastGadnum, *LastP=-1, *P, *CellDat.CellOptions
Protected T,m,q$,C
; *Q=0: Special case for de-selecting cell from previous call
If *Q = 0
If *LastP = -1 ; But not the very first time!
ProcedureReturn
EndIf
GadNum = LastGadnum ; The previous cell's gadget,
*P = *LastP ; and structure
Flag = #RD_HiLtB ;
Else
*P = *Q
EndIf
*CellDat.CellOptions = *P
; Callbacks... MUST be outside Start/StopDrawing() so callback can involve drawing.
If uGridCallbackFlag
If (Flag & #RD_HiLtB) : uGridCallback(GadNum,#uGridEvent_DeSelect,0,*P): EndIf
If (Flag & #RD_HiLtC) : uGridCallback(GadNum,#uGridEvent_SelecT,0,*P) : EndIf
If (Flag & #RD_Image) : uGridCallback(GadNum,#uGridEvent_CellImageFlip,*CellDat\CellFlags & #uGrid_CellToggle,*P) : EndIf
EndIf
With *CellDat
If StartDrawing(CanvasOutput(GadNum))
DrawingFont(\CellFontID)
q$ = \CellContent
If Flag & #RD_Image ;{- Redraw an Image cell
; Two images are available, selected by \CellFlag & #uGrid_CellToggle
If \CellFlags & #uGrid_CellToggle
DrawImage(ImageID(\CellImage[1]),\CellX-2,\CellY-2)
Else
DrawImage(ImageID(\CellImage[0]),\CellX-2,\CellY-2)
EndIf
;}
EndIf
If Flag & #RD_Text ;{- Clear cell and draw text
; Draw empty cell (Leave highlight in place)
If \CellType & #uGrid_CellList ; List cell
Box(\CellX , \CellY-1, \CellW - 7, \CellH+2, \CellBackColour)
EdSwitch = #False
Else
Box(\CellX,\CellY,\CellW,\CellH,\CellBackColour) ; Normal cell
EndIf
; Calculate text offset to suit cell alignment
T = \CellFlags
m = 0
If T & #uGrid_CellAlignC : m = (\CellW-TextWidth(\CellContent))/2 : EndIf
If T & #uGrid_CellAlignR : m = (\CellW-TextWidth(\CellContent)) : EndIf
; Draw text, limited to width of cell
DrawingMode(#PB_2DDrawing_Transparent)
While TextWidth(q$) > \CellW
q$ = Left(q$,Len(q$)-1)
Wend
DrawText(\CellX+m,\CellY+\CellTextDY,q$,\CellTextColour)
;}
EndIf
If (Flag & #RD_HiLtB) ;{- Remove selection box from a cell
If \CellType & #uGrid_CellImageFlip ; Image Flip cell...
If \CellFlags & #uGrid_CellToggle
DrawImage(ImageID(\CellImage[1]),\CellX-2,\CellY-2)
Else
DrawImage(ImageID(\CellImage[0]),\CellX-2,\CellY-2)
EndIf
Else ; Text cell...
C = \CellBackColour
; Remove selection box from cell
DrawingMode(#PB_2DDrawing_Outlined)
Box(\CellX-2, \CellY-2, \CellW+4, \CellH+4,C)
If \CellH > 15
Box(\CellX-1, \CellY-1, \CellW+2, \CellH+2,C)
EndIf
; Remove list cell indicator
If \CellType & #uGrid_CellList
DrawingMode(#PB_2DDrawing_Default)
Box(\CellX + \CellW - 7, \CellY-1, 8, \CellH+2, C)
EndIf
DestroyCaret_()
EndIf
;}
EndIf
If (Flag & #RD_HiLtC) ;{- Draw selection box on a cell
If (\CellType & #uGrid_CellNoEdit) =0 ; ... but not if a no-edit cell
; Select colour to be used and make Caret
If \CellType & #uGrid_CellList Or \CellType & #uGrid_CellImageFlip ; List cell colour
C = uGrid(EdIndex)\GridListSelectColour
Else
C = uGrid(EdIndex)\GridSelectColour ; Text cells
CreateCaret_(WindowID(EdWin),0,1,EdCarH) ; Create a cursor...
ShowCaret_(WindowID(EdWin))
EndIf
; Draw selection box on cell
DrawingMode(#PB_2DDrawing_Outlined)
Box(\CellX-2, \CellY-2, \CellW+4, \CellH+4,C)
If \CellH > 15
Box(\CellX-1, \CellY-1, \CellW+2, \CellH+2,C)
EndIf
; Draw indicator for list selector
If \CellType & #uGrid_CellList
DrawingMode(#PB_2DDrawing_Default)
Box(\CellX + \CellW - 7, \CellY-1, 8, \CellH+2, uGrid(EdIndex)\GridListSelectColour)
Circle(\CellX + \CellW - 4, \CellY+(\CellH/2),2,#Red)
EndIf
EndIf
;}
EndIf
If Flag & #RD_Caret ;{- Draw the Caret
T = TextWidth(Left(q$,EdCaretPos))+2
If T < \CellW
SetCaretPos_( EdCarX+\CellX+T,EdCarY+\CellY+2+\CellTextDY) ; Position the cursor
EndIf
;}
EndIf
StopDrawing()
EndIf
EndWith
; Keep Gadget and Cell ID for de-selecting cell.
LastGadnum = GadNum
*LastP = *P
EndProcedure
Procedure uGridService(GadNum) ;/ Cell Selection and edit
Protected ReDraw,px,py,cx,cy,lx,rx,*T,*CellDat.CellOptions
Protected CKey, CMod, Lp$,Rp$,Np$,k$,MPtr,KeyOK,T
Protected KeepEdCellX,KeepEdCellY,X,Y,Move, GridIndex
Static *OldT
ReDraw = 0
Move = #False
; Find index of uGrid in table of grids (-1 if not found)
GridIndex = uGridGetGridIndex(GadNum)
; Grid NOT found... this will always be a design error.
If GridIndex = -1
MessageRequester("Programming error","uGridService(): Gadget# not found :"+Str(GadNum))
ProcedureReturn #False
EndIf
; Some events need the mouses's CELL X and Y positions...
If EventType() & #PB_EventType_LeftDoubleClick | #PB_EventType_LeftButtonDown |#PB_EventType_RightButtonDown |#PB_EventType_MouseMove ;{
; Get mouse position within working area
px = GetGadgetAttribute(GadNum,#PB_Canvas_MouseX)
py = GetGadgetAttribute(GadNum,#PB_Canvas_MouseY)
; Calculate the CELL column number
lx = 0 : rx = 00
For cx = 0 To uGrid(GridIndex)\GridColCount-1
rx + uGrid(GridIndex)\GridColW[cx]
If px>lx And px<rx
Break
EndIf
lx = rx
Next
; Calculate the CELL row number
If py < (uGrid(GridIndex)\TitleFontH + 5) ; Title bar
cy = -1
Else
py - (uGrid(GridIndex)\TitleFontH + 5) ; Subtract titlebar height
If uGrid(GridIndex)\GridFlags & #uGrid_UseAuxH
cy = py / uGrid(GridIndex)\ImageCellH
Else
cy = py /(uGrid(GridIndex)\GridFontH + 5)
EndIf
EndIf
;}
EndIf
Select EventType()
Case #PB_EventType_LeftDoubleClick, #PB_EventType_LeftButtonDown ;{ Left mouse: Grid / Cell selection
;{ Detect user selecting a new GRID
If GadNum <> EdGrid ; Change?
; Tidy up the previous grid
If EdGrid <> -1
uGridRefreshGrid(EdGrid)
EndIf
; Check the entry mode is correct (single / double click)
If EventType() <> uGrid(GridIndex)\GridEditStart
ProcedureReturn #False
EndIf
; Set up for editing
EdWin = EventWindow()
EdGrid = GadNum
EdIndex = GridIndex
EdCellX = -1 ; Force cell location later...
EdSwitch = #True
EndIf
;}
;{ Detect user selecting a new CELL
; Title bar clicked?
If cy = -1
uGridCallback(GadNum,#uGridEvent_TitleClick,cx,0)
ProcedureReturn
EndIf
; Make pointer to new target cell structure...
*T = uGrid(EdIndex)\GridCellPointer + (cy * uGrid(EdIndex)\GridColCount * SizeOf(uG)) + (cx * SizeOf(uG))
*CellDat.CellOptions = *T
If *CellDat\CellType & #uGrid_CellNoEdit = 0 ; Check target cell is not barred from selection
uGridDrawCell(0,0,#RD_HiLtB) ; Remove the last selection (It may even be on a different grid.)
; Save new cell co-ords, structure pointer etc
*EdCell = *T
EdCellX = cx
EdCellY = cy
EdCarX = GadgetX(GadNum)
EdCarY = GadgetY(GadNum)
EdCarH = uGrid(EdIndex)\GridFontH
If *CellDat\CellType & #uGrid_CellImageFlip
; User clicked an 'Image cell'...
*CellDat\CellFlags ! #uGrid_CellToggle ; Flip the image select bit
EdSwitch = #False
DestroyCaret_()
ReDraw = #RD_Image | #RD_HiLtC ; Request redraw of Image with Selector box
While WindowEvent() : Wend
Else
; User clicked on a 'Text cell'...
EdKeepContent$ = *CellDat\CellContent ; Keep cell contents for ESC exit restore.
EdCaretPos = Len(*CellDat\CellContent)
EdSwitch = #True
ReDraw = #RD_Text | #RD_Caret | #RD_HiLtC ; Request redraw of Text, Caret and Selector box
EndIf
EndIf
;}
;}
Case #PB_EventType_RightButtonDown ;{ Right mouse
If uGridCallbackFlag
If cy = -1 : ProcedureReturn : EndIf ; Title bar...
; Calculate pointer to cell data
*T = uGrid(GridIndex)\GridCellPointer + (cy * uGrid(GridIndex)\GridColCount * SizeOf(uG)) + (cx * SizeOf(uG))
*CellDat.CellOptions = *T
; If an editable cell then Callback
If Not *CellDat\CellType & #uGrid_CellNoEdit
uGridCallback(GadNum,#uGridEvent_RightKey,0,*T)
EndIf
EndIf
;}
Case #PB_EventType_KeyDown ;{ Edit and cursor movement keys
; CR exits the edit
; ESC replaces the original string and exits
; Edits are effective keystroke by keystroke
CKey = GetGadgetAttribute(GadNum,#PB_Canvas_Key)
CMod = GetGadgetAttribute(GadNum,#PB_Canvas_Modifiers) ; 0,1,4
*CellDat.CellOptions = *EdCell
With uGrid(EdIndex)
Select CMod ; Modifiers (0,1,2,4, None,SHIFT,ALT,CNTRL)
Case 0,1 ;{ L/R Cursor keys, CR, ESC etc
If EdSwitch = #True
Lp$ = Left(*CellDat\CellContent,EdCaretPos)
Rp$ = Mid( *CellDat\CellContent,EdCaretPos + 1)
; Text EDIT control keys
Select CKey
Case 8 ;{ BS
Lp$ = Left(Lp$,Len(Lp$)-1)
If EdCaretPos
EdCaretPos - 1
EndIf
*CellDat\CellContent = Lp$ + Rp$
ReDraw | #RD_Text | #RD_Caret
;}
Case 46 ;{ DEL
Rp$=Mid(Rp$,2)
*CellDat\CellContent = Lp$ + Rp$
ReDraw | #RD_Text | #RD_Caret
;}
Case 35 ;{ END
EdCaretPos = Len(*CellDat\CellContent)
Lp$ = *CellDat\CellContent
Rp$= ""
ReDraw | #RD_Text | #RD_Caret
;}
Case 36 ;{ HOME
EdCaretPos = 0
Lp$ = ""
Rp$= *CellDat\CellContent
ReDraw | #RD_Text | #RD_Caret
;}
Case 37 ;{ LEFT Cursor
If EdCaretPos
EdCaretPos - 1
Lp$ = Left(*CellDat\CellContent,EdCaretPos)
Rp$ = Mid(*CellDat\CellContent,EdCaretPos + 1)
EndIf
ReDraw | #RD_Text | #RD_Caret
;}
Case 39 ;{ RIGHT Cursor
If EdCaretPos < Len(*CellDat\CellContent)
EdCaretPos + 1
Lp$ = Left(*CellDat\CellContent,EdCaretPos)
Rp$ = Mid(*CellDat\CellContent,EdCaretPos + 1)
EndIf
ReDraw | #RD_Text | #RD_Caret
;}
Case 13 ;{ CR
uGridDrawCell(0,0) ; Remove selection
ReDraw | #RD_Text
EdSwitch = #False
EdCellX = -1
;}
Case 27 ;{ ESC
*CellDat\CellContent = EdKeepContent$ ; Replace old contents
ReDraw | #RD_Text ; Request a text redraw
uGridDrawCell(0,0) ; Remove selection box
EdSwitch = #False ; Stop edits
EdCellX = -1 ; Ensure new grid posn..
;}
EndSelect
Else
If *CellDat\CellType & #uGrid_CellList ; List cell?...
Select CKey
Case 40 ;{ Up Cursor
k$ = UCase(*CellDat\CellContent) ; Current content of cell
T = FindField(*CellDat\CellListString,k$,"|")
If T>1
T-1
*CellDat\CellContent = StringField(*CellDat\CellListString,T,"|")
ReDraw = #RD_Text
EndIf
;}
Case 38 ;{ Down Cursor
k$ = UCase(*CellDat\CellContent) ; Current content of cell
If k$=""
T = 0
Else
T = FindField(*CellDat\CellListString,k$,"|")
EndIf
If T < CountString(*CellDat\CellListString,"|")
T+1
*CellDat\CellContent = StringField(*CellDat\CellListString,T,"|")
ReDraw = #RD_Text
EndIf
;}
EndSelect
EndIf
EndIf
;}
Case 4 ;{ CNTRL C/V/X and CNTRL Left/Right/Up/Down Cursor keys
MPtr = 0
KeepEdCellX = EdCellX ; Keep pointers in case we cannot go
KeepEdCellY = EdCellY ; to a cell.
Select CKey
;- Copy, Paste and Cut
Case 'C'
\GEP = *CellDat\CellContent
Case 'V'
*CellDat\CellContent = \GEP
EdCaretPos = Len(*CellDat\CellContent)
ReDraw | #RD_Text | #RD_Caret
Case 'X'
\GEP = *CellDat\CellContent
*CellDat\CellContent = ""
EdCaretPos = 0
ReDraw | #RD_Text | #RD_Caret
; Grid navigation with CNTRL + cursor keys
Case '%' ;- Cursor Left
X = EdCellX - 1 ; Current cell 'X' position
MPtr = - SizeOf(CellOptions) ; Cell data pointer step size
While X > - 1 ;
*CellDat.CellOptions = *EdCell + MPtr
If *CellDat\CellType & #uGrid_CellNoEdit = 0; If we CAN go there..
EdCellX = X ; Adjust X position
Move = #True ; Set flag to force move,
Break ; Done...
EndIf
X - 1 ; Move test position left one cell
MPtr - SizeOf(CellOptions) ; and data test pointer one cell prior
Wend
Case Asc("'") ;- Cursor Right
X = EdCellX + 1
MPtr = SizeOf(CellOptions)
While X < \GridColCount
*CellDat.CellOptions = *EdCell + MPtr
If *CellDat\CellType & #uGrid_CellNoEdit = 0
EdCellX = X
Move = #True
Break
EndIf
MPtr + SizeOf(CellOptions)
X + 1
Wend
Case '&' ;- Cursor Up
Y = EdCellY - 1
MPtr = -(SizeOf(CellOptions) * (\GridColCount))
While Y > -1
*CellDat.CellOptions = *EdCell + MPtr
If *CellDat\CellType & #uGrid_CellNoEdit = 0
EdCellY = Y
Move = #True
Break
EndIf
MPtr - (SizeOf(CellOptions) * (\GridColCount))
Y - 1
Wend
Case '(' ;- Cursor Down
Y = EdCellY + 1
MPtr = (SizeOf(CellOptions) * (\GridColCount))
While Y < \GridRowCount
*CellDat.CellOptions = *EdCell + MPtr
If *CellDat\CellType & #uGrid_CellNoEdit = 0
EdCellY = Y
Move = #True
Break
EndIf
MPtr + (SizeOf(CellOptions) * (\GridColCount))
Y + 1
Wend
EndSelect
; Move to new cell...
If Move ; If moving is OK...
uGridDrawCell(0,0) ; Clear prior selection
*EdCell + MPtr ; Set new cell structure pointer
*CellDat.CellOptions = *EdCell
; Save new cell co-ords, structure pointer etc...
EdCellX = *CellDat\CellGX ; cx
EdCellY = *CellDat\CellGY ; cy
EdCarH = uGrid(uGridGetGridIndex(GadNum))\GridFontH
EdCarX = GadgetX(GadNum)
EdCarY = GadgetY(GadNum)
If *CellDat\CellType & #uGrid_CellImageFlip
; User moved to an 'Image cell'...
EdSwitch = #False
ReDraw = #RD_HiLtC ; Request redraw of Image with Selector box
While WindowEvent() : Wend
Else
; User moved to a 'Text cell'...
EdKeepContent$ = *CellDat\CellContent ; Keep cell contents for ESC exit restore.
EdCaretPos = Len(*CellDat\CellContent)
EdSwitch = #True
ReDraw = #RD_Text | #RD_Caret | #RD_HiLtC ; Request redraw of Text, Caret and Selector box
EndIf
EndIf
;}
EndSelect
EndWith
;}
Case #PB_EventType_Input ;{ Text input keys
If EdSwitch = #True
CKey = GetGadgetAttribute(GadNum,#PB_Canvas_Input) ; Get user key input
Np$ = Chr(CKey) ; New text from pressed key
*CellDat.CellOptions = *EdCell
; Character filters...
KeyOK = #True
Select *CellDat\CellType & %000011111111
Case #uGrid_CellDefault ; No restrictions
Case #uGrid_CellNoEdit : KeyOK = #False
Case #uGrid_CellUcase : Np$ = UCase(Np$)
Case #uGrid_CellLCase : Np$ = LCase(Np$)
Case #uGrid_CellNumOnly
If CKey<'0' Or CKey>'9' : KeyOK = #False : EndIf ; Allow numbers only and
If EdCaretPos = 0 And Np$ = "-" : KeyOK = #True : EndIf ; allow '-' as first character
Case #uGrid_CellFloat
If CKey<'0' Or CKey>'9' : KeyOK = #False : EndIf ; Allow numbers only and
If EdCaretPos = 0 And Np$ = "-" : KeyOK = #True : EndIf ; allow '-' as first character
If CKey = '.' And FindString(*CellDat\CellContent,".",1)=0 : KeyOK = #True : EndIf ; and just one '.'
Case #uGrid_CellHexOnly
k$ = UCase(Chr(CKey))
If Not ((k$ >="0" And k$ <="9") Or (k$ >= "A" And k$ <= "F"))
KeyOK = #False
Else
Np$ = k$
EndIf
EndSelect
; Build/modify string for CELL
If KeyOK = #True
uGridCallback(GadNum,#uGridEvent_CellChar,CKey,*EdCell)
Lp$ = Left(*CellDat\CellContent,EdCaretPos) ; Text to left of caret.
Rp$ = Mid(*CellDat\CellContent,EdCaretPos + 1) ; Text to right of caret.
k$ = Lp$ + Np$ + Rp$ ; join them all back together
If Len(k$) <= *CellDat\CellMaxChars ; If the text will fit in the cell...
*CellDat\CellContent = k$ ; Save text,
EdCaretPos + 1 ; move caret one char right and
ReDraw | #RD_Text | #RD_Caret ; set flags to redraw the cell on the CanvasGadget().
Else
ReDraw = 0
EndIf
EndIf
EndIf
;}
Case #PB_EventType_LostFocus ;{ Grid Lost focus
If uGridCallbackFlag
uGridCallback(EdGrid,#uGridEvent_GridLostFocus,0,*EdCell)
EndIf
uGridDrawCell(0,0) ; Clear select box
EdSwitch = 0 ; No more edits
EdCellX = -1 ; Force re-discovery
;}
Case #PB_EventType_MouseMove ;{ Cursor movement. Reports to uGridCallback()
If EventGadget() = EdGrid
If cy > -1
; Safety check on max X and Y... 'cos gadget may be oversized
If cy < uGrid(EdIndex)\GridRowCount And cx < uGrid(EdIndex)\GridColCount And cx>-1
; Calculate the cell data address pointer
*T = uGrid(EdIndex)\GridCellPointer
*T + (cy * uGrid(EdIndex)\GridColCount * SizeOf(uG))
*T + (cx * SizeOf(uG))
; Decide when to report a new cell
If *T <> *OldT
*OldT = *T
uGridCallback(GadNum,#uGridEvent_CellXY,0,*T)
EndIf
EndIf
EndIf
EndIf
;}
EndSelect
;Redraw the cell contents
If ReDraw
uGridDrawCell(EdGrid,*EdCell,ReDraw)
EndIf
EndProcedure
Procedure uGridGetCellPtr(GadNum,Col.i,Row.i) ; Return the address of a Cell's structure for a uGridGadget/Col/Row
Protected *P, n
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
; Check grid and limits... development stage check
If n >-1
If Col<0 Or Col>uGrid(n)\GridColCount Or Row<0 Or Row > uGrid(n)\GridRowCount
MessageRequester("Error","Cell("+Str(Col)+") Or Row("+Str(Row)+") is out of bounds")
*P = 0
Else
*P = uGrid(n)\GridCellPointer
*P + (Row * uGrid(n)\GridColCount * SizeOf(uG))
*P + (Col * SizeOf(uG))
EndIf
Else
MessageRequester("Error","Gadget("+Str(GadNum)+") is out of bounds")
EndIf
ProcedureReturn *P
EndProcedure
Procedure uGridEnableCallback(Flag)
uGridCallbackFlag = Flag
EndProcedure
Procedure uGridGetFlipImageNum(GadNum,cx,cy,state) ; Return the Image# for CellImageFlip() defined by 'state' (0/1)
Protected *P, *CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
If *CellDat\CellType & #uGrid_CellImageFlip
ProcedureReturn *CellDat\CellImage[state & 1]
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure uGridSetFlipImageState(GadNum,cx,cy,state) ; Set the Image# for CellImageFlip() defined by 'state' (0/1)
Protected *P, *CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
If *CellDat\CellType & #uGrid_CellImageFlip
If state & 1
*CellDat\CellFlags | #uGrid_CellToggle
Else
*CellDat\CellFlags & ($FFFF ! #uGrid_CellToggle)
EndIf
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure uGridSetCellData(GadNum,cx,cy,D.i) ; Save an integer data value at the specified cell.
Protected *P, *CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
*CellDat\CellData = D
EndIf
EndProcedure
Procedure uGridGetCellData(GadNum,cx,cy) ; Return integer data value saved with uGridSetCellData()
Protected *P, *CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
ProcedureReturn *CellDat\CellData
EndIf
EndProcedure
Procedure uGridSetCellMaxChars(GadNum,cx,cy,cw,ch,CharNum) ; Set maximum number of characters allowed in a block of cells.
Protected *P, *CellDat.CellOptions
Protected n,X,Y,Y2,X2
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n> -1
; Option to set X/Y range to full width/height
If cy = 0 And ch=-1 : ch = uGrid(n)\GridRowCount : EndIf
If cx = 0 And cw=-1 : cw = uGrid(n)\GridColCount : EndIf
; Check and apply limits
Y2 = cy+ch-1 : If Y2 > uGrid(n)\GridRowCount-1 : Y2 = uGrid(n)\GridRowCount-1 : EndIf
X2 = cx+cw-1 : If X2 > uGrid(n)\GridColCount-1 : X2 = uGrid(n)\GridColCount-1 : EndIf
; Set cell flags
For Y = cy To Y2
For X = cx To X2
*P = uGridGetCellPtr(GadNum,X,Y)
If *P
*CellDat.CellOptions = *P
*CellDat\CellMaxChars = CharNum
EndIf
Next
Next
EndIf
EndProcedure
Procedure uGridSetCellList(GadNum,cx,cy,cw,ch,ListString.s) ; Set option strings for a block of list cells
Protected *P, *CellDat.CellOptions
Protected n,X,Y,Y2,X2
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n >-1
; Option to set X/Y range to full width/height
If cy = 0 And ch=-1 : ch = uGrid(n)\GridRowCount : EndIf
If cx = 0 And cw=-1 : cw = uGrid(n)\GridColCount : EndIf
; Check and apply limits
Y2 = cy+ch-1 : If Y2 > uGrid(n)\GridRowCount-1 : Y2 = uGrid(n)\GridRowCount-1 : EndIf
X2 = cx+cw-1 : If X2 > uGrid(n)\GridColCount-1 : X2 = uGrid(n)\GridColCount-1 : EndIf
; Set cell flags
For Y = cy To Y2
For X = cx To X2
*P = uGridGetCellPtr(GadNum,X,Y)
If *P
*CellDat.CellOptions = *P
*CellDat\CellType = #uGrid_CellList
*CellDat\CellListString = ListString
EndIf
Next
Next
EndIf
EndProcedure
Procedure uGridSetCellHelp(GadNum,cx,cy,cw,ch,HelpString.s) ; Set 'Help' string for a cell / block-of-cells
Protected *P, *CellDat.CellOptions
Protected n,X,Y,Y2,X2
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n >-1
; Option to set X/Y range to full width/height
If cy = 0 And ch=-1 : ch = uGrid(n)\GridRowCount : EndIf
If cx = 0 And cw=-1 : cw = uGrid(n)\GridColCount : EndIf
; Check and apply limits
Y2 = cy+ch-1 : If Y2 > uGrid(n)\GridRowCount-1 : Y2 = uGrid(n)\GridRowCount-1 : EndIf
X2 = cx+cw-1 : If X2 > uGrid(n)\GridColCount-1 : X2 = uGrid(n)\GridColCount-1 : EndIf
; Set cell flags
For Y = cy To Y2
For X = cx To X2
*P = uGridGetCellPtr(GadNum,X,Y)
If *P
*CellDat.CellOptions = *P
*CellDat\CellHelp = HelpString
EndIf
Next
Next
EndIf
EndProcedure
Procedure.s uGridGetCellHelp(GadNum,cx,cy) ; Get 'Help' string for a cell
Protected *P, *CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
ProcedureReturn *CellDat\CellHelp
EndIf
ProcedureReturn ""
EndProcedure
Procedure uGridRefreshGrid(GadNum) ; Re-draw the visible grid area
Protected n,*P,*CellDat.CellOptions,Y,X,T,m
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
; uGridGadget() NOT found
If n = -1
MessageRequester("Error","GridRefresh() Gadget# not found ")
ProcedureReturn #False
EndIf
If StartDrawing(ImageOutput(uGrid(n)\GridDataImage))
; Draw backdrop... grid lines etc
DrawImage(ImageID(uGrid(n)\GridBackImage),0,0)
; Draw text in CELLs...
DrawingMode(#PB_2DDrawing_Transparent)
*P = uGrid(n)\GridCellPointer
For Y = 0 To uGrid(n)\GridRowCount - 1
For X = 0 To uGrid(n)\GridColCount - 1
*CellDat.CellOptions = *P
With *CellDat
If \CellType & #uGrid_CellImageFlip ; Image cell...
; Two images are available, defined by \CellFlag & #uGrid_CellToggle
T = 0 : If \CellFlags & #uGrid_CellToggle : T = 1 : EndIf
DrawImage(ImageID(\CellImage[T]),\CellX-2,\CellY-2)
Else ; Text cell...
Box(\CellX-2,\CellY-2,\CellW+4,\CellH+4,\CellBackColour)
; Calculate text offset to suit cell alignment
DrawingFont(\CellFontID)
T = \CellFlags
m = 0
If T & #uGrid_CellAlignC : m = (\CellW-TextWidth(\CellContent))/2 : EndIf
If T & #uGrid_CellAlignR : m = (\CellW-TextWidth(\CellContent)) : EndIf
; Draw the text
DrawText(\CellX+m,\CellY+\CellTextDY,\CellContent,\CellTextColour)
EndIf
EndWith
*P + SizeOf(uG)
Next
Next
StopDrawing()
If StartDrawing(CanvasOutput(uGrid(n)\GridPBNum))
DrawImage(ImageID(uGrid(n)\GridDataImage),0,0)
StopDrawing()
EndIf
EndIf
EndProcedure
Procedure uGridClearCell(GadNum,cx,cy,cw,ch) ; Clear a cell \ range of cells
Protected *P, *CellDat.CellOptions
Protected n,X,Y,Y2,X2
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n >-1
; Option to set X/Y range to full width/height
If cy = 0 And ch=-1 : ch = uGrid(n)\GridRowCount : EndIf
If cx = 0 And cw=-1 : cw = uGrid(n)\GridColCount : EndIf
; Check and apply limits
Y2 = cy+ch-1 : If Y2 > uGrid(n)\GridRowCount-1 : Y2 = uGrid(n)\GridRowCount-1 : EndIf
X2 = cx+cw-1 : If X2 > uGrid(n)\GridColCount-1 : X2 = uGrid(n)\GridColCount-1 : EndIf
; Set cell flags
StartDrawing(CanvasOutput(GadNum))
For Y = cy To Y2
For X = cx To X2
*P = uGridGetCellPtr(GadNum,X,Y)
If *P
*CellDat.CellOptions = *P
With *CellDat
If \CellType & #uGrid_CellImageFlip = 0 ; If NOT an image cell...
\CellContent = "" ; Clear cell contents in structure
Box(\CellX,\CellY,\CellW,\CellH,\CellBackColour) ; Erase visible screen cell
If \CellGX = EdCellX And \CellGY = EdCellY And GadNum = EdGrid ; If cell is current selected cell...
EdCaretPos = 0 ; move caret to 'home'
SetCaretPos_( EdCarX+\CellX+2,EdCarY+\CellY+2)
EndIf
EndIf
EndWith
EndIf
Next
Next
StopDrawing()
EndIf
EndProcedure
Procedure uGridWriteCellText(GadNum,cx,cy,text.s) ; Write text to a specific CELL structure at co-ords cx,cy
Protected *P,*CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
*CellDat\CellContent = text
uGridDrawCell(GadNum,*P,#RD_Text)
EndIf
EndProcedure
Procedure.s uGridReadCellText(GadNum,cx,cy) ; Read text from a specific GRID at CELL co-ords cx,cy
Protected *P,*CellDat.CellOptions
*P = uGridGetCellPtr(GadNum,cx,cy)
If *P
*CellDat.CellOptions = *P
ProcedureReturn *CellDat\CellContent
EndIf
EndProcedure
Procedure uGridSetCellType(GadNum,cx,cy,cw,ch,Flag,FlagSwitch=#True) ; Set CELL type for a range X,Y,W,H
; Specify the range of cells in conventional X,Y,W,H format.
; Set cw and ch to 1 to set the FLAGS of a single cell at cx, cy
; To specify whole column(s) set cy as 0 and ch as -1
; To specify whole row(s) set cx as 0 and cw as -1
Protected X,Y,X2,Y2,*CellDat.CellOptions,*P,n,C,T
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n >-1
; Option to set X/Y range to full width/height
If cy = 0 And ch=-1 : ch = uGrid(n)\GridRowCount : EndIf
If cx = 0 And cw=-1 : cw = uGrid(n)\GridColCount : EndIf
; Check and apply limits
Y2 = cy+ch-1 : If Y2 > uGrid(n)\GridRowCount-1 : Y2 = uGrid(n)\GridRowCount-1 : EndIf
X2 = cx+cw-1 : If X2 > uGrid(n)\GridColCount-1 : X2 = uGrid(n)\GridColCount-1 : EndIf
; Adjust cell flags
For Y = cy To Y2
For X = cx To X2
*P = uGridGetCellPtr(GadNum,X,Y) ; Get pointer to cell structure
If *P
*CellDat.CellOptions = *P
With *CellDat
If FlagSwitch
\CellType | Flag
Else
\CellType = \CellType & (Flag ! $FFFF)
EndIf
; For image cells create a pair of default images
If \CellType & #uGrid_CellImageFlip
C = RGB(220,255,220)
For T = 0 To 1
If \CellImage[T] = 0
\CellImage[T] = CreateImage(#PB_Any,\CellW+4,\CellH+4) ;+4? Images FILL cell, including selection box area
If StartDrawing(ImageOutput(\CellImage[T]))
Box(0,0,\CellW+4,\CellH+4,C)
StopDrawing()
EndIf
EndIf
C = RGB(255,220,220)
Next
EndIf
EndWith
EndIf
Next
Next
EndIf
EndProcedure
Procedure uGridSetCellColour(GadNum,cx,cy,cw,ch,FCol=-1,BCol=-1) ; Set Front and Backcolour for a range of cells
; Specify the range of cells in conventional X,Y,W,H format.
; Set cw and ch to 1 to colour a single cell at cx, cy
; Specify the colours or use -1,-1 to use defaults.
; To specify whole column(s) set cy as 0 and ch as -1
; To specify whole row(s) set cx as 0 and cw as -1
Protected X,Y,X2,Y2,*P,*CellDat.CellOptions,n
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n >-1
; Option to use default colours
If FCol = -1 : FCol= uGrid(n)\GridTextColour : EndIf
If BCol = -1 : BCol= uGrid(n)\GridTextBackColour : EndIf
; Option to set X/Y range to full width/height
If cy = 0 And ch=-1 : ch = uGrid(n)\GridRowCount : EndIf
If cx = 0 And cw=-1 : cw = uGrid(n)\GridColCount : EndIf
; Check and apply limits
Y2 = cy+ch-1 : If Y2 > uGrid(n)\GridRowCount-1 : Y2 = uGrid(n)\GridRowCount-1 : EndIf
X2 = cx+cw-1 : If X2 > uGrid(n)\GridColCount-1 : X2 = uGrid(n)\GridColCount-1 : EndIf
; Adjust specified cells
For Y = cy To Y2
For X = cx To X2
*P = uGridGetCellPtr(GadNum,X,Y)
If *P
*CellDat.CellOptions = *P
If StartDrawing(ImageOutput(uGrid(n)\GridDataImage))
With *CellDat
\CellTextColour = FCol
\CellBackColour = BCol
StopDrawing()
EndWith
EndIf
EndIf
Next
Next
; Re-draw the grid
uGridRefreshGrid(GadNum)
EndIf
EndProcedure
Procedure uGridSwapRowContents(GadNum,Y1,Y2,SwapData=#False) ; Swap row contents and optionally the CellData values.
Protected m,n,*P1,*P2,*P3,Pitch,Q,ContOffset
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n >-1
Pitch = uGrid(n)\GridColCount * SizeOf(uG) ; Size of one line of data/pointers
ContOffset = OffsetOf(CellOptions\CellContent)
SwapData & %001
Repeat
*P1 = uGrid(n)\GridCellPointer + (Y1*Pitch) + ContOffset ; Pointer to first contents cell on line Y1...
*P2 = uGrid(n)\GridCellPointer + (Y2*Pitch) + ContOffset ; and Y2
*P3 = @Q ; an integer
For m = 0 To uGrid(n)\GridColCount -1
CopyMemory(*P1,*P3,SizeOf(Q))
CopyMemory(*P2,*P1,SizeOf(Q))
CopyMemory(*P3,*P2,SizeOf(Q))
*P1 + SizeOf(uG)
*P2 + SizeOf(uG)
Next
ContOffset = OffsetOf(CellOptions\CellData)
SwapData -1
Until SwapData = -1
EndIf
EndProcedure
Procedure uGridSort(GadNum,ColNum,SortOrder=#False) ; Sort the data, selected by column title click.
Protected n, GridH,X,Y,SType,NumCol,*CellDat.CellOptions
Protected First,m,StepDir,T,u,SwapVal,k$,Empty
; Find index of uGrid in grid table (-1 if not found)
n = uGridGetGridIndex(GadNum)
If n = -1 : ProcedureReturn : EndIf
; Determine the size of the grid
GridH = uGrid(n)\GridRowCount ; get the number of rows,
NumCol= uGrid(n)\GridColCount ; and columns.
SortOrder & 1
; Determine the column's variable type.
X = ColNum ; Column number (X? lazy typist!)
*CellDat.CellOptions = uGridGetCellPtr(GadNum,X,0) ; Get pointer for top cell in column (Assumes all of col is the same!)
SType = *CellDat\CellType & %000001111100 ; Get the cell type flags
; Set up sort parameters
If SortOrder
First = 0 : StepDir = 1 : u = 1
Else
First = GridH -1 : StepDir = -1 : u = -1
EndIf
; Perform the sort on the stored grid data... this does NOT update the display
SwapVal = #True
While SwapVal
SwapVal = #False
n = First
For m = 1 To GridH - 1
T = #False
Select SType
Case #uGrid_CellUcase : If uGridReadCellText(GadNum,X,n) > uGridReadCellText(GadNum,X,n+u) : T = #True : EndIf ; UCASE
Case #uGrid_CellLCase : If uGridReadCellText(GadNum,X,n) > uGridReadCellText(GadNum,X,n+u) : T = #True : EndIf ; LCASE
Case #uGrid_CellNumOnly : If Val(uGridReadCellText(GadNum,X,n)) > Val(uGridReadCellText(GadNum,X,n+u)) : T = #True : EndIf ; Integers
Case #uGrid_CellHexOnly : If Val("$"+uGridReadCellText(GadNum,X,n))> Val("$"+uGridReadCellText(GadNum,X,n+u)): T = #True : EndIf ; Hex
Case #uGrid_CellFloat : If ValF(uGridReadCellText(GadNum,X,n)) > ValF(uGridReadCellText(GadNum ,X,n+u)) : T = #True : EndIf ; Float
Default : If uGridReadCellText(GadNum,X,n) > uGridReadCellText(GadNum,X,n+u) : T = #True : EndIf ; Not specified
EndSelect
If T
uGridSwapRowContents(GadNum,n,n+u)
SwapVal = #True
EndIf
n + StepDir
Next
Wend
; Remove blank lines from top of display. This can be complicated by the
; presence of negative numeric values or partially occupied lines so
; after many false starts I cracked the peanut with a sledge hammer!
For Y = 0 To GridH-1 ; Scan the grid,
Empty = #True ; scan a line to see if ALL cols are empty,
For X = 0 To NumCol-1
If Trim(uGridReadCellText(GadNum,X,Y))
Empty = #False
EndIf
Next
If Empty ; find an occupied row further down,
For m = Y To GridH-1
For X = 0 To NumCol-1
If Trim(uGridReadCellText(GadNum,X,m)) ; Not empty so...
uGridSwapRowContents(GadNum,m,Y) ; swap row with the empty one
Break 2
EndIf
Next
Next
EndIf
Next
; Make the changes visible.
uGridRefreshGrid(GadNum)
EndProcedure
Procedure uGridGadget(GadNum.i,gX,Gy,width,height,ColTitles.s,RowCount,flags) ; Create a new MicroGrid
; Syntax
; GadNum MicroGrid gadget number or #PB_Any.
; X,Y Grid position
; Width,Height Size of grid
; Titles.s Number of columns defined by the number of title elements
; Column titles have '|' separators.
; The column widths are defined by the appended value [Width]
; RowCount Number of rows in Grid. ALL MUST BE VISIBLE.
Protected Result = 0, *P,*CellDat.CellOptions,T,cx,cy,px,py,Pl,Pr,n,k$,X,Y
Protected ColCount = CountString(ColTitles,"|")
; Create storage for 2nd and later grids
If GridCount > 1
Redim uGrid(GridCount)
EndIf
; Create memory block for CELL data
*P = AllocateMemory(SizeOf(uG) * ColCount * RowCount)
If *P = 0 : ProcedureReturn 0 : EndIf
; Save essential data of the new GRID
With uGrid(GridCount)
\GridWin = GetActiveWindow()
\GridCellPointer = *P
\GridColCount = ColCount
\GridRowCount = RowCount
\GridFlags = flags
; Set default grid, cell,cursor and font colours
\GridTitleBackColour= uGridDefaults\TitleBackColour
\GridTitleTextColour= uGridDefaults\TitleTextColour
\GridTextBackColour = uGridDefaults\TextBackColour
\GridTextColour = uGridDefaults\TextColour
\GridLineColour = uGridDefaults\LineColour
\GridSelectColour = uGridDefaults\SelectColour
\GridListSelectColour = uGridDefaults\ListSelectColour
; Click / DClick to start CELL edit
\GridEditStart = uGridDefaults\EditStart
; Font for Cells
\GridFont = uGridDefaults\GridFont
\GridFontH = uGridDefaults\GridFontH
\GridFontNum = LoadFont(#PB_Any,\GridFont,\GridFontH)
\GridFontID = FontID(\GridFontNum)
; Get true pixel height of for CELLS
T = CreateImage(#PB_Any,100,100)
If StartDrawing(ImageOutput(T))
DrawingFont(\GridFontID)
\GridFontH = TextHeight("Xy") ; Replace user's value with 'real'
StopDrawing()
EndIf
FreeImage(T)
\TitleFont = uGridDefaults\TitleFont
\TitleFontH = uGridDefaults\TitleFontH
\TitleFontNum = LoadFont(#PB_Any,\TitleFont,\TitleFontH)
\TitleFontID = FontID(\TitleFontNum)
; Get true pixel height for TITLE
T = CreateImage(#PB_Any,100,100)
If StartDrawing(ImageOutput(T))
DrawingFont(\TitleFontID)
\TitleFontH = TextHeight("Xy") ; Replace user's value with 'real'
StopDrawing()
EndIf
FreeImage(T)
\ImageCellH = uGridDefaults\ImageCellH
; Parse the column title definitions, save CELL X
; offsets and total GRID width.
cx = 3 ; Space for border(2)+ gridLine(1)
For n = 0 To ColCount - 1
Pl = 1
k$ = StringField(ColTitles,n+1,"|")
Pl = FindString(k$,"[",Pl)
Pr = FindString(k$,"]",Pl)
\GridColTitle[n] = Left(k$,Pl-1)
k$ = Mid(k$,Pl+1,Pr-Pl-1)
\GridCellX[n] = cx
\GridColW[n] = Val(k$) + 5 ; 5? Border(2)+GridLine(1)+Border(2)
cx + \GridColW[n]
Next
; Width of whole grid
\GridPixW = cx-2
; Each GRID has a block of CELL descriptors stacked in order
; GRID left to right and down the page.
; Create CELL descriptors table
cy = 3 + \TitleFontH + 5 ; Space for title
For Y = 0 To RowCount-1
For X = 0 To ColCount-1
*CellDat.CellOptions = *P
; Cell type
*CellDat\CellType = #uGrid_CellDefault
; Cell X,Y,W,H in pixels
*CellDat\CellX = \GridCellX[X]
*CellDat\CellY = cy
*CellDat\CellW = \GridColW[X]-5
If \GridFlags & #uGrid_UseAuxH
*CellDat\CellH = \ImageCellH ; Increased height cell
*CellDat\CellTextDY = (\ImageCellH - \GridFontH )/2
Else
*CellDat\CellH = \GridFontH ; Normal cell H
*CellDat\CellTextDY = 0
EndIf
; Cell logical X,Y
*CellDat\CellGX = X
*CellDat\CellGY = Y
; Cell colours
*CellDat\CellTextColour = \GridTextColour
*CellDat\CellBackColour = \GridTextBackColour
; Cell character info
*CellDat\CellFontID = \GridFontID
*CellDat\CellMaxChars = 256
*CellDat\CellHelp = "X="+Str(X)+" Y="+Str(Y) ; For testing
*P + SizeOf(uG)
Next X
cy + *CellDat\CellH + 5
Next Y
; Height of whole grid
\GridPixH = cy - 2
; Manual sizing option
If Not \GridFlags & #uGrid_AutoSizeX : \GridPixW = width : EndIf
If Not \GridFlags & #uGrid_AutoSizeY : \GridPixH = height : EndIf
; Create CanvasGadget()
T = #PB_Canvas_ClipMouse|#PB_Canvas_Keyboard|#PB_Canvas_DrawFocus|#PB_Canvas_Border
Result = CanvasGadget(GadNum, gX, Gy, \GridPixW+4,\GridPixH+4,T)
If GadNum = #PB_Any : GadNum = Result : EndIf
\GridPBNum = GadNum ; Save the gadget number
\GridSortOrder = 0
;{ Create Images for rendering backdrop and data
\GridBackImage = CreateImage(#PB_Any,\GridPixW+2,\GridPixH+2)
\GridDataImage = CreateImage(#PB_Any,\GridPixW+2,\GridPixH+2)
;}
;{ Draw Gridlines and column titles
If StartDrawing(ImageOutput(\GridBackImage))
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(\TitleFontID)
; Backdrop for grid
Box(0,0,\GridPixW,\GridPixH,\GridTextBackColour)
; Horizontal lines
LineXY(0,0,\GridPixW,0,\GridLineColour) ; Above title
cy = \TitleFontH + 5
LineXY(0,cy,\GridPixW,cy,\GridLineColour) ; Under title
*P = \GridCellPointer
For Y = 0 To RowCount - 1
*CellDat.CellOptions = *P
py = *CellDat\CellY + *CellDat\CellH +2
LineXY(0,py ,\GridPixW, py, \GridLineColour) ; Under each row
*P + (SizeOf(uG)* ColCount)
Next
; Vertical lines, title box and title
*P = \GridCellPointer
For X = 0 To ColCount-1
*CellDat.CellOptions = *P
px = \GridCellX[X] - 3 ; Grid line is 3 pix left of text area
LineXY(px,0 ,px,\GridPixH,\GridLineColour) ; DrawColumn edge
T = (\GridColW[X] - TextWidth(\GridColTitle[X]))/2 ; Title offset
Box(px+1,1,\GridColW[X],\TitleFontH+4,\GridTitleBackColour); Title backdrop
DrawText(px+T,3,\GridColTitle[X],\GridTitleTextColour) ; Draw title
*P + SizeOf(uG)
Next
px + \GridColW[ColCount-1]
LineXY(px,0 ,px,\GridPixH,\GridLineColour) ; DrawColumn edge
StopDrawing()
EndIf
;}
GridCount + 1
EndWith
uGridRefreshGrid(GadNum)
ProcedureReturn Result
EndProcedure
Procedure uGridDeleteGrid(GadNum) ; ***** Work in progress****
Protected Gr
Gr = uGridGetGridIndex(GadNum) ; Find index of uGrid in grid table (-1 if not found)
If Gr =-1 : ProcedureReturn 0 : EndIf
; Ensure associated canvas does not have focus
With uGrid(Gr)
FreeImage(\GridBackImage) ; Free bitmaps
FreeImage(\GridDataImage)
ClearStructure(@uGrid(Gr),GRIDOPTIONS); Free any strings associated with GRID
; For Y ; Free all strings associated with CELLs
; For X
;
; Next
; Next
FreeMemory(\GridCellPointer) ; Free grid data memory
FreeGadget(\GridPBNum) ; Destroy Canvas()
EndWith
; Move higher table references down
If GridCount > 1; Re-dim table one smaller
GridCount - 1 ; Decrease number of grids
Redim uGrid(GridCount)
EndIf
EndProcedure
Procedure FindField(String$,Search$,Sep$,CaseFlag=0); Return the field number for 'Search$' in the longer string 'String$'
; ASCII only.
; Default is to case independent search. Set CaseFlag 'True' to match cases.
Protected n
If FindString(Search$,Sep$)
MessageRequester("ERROR: FindField()","'Search$' cannot include 'Sep$'")
ProcedureReturn 0
EndIf
; Case independent match...
If CaseFlag = 0
String$ = UCase(String$)
Search$ = UCase(Search$)
EndIf
; Compare fields
For n = 1 To CountString(String$,Sep$) + 1
If StringField(String$,n,Sep$) = Search$
ProcedureReturn n
EndIf
Next
ProcedureReturn 0
EndProcedure
DisableExplicit
; Append test code here...
