Code: Select all
;--------------------------------------------------------------------------------------------
;--- Navigation
;--------------------------------------------------------------------------------------------
Procedure.i _MyGrid_NeededRows(*mg._MyGrid_Type, Row, xRows)
; return the nbr of data-rows needed (+/-) to add/remove to Row
; in order to move by xRows (+/-)
Protected i, actRows, ttlDataRows
If xRows <> 0
If xRows > 0
For i = Row + 1 To *mg\Rows
If actRows = xRows : Break : EndIf
If *mg\RowHeight(i) > 0
actRows = actRows + 1
EndIf
ttlDataRows + 1
Next
Else
For i = Row - 1 To 1 Step - 1
If actRows = xRows : Break : EndIf
If *mg\RowHeight(i) > 0
actRows = actRows - 1
EndIf
ttlDataRows = ttlDataRows - 1
Next
EndIf
EndIf
If actRows <> 0 : ProcedureReturn ttlDataRows : EndIf
EndProcedure
Procedure.i _MyGrid_NeededCols(*mg._MyGrid_Type, Col, xCols)
; return the nbr of data-cols needed (+/-) to add/remove to Col
; in order to move by xCols (+/-)
Protected i, actCols, ttlDataCols
If xCols <> 0
If xCols > 0
For i = Col + 1 To *mg\Cols
If actCols = xCols : Break : EndIf
If *mg\ColWidth(i) > 0
actCols = actCols + 1
EndIf
ttlDataCols + 1
Next
Else
For i = Col - 1 To 1 Step - 1
If actCols = xCols : Break : EndIf
If *mg\ColWidth(i) > 0
actCols = actCols - 1
EndIf
ttlDataCols = ttlDataCols - 1
Next
EndIf
EndIf
If actCols <> 0 : ProcedureReturn ttlDataCols : EndIf
EndProcedure
Procedure.i _MyGrid_ChangeCurTopRow(*mg._MyGrid_Type, xRows)
; scrolls up/dn wihtout changing current cell
*mg\TopRow = *mg\TopRow + _MyGrid_NeededRows(*mg._MyGrid_Type, *mg\TopRow, xRows)
EndProcedure
Procedure.i _MyGrid_ChangeCurTopCol(*mg._MyGrid_Type, xCols)
*mg\TopCol = *mg\TopCol + _MyGrid_NeededCols(*mg._MyGrid_Type, *mg\TopCol, xCols)
EndProcedure
;--------------------------------------------------------------------------------------------
;--- Editing
;--------------------------------------------------------------------------------------------
Procedure.i _MyGrid_ManageEdit(*mg._MyGrid_Type, ky.s, EnterPressed, SimpleClick)
Protected winNbr, cntNbr, gdt, evnt, evMn, evGt, evTy, exitEdit.i = #False
Protected ar,ac,r,c,x,y,w,h,oldGdtList, wrd.s
Protected SBColor, SFColor, SAlign, SFont
r = *mg\Row
c = *mg\Col
__MyGrid_SelectStyle(*mg, r, c)
If *mg\LstStyle()\Editable = #False : ProcedureReturn : EndIf
Select *mg\LstStyle()\CellType
Case #MyGrid_CellType_Checkbox
; an Enter or Space in a Checkbox are equivalent to Button-Click (check/uncheck)
If ky = " " Or EnterPressed Or SimpleClick
If Val( _MyGrid_GetCellText(*mg, r, c) ) = 0
_MyGrid_SetCellText(*mg, r, c, "1")
Else
_MyGrid_SetCellText(*mg, r, c, "0")
EndIf
_MyGrid_DrawCurrentCell(*mg)
EndIf
ProcedureReturn
Case #MyGrid_CellType_Button
ProcedureReturn
Case #MyGrid_CellType_Combo
ProcedureReturn
Case #MyGrid_CellType_Normal
If SimpleClick : ProcedureReturn : EndIf
; an Enter in text-cell will open current content for editing
If EnterPressed : ky = _MyGrid_GetCellText(*mg, r, c) : EndIf
Default
ProcedureReturn
EndSelect
ar = _MyGrid_Area_Of_Row(*mg, r)
ac = _MyGrid_Area_Of_Col(*mg, c)
If ar < 0 Or ac < 0 : ProcedureReturn : EndIf
winNbr = *mg\Window
cntNbr = *mg\Container
AddKeyboardShortcut(winNbr, #PB_Shortcut_Escape , 10001)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Tab , 10002)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Left , 10003)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Right , 10004)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Up , 10005)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Down , 10006)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Prior , 10007)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Next , 10008)
AddKeyboardShortcut(winNbr, #PB_Shortcut_Return , 10009)
SelectElement(*mg\LstAreaCol(), ac)
SelectElement(*mg\LstAreaRow(), ar)
x = *mg\LstAreaCol()\X + GadgetX(*mg\Gadget)
w = *mg\LstAreaCol()\Width
y = *mg\LstAreaRow()\Y + GadgetY(*mg\Gadget)
h = *mg\LstAreaRow()\Height
If IsGadget(cntNbr) ; if grid is inside a container - adjust X,Y
Select GadgetType(cntNbr)
Case #PB_GadgetType_Container, #PB_GadgetType_ScrollArea, #PB_GadgetType_Panel
OpenGadgetList(cntNbr)
gdt = StringGadget(#PB_Any, x+#MyGrid_Text_MarginX, y+#MyGrid_Text_MarginY, w-2*#MyGrid_Text_MarginX, h-2*#MyGrid_Text_MarginY, ky, #PB_String_BorderLess)
CloseGadgetList()
EndSelect
Else
; grid is on the window outside any container
oldGdtList = UseGadgetList(WindowID(winNbr))
gdt = StringGadget(#PB_Any, x+#MyGrid_Text_MarginX, y+#MyGrid_Text_MarginY, w-2*#MyGrid_Text_MarginX, h-2*#MyGrid_Text_MarginY, ky, #PB_String_BorderLess)
UseGadgetList(oldGdtList)
EndIf
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Delay(1)
keybd_event_(#VK_END, 0, 0, 0)
CompilerCase #PB_OS_Linux
CompilerCase #PB_OS_MacOS
CompilerDefault
CompilerEndSelect
SBColor = *mg\LstStyle()\BackColor
SFColor = *mg\LstStyle()\ForeColor
SAlign = *mg\LstStyle()\Aling
SFont = *mg\LstStyle()\Font
If IsFont(SFont) : SetGadgetFont(gdt, FontID(SFont)) : EndIf
SetGadgetColor(gdt, #PB_Gadget_FrontColor, SFColor)
SetGadgetColor(gdt, #PB_Gadget_BackColor , *mg\Color_FocusBack)
SetActiveGadget(gdt)
Repeat
evnt = WaitWindowEvent()
evMn = EventMenu()
evGt = EventGadget()
evTy = EventType()
Select evnt
Case #PB_Event_Menu
If evMn >= 10001 And evMn <= 10009
If evMn >= 10002
_MyGrid_SetCellText(*mg, r, c, GetGadgetText(gdt))
_MyGrid_DrawCurrentCell(*mg)
EndIf
exitEdit = #True
EndIf
EndSelect
If GetActiveGadget() <> gdt: exitEdit = #True : EndIf
Until exitEdit
FreeGadget(gdt)
;DisableGadget(*mg\Gadget, #False)
SetActiveGadget(*mg\Gadget)
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Escape )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Tab )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Left )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Right )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Up )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Down )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Prior )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Next )
RemoveKeyboardShortcut(winNbr, #PB_Shortcut_Return )
Select evMn
Case 10002, 10004 : MyGrid_MoveHorizontal(*mg\Gadget, 1)
Case 10003 : MyGrid_MoveHorizontal(*mg\Gadget, -1)
Case 10005 : MyGrid_MoveVertical(*mg\Gadget, -1)
Case 10006 : MyGrid_MoveVertical(*mg\Gadget, 1)
Case 10007 : MyGrid_MoveVertical(*mg\Gadget, -30)
Case 10008 : MyGrid_MoveVertical(*mg\Gadget, 30)
EndSelect
EndProcedure
Procedure.i _MyGrid_UserResize(*mg._MyGrid_Type, x, y)
; we resize only if:
; 1. we are in the area of col-header
; OR 2. we are in the area of row-header
; OR 3. we are in both col-header and row-header
;
; if resizing from left/up -> resizing that column/row
; if resizing from right/down -> un-hiding any next hidden column/row
; PreviousX, PreviousY store coord. when resizing started
;
Protected i, px, py, c, r, nwVal, oAreaRow, oAreaCol, X1, X2, Y1, Y2, crs
px = *mg\PreviousX
py = *mg\PreviousY
If px = x And py = y : ProcedureReturn : EndIf
oAreaRow = _MyGrid_AreaResizeRow(*mg, px, py)
oAreaCol = _MyGrid_AreaResizeCol(*mg, px, py)
FirstElement(*mg\LstAreaCol()) : X1 = *mg\LstAreaCol()\X : X2 = X1 + *mg\LstAreaCol()\Width
FirstElement(*mg\LstAreaRow()) : Y1 = *mg\LstAreaRow()\Y : Y2 = Y1 + *mg\LstAreaRow()\Height
crs = GetGadgetAttribute(*mg\Gadget, #PB_Canvas_Cursor)
; resizing column or unhiding a col that was shrinked to 0 by user
If oAreaCol >= 0 And Y1 <= y And y < Y2 And crs = #PB_Cursor_LeftRight
SelectElement(*mg\LstAreaCol() , oAreaCol)
If px <= *mg\LstAreaCol()\X + *mg\LstAreaCol()\Width
c = *mg\LstAreaCol()\Col
nwVal = *mg\ColWidth(c) + (x - px) : If nwVal < 0 : nwVal = 0 : EndIf
_MyGrid_ChangeColWidth(*mg, c, nwVal)
Else
c = *mg\LstAreaCol()\Col
For i = *mg\LstAreaCol()\Col+1 To *mg\Cols
If *mg\ColWidth(i) = 0
c = i: Break
EndIf
If *mg\ColWidth(i) > 0 : Break : EndIf
Next
nwVal = *mg\ColWidth(c) + (x - px) : If nwVal < 0 : nwVal = 0 : EndIf
_MyGrid_ChangeColWidth(*mg, c, nwVal)
EndIf
EndIf
; resizing column or unhiding a col that was shrinked to 0 by user
If oAreaRow >= 0 And X1 <= x And x < X2 And crs = #PB_Cursor_UpDown
SelectElement(*mg\LstAreaRow() , oAreaRow)
If py <= *mg\LstAreaRow()\Y + *mg\LstAreaRow()\Height
r = *mg\LstAreaRow()\Row
nwVal = *mg\RowHeight(r) + (y - py) : If nwVal < 0 : nwVal = 0 : EndIf
_MyGrid_ChangeRowHeight(*mg, r, nwVal)
Else
r = *mg\LstAreaRow()\Row
For i = *mg\LstAreaRow()\Row+1 To *mg\Rows
If *mg\RowHeight(i) = 0
r = i: Break
EndIf
If *mg\RowHeight(i) > 0 : Break : EndIf
Next
nwVal = *mg\RowHeight(r) + (y - py) : If nwVal < 0 : nwVal = 0 : EndIf
_MyGrid_ChangeRowHeight(*mg, r, nwVal)
EndIf
EndIf
EndProcedure
;--------------------------------------------------------------------------------------------
;--- Init and default
;--------------------------------------------------------------------------------------------
Procedure.i _MyGrid_Reset(*mg._MyGrid_Type, Rows, Cols)
; Reset everything so Grid can receive/show new data
Protected i
If rows <= 0 : rows =1 : EndIf
If cols <= 0 : cols =1 : EndIf
*mg\Rows = rows : Dim *mg\RowHeight(rows)
*mg\Cols = cols : Dim *mg\ColWidth(cols) : Dim *mg\ColID(cols)
*mg\LastIndex = (rows+1) * (cols+1) - 1
Dim *mg\gData(*mg\LastIndex)
If ArraySize(*mg\gData()) < 0
Debug "failed to allocate memory for the grid data !... "
ProcedureReturn
EndIf
; initializations
*mg\TopRow = 1
*mg\TopCol = 1
*mg\Row = 1
*mg\Col = 1
For i=1 To cols
_MyGrid_SetCellText(*mg, 0, i, "Col " + Str(i))
Next
For i=1 To rows
_MyGrid_SetCellText(*mg, i, 0, Str(i))
Next
_MyGrid_ChangeColWidth(*mg, #MyGrid_RC_Any, #MyGrid_Default_ColWidth)
_MyGrid_ChangeRowHeight(*mg, #MyGrid_RC_Any, #MyGrid_Default_RowHeight)
*mg\FrozenCol = 0
*mg\FrozenRow = 0
*mg\MoveStatus = #MyGrid_MouseMove_Nothing
*mg\PreviousX = 0
*mg\PreviousY = 0
*mg\NoRedraw = #False
*mg\Color_Line = $CCCCCC
*mg\Color_BlockBack = $FFFFBB
*mg\Color_Background = $808080
*mg\Color_FocusBack = $DBF0E0
*mg\Color_FocusBorder = $009AB6
*mg\WrapText = #True
; adding the 4 default styles : data-cell/frozen-cells/col-header/row-header
ClearList( *mg\LstStyle() )
ClearMap( *mg\DicStyle() )
AddElement(*mg\LstStyle()) ; data area
_MyGrid_DefineCurrentStyle(*mg, #MyGrid_Align_Center, $FFFFFF, $000000, Font_A8, 0, 1)
AddElement(*mg\LstStyle()) ; frozen-data area
_MyGrid_DefineCurrentStyle(*mg, #MyGrid_Align_Center, $D7EBFA, $000000, Font_A8, 0, 1)
AddElement(*mg\LstStyle()) ; col-headers
_MyGrid_DefineCurrentStyle(*mg, #MyGrid_Align_Center, $EB9E85, $FFFFFF, Font_A8, 0, 0)
AddElement(*mg\LstStyle()) ; row-headers
_MyGrid_DefineCurrentStyle(*mg, #MyGrid_Align_Center, $EB9E85, $FFFFFF, Font_A8, 0, 0)
; set min/max/page of scrolls
_MyGrid_AdjustScrolls(*mg)
EndProcedure
;--------------------------------------------------------------------------------------------
;--- Interface / Exposed - works with PB Gadget number
; Only exposed routines should call _MyGrid_Draw()
;--------------------------------------------------------------------------------------------
Procedure.i MyGrid_SynchronizeGrid(Gdt, AdjustCol)
; update grid as per scrolls ... requested by end-user
;
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If _MyGrid_ScrollsToGrid(*mg, AdjustCol)
_MyGrid_Draw(*mg)
EndIf
EndProcedure
Procedure.i MyGrid_ShowCell(Gdt.i, Row, Col, SetCellFocus = #False)
; makes sure cell defined by (Row,Col) is visible on screen - scrolls if need be
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Protected i,h,w,b1.i,b2.i, ar, ac
If _MyGrid_IsValidCell(*mg, Row, Col) = #False : ProcedureReturn #False : EndIf
If *mg\RowHeight(Row) <= 0 : ProcedureReturn #False : EndIf
If *mg\ColWidth(Col) <= 0 : ProcedureReturn #False : EndIf
ar = _MyGrid_Area_Of_Row(*mg, row)
ac = _MyGrid_Area_Of_Col(*mg, col)
b1 = #False : b2 = #False
If ar >= 0
SelectElement(*mg\LstAreaRow() , ar)
If *mg\LstAreaRow()\Y + *mg\LstAreaRow()\Height <= *mg\Height
b1 = #True
EndIf
EndIf
If ac >= 0
SelectElement(*mg\LstAreaCol() , ac)
If *mg\LstAreaCol()\X + *mg\LstAreaCol()\Width <= *mg\Width
b2 = #True
EndIf
EndIf
If b1 And b2
If SetCellFocus
If StartDrawing(CanvasOutput(*mg\Gadget))
_MyGrid_UnDrawFocus(*mg)
*mg\Row = row
*mg\Col = col
_MyGrid_DrawFocus(*mg)
StopDrawing()
EndIf
EndIf
ProcedureReturn #True
EndIf
; we need to scroll via adjusting TopRow/TopCol => re-draw
If Not b1
If *mg\TopRow > row ; scrolling up one shot
*mg\TopRow = row
Else
; scrolling down
*mg\TopRow = row
FirstElement(*mg\LstAreaRow())
h = (*mg\LstAreaRow()\Height - 1) + (*mg\RowHeight(row) - 1)
For i = 1 To *mg\FrozenRow
h = h + (*mg\RowHeight(i) - 1)
Next
For i = row-1 To 1 Step -1
If h + *mg\RowHeight(i) > *mg\Height : Break : EndIf
h = h + (*mg\RowHeight(i) - 1)
*mg\TopRow = i
Next i
EndIf
EndIf
If Not b2
If *mg\TopCol > col ; scrolling left one shot
*mg\TopCol = col
Else
; scrolling right
*mg\TopCol = col
FirstElement(*mg\LstAreaCol())
w = (*mg\LstAreaCol()\Width - 1) + (*mg\ColWidth(col) - 1)
For i = 1 To *mg\FrozenCol
w = w + (*mg\ColWidth(i) - 1)
Next
For i = col-1 To 1 Step -1
If w + *mg\ColWidth(i) > *mg\Width : Break : EndIf
w = w + (*mg\ColWidth(i) - 1)
*mg\TopCol = i
Next i
EndIf
EndIf
If SetCellFocus
*mg\Row = row
*mg\Col = col
EndIf
_MyGrid_GridToScrolls(*mg)
_MyGrid_Draw(*mg)
ProcedureReturn #True
EndProcedure
Macro MyGrid_FocusCell(Gdt, Row, Col)
; moves the focus from current cell to the new one defind by param
MyGrid_ShowCell(Gdt, Row, Col, #True)
EndMacro
Procedure.i MyGrid_MoveVertical(Gdt, xRows)
; moves the current cell down/up by 'xRows' (showable rows)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Protected shiftedRows = _MyGrid_NeededRows(*mg, *mg\Row, xRows)
If shiftedRows <> 0
MyGrid_FocusCell(Gdt, *mg\Row + shiftedRows, *mg\Col)
EndIf
EndProcedure
Procedure.i MyGrid_MoveHorizontal(Gdt, xCols)
; moves the current cell right/left by 'xCols' (showable Cols)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Protected shiftedCols = _MyGrid_NeededCols(*mg, *mg\Col, xCols)
If shiftedCols <> 0
MyGrid_FocusCell(gdt, *mg\Row , *mg\Col + shiftedCols)
EndIf
EndProcedure
Procedure MyGrid_NoRedraw(Gdt.i)
; stops drawing - useful when many settings that should yield a drawing each are
; grouped together ... once applying those settings is over, we draw once only
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
*mg\NoRedraw = #True
EndProcedure
Procedure MyGrid_Redraw(Gdt.i)
; forces a draw now
Protected *mg._MyGrid_Type = GetGadgetData(gdt)
*mg\NoRedraw = #False
_MyGrid_Draw(*mg)
EndProcedure
;--------------------------- New Grid
Procedure.i MyGrid_New(WinNbr, ContainerNbr, Gadget, GadgetColScroll, GadgetRowScroll, X, Y, W, H, Rows = 500, Cols = 100, DoNotDraw = #False)
Protected *mg._MyGrid_Type, oldGdtList
Protected ret,i,j,ttlW,ttlH,xx,yy
If Not IsWindow(WinNbr) : ProcedureReturn : EndIf
*mg._MyGrid_Type = AllocateMemory(SizeOf(_MyGrid_Type))
InitializeStructure(*mg, _MyGrid_Type)
W = W - #MyGrid_Scroll_Width
H = H - #MyGrid_Scroll_Width
With *mg
\Window = WinNbr
\Container = ContainerNbr
\X = X
\Y = Y
\Width = W
\Height = H
EndWith
; -- sub-gadgets creation
oldGdtList = UseGadgetList(WindowID(WinNbr))
ret = CanvasGadget(Gadget, X, Y, W, H, #PB_Canvas_Keyboard);|#PB_Canvas_Border)
If Gadget = #PB_Any : Gadget = ret: EndIf
SetGadgetData(Gadget, *mg)
*mg\Gadget = Gadget
;
ScrollBarGadget(GadgetColScroll, X,Y+H, W,#MyGrid_Scroll_Width,0,0,0)
ScrollBarGadget(GadgetRowScroll, X+W, Y, #MyGrid_Scroll_Width,H,0,0,0, #PB_ScrollBar_Vertical)
*mg\ColScroll = GadgetColScroll
*mg\RowScroll = GadgetRowScroll
UseGadgetList(oldGdtList)
_MyGrid_Reset(*mg, Rows, Cols)
; drawing - usefule if we need to customie the grid first
If DoNotDraw = #False
_MyGrid_Draw(*mg)
EndIf
ProcedureReturn ret
EndProcedure
;---------------------------
;---- ********************** some Setters/Getters:
; --- Grid level
Procedure.i MyGrid_SetColorAttribute(Gdt.i, Attribute = #MyGrid_Color_Line, Value = $CCCCCC)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Select Attribute
Case #MyGrid_Color_Line : *mg\Color_Line = Value
Case #MyGrid_Color_Background : *mg\Color_Background = Value
Case #MyGrid_Color_FocusBack : *mg\Color_FocusBorder = Value
Case #MyGrid_Color_FocusBorder : *mg\Color_FocusBack = Value
Case #MyGrid_Color_BlockBack : *mg\Color_BlockBack = Value
EndSelect
EndProcedure
Procedure.i MyGrid_GetColorAttribute(Gdt.i, Attribute = #MyGrid_Color_Line)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Select Attribute
Case #MyGrid_Color_Line : ProcedureReturn *mg\Color_Line
Case #MyGrid_Color_Background : ProcedureReturn *mg\Color_Background
Case #MyGrid_Color_FocusBack : ProcedureReturn *mg\Color_FocusBorder
Case #MyGrid_Color_FocusBorder : ProcedureReturn *mg\Color_FocusBack
Case #MyGrid_Color_BlockBack : ProcedureReturn *mg\Color_BlockBack
EndSelect
ProcedureReturn -1
EndProcedure
Procedure.i MyGrid_AttachPopup(Gdt.i, Popup.i)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
*mg\AttachedPopupMenu = Popup
EndProcedure
Procedure.i MyGrid_ReDefine(Gdt.i, Rows, Cols)
Protected i, *mg._MyGrid_Type = GetGadgetData(gdt)
_MyGrid_Reset(*mg, Rows, Cols)
_MyGrid_Draw(*mg)
EndProcedure
Procedure MyGrid_Resize(Gdt.i, X,Y,W,H)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If X = #PB_Ignore : X = *mg\X : EndIf
If Y = #PB_Ignore : Y = *mg\Y : EndIf
If W = #PB_Ignore : W = *mg\Width : EndIf
If H = #PB_Ignore : H = *mg\Height : EndIf
W = W - #MyGrid_Scroll_Width
H = H - #MyGrid_Scroll_Width
ResizeGadget(Gdt, X, Y , W, H)
*mg\Width = W
*mg\Height = H
*mg\X = X
*mg\Y = Y
; -- resizing scroll bars
If *mg\ColScroll
ResizeGadget( *mg\ColScroll, *mg\X, *mg\Y + H, W, #MyGrid_Scroll_Width)
HideGadget( *mg\ColScroll, #False )
EndIf
If *mg\RowScroll
ResizeGadget( *mg\RowScroll, *mg\X + W, *mg\Y, #MyGrid_Scroll_Width, H)
HideGadget( *mg\RowScroll, #False )
EndIf
_MyGrid_Draw(*mg)
_MyGrid_AdjustScrolls(*mg)
EndProcedure
Procedure MyGrid_Hide(Gdt.i, State = 0)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
HideGadget(Gdt, State)
If *mg\ColScroll : HideGadget(*mg\ColScroll, State) : EndIf
If *mg\RowScroll : HideGadget(*mg\RowScroll, State) : EndIf
EndProcedure
Procedure MyGrid_Free(Gdt.i)
Protected *mg._MyGrid_Type
If IsGadget(Gdt)
*mg = GetGadgetData(Gdt)
FreeGadget(Gdt)
If *mg\ColScroll : FreeGadget(*mg\ColScroll) : EndIf
If *mg\RowScroll : FreeGadget(*mg\RowScroll) : EndIf
FreeMemory(*mg)
EndIf
EndProcedure
Procedure.i MyGrid_SetText(Gdt.i, Row.i, Col.i, Txt.s)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If _MyGrid_IsValidCell(*mg, Row, Col)
_MyGrid_SetCellText(*mg, Row, Col, Txt)
EndIf
EndProcedure
Procedure.s MyGrid_GetText(Gdt.i, Row.i, Col.i)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If _MyGrid_IsValidCell(*mg, Row, Col)
ProcedureReturn _MyGrid_GetCellText(*mg, Row, Col)
EndIf
ProcedureReturn ""
EndProcedure
; --- For Columns
Procedure.i MyGrid_Col_SetColID(Gdt.i, Col.i, ColID.s)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If Col <= *mg\Cols And Col > 0
*mg\DicColID(UCase(ColID)) = Col
*mg\ColID(Col) = ColID
EndIf
EndProcedure
Procedure.i MyGrid_ColNumberOfColID(Gdt.i, ColID.s)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If FindMapElement(*mg\DicColID(), UCase(ColID))
ProcedureReturn *mg\DicColID()
EndIf
ProcedureReturn -1
EndProcedure
Procedure.i MyGrid_Col_ChangeWidth(Gdt.i, GCol.i, Width.i = #MyGrid_Default_ColWidth)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
_MyGrid_ChangeColWidth(*mg, GCol, Width)
_MyGrid_Draw(*mg)
EndProcedure
Procedure.i MyGrid_Col_Hide(Gdt.i, GCol.i, State)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If State
_MyGrid_ChangeColWidth(*mg, GCol, -1) ; hidden by application cannot be un-hidden by user
_MyGrid_Draw(*mg)
Else
_MyGrid_ChangeColWidth(*mg, GCol, #MyGrid_Default_ColWidth)
_MyGrid_Draw(*mg)
EndIf
EndProcedure
Procedure.i MyGrid_Col_AutoWidth(Gdt.i, GCol)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Protected i, SFont, mxWdh, wdh, iC, C1, C2, wrd.s, rdrw
If Not _MyGrid_IsValidGenericCol(*mg, GCol) : ProcedureReturn : EndIf
If GCol >= 0 : C1 = GCol : C2 = GCol : EndIf
If GCol = #MyGrid_RC_Data : C1 = 1 : C2 = *mg\Cols : EndIf
If GCol = #MyGrid_RC_Any : C1 = 0 : C2 = *mg\Cols : EndIf
; dummy StartDrawing to measure text-width
If StartDrawing(CanvasOutput(*mg\Gadget))
For iC = C1 To C2
mxWdh = 0
For i = 0 To *mg\Rows
wrd = _MyGrid_GetCellText(*mg, i, iC)
If wrd <> ""
__MyGrid_SelectStyle(*mg, i, iC)
SFont = *mg\LstStyle()\Font
If IsFont(SFont) : DrawingFont(FontID(SFont)) : EndIf
wdh = TextWidth(wrd)
If wdh > mxWdh : mxWdh = wdh : EndIf
EndIf
Next i
mxWdh = mxWdh + (2*#MyGrid_Text_MarginX)
If *mg\ColWidth( iC) <> mxWdh
If mxWdh > 0.9 * *mg\Width : mxWdh = 0.9 * *mg\Width : EndIf
_MyGrid_ChangeColWidth(*mg, iC, mxWdh)
rdrw = #True
EndIf
Next iC
StopDrawing()
EndIf
If rdrw : _MyGrid_Draw(*mg) : EndIf
EndProcedure
Procedure.i MyGrid_Col_Freeze(Gdt.i, Col.i)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If Col <= *mg\Cols And Col >= 0
*mg\FrozenCol = Col
_MyGrid_AdjustScrolls(*mg)
EndIf
EndProcedure
; --- For Rows only
Procedure.i MyGrid_Row_ChangeHeight(Gdt.i, GRow.i, Height.i = #MyGrid_Default_RowHeight)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
_MyGrid_ChangeRowHeight(*mg, GRow, Height)
_MyGrid_Draw(*mg)
EndProcedure
Procedure.i MyGrid_Row_Hide(Gdt.i, GRow.i, State)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If State
_MyGrid_ChangeRowHeight(*mg, GRow, -1) ; hidden by application cannot be un-hidden by user
_MyGrid_Draw(*mg)
Else
_MyGrid_ChangeRowHeight(*mg, GRow, #MyGrid_Default_RowHeight)
_MyGrid_Draw(*mg)
EndIf
EndProcedure
Procedure.i MyGrid_Row_AutoHeight(Gdt.i, GRow)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Protected i, SFont, mxHgt, hgt, iR, R1, R2, wrd.s, rdrw
If Not _MyGrid_IsValidGenericRow(*mg, GRow) : ProcedureReturn : EndIf
If GRow >= 0 : R1 = GRow : R2 = GRow : EndIf
If GRow = #MyGrid_RC_Data : R1 = 1 : R2 = *mg\Rows : EndIf
If GRow = #MyGrid_RC_Any : R1 = 0 : R2 = *mg\Rows : EndIf
; dummy StartDrawing to measure text-width
If StartDrawing(CanvasOutput(*mg\Gadget))
For iR = R1 To R2
mxHgt = 0
For i = 0 To *mg\Cols
wrd = _MyGrid_GetCellText(*mg, iR, i)
If wrd <> ""
__MyGrid_SelectStyle(*mg, iR, i)
SFont = *mg\LstStyle()\Font
If IsFont(SFont) : DrawingFont(FontID(SFont)) : EndIf
hgt = TextHeight(wrd)
If hgt > mxHgt : mxHgt = hgt : EndIf
EndIf
Next i
mxHgt = mxHgt + (2*#MyGrid_Text_MarginY)
If *mg\RowHeight(iR) <> mxHgt
If mxHgt > 0.9 * *mg\Height : mxHgt = 0.9 * *mg\Height : EndIf
_MyGrid_ChangeRowHeight(*mg, iR, mxHgt)
rdrw = #True
EndIf
Next iR
StopDrawing()
EndIf
If rdrw : _MyGrid_Draw(*mg) : EndIf
EndProcedure
Procedure.i MyGrid_Row_Freeze(Gdt.i, Row.i)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If Row <= *mg\Rows And Row >= 0
*mg\FrozenRow = Row
_MyGrid_AdjustScrolls(*mg)
EndIf
EndProcedure
Procedure.i MyGrid_ReviseStyle(Gdt,Style=#MyGrid_DefStyle_DataCell,Algn=#PB_Ignore,BColor=#PB_Ignore,FColor=#PB_Ignore,Font=#PB_Ignore,CellType=#PB_Ignore,Editable=#PB_Ignore)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
If Style < ListSize(*mg\LstStyle()) And Style >= 0
SelectElement(*mg\LstStyle() , Style)
If Algn <> #PB_Ignore : *mg\LstStyle()\Aling = Algn : EndIf
If BColor <> #PB_Ignore : *mg\LstStyle()\BackColor = BColor : EndIf
If FColor <> #PB_Ignore : *mg\LstStyle()\ForeColor = FColor : EndIf
If Font <> #PB_Ignore : *mg\LstStyle()\Font = Font : EndIf
If CellType <> #PB_Ignore : *mg\LstStyle()\CellType = CellType : EndIf
If Editable <> #PB_Ignore : *mg\LstStyle()\Editable = Editable : EndIf
_MyGrid_Draw(*mg)
EndIf
EndProcedure
; --- Event Manager: all events are processed here!
Procedure.i MyGrid_ManageEvent(Gdt.i, eType, eScrollGdt)
Protected *mg._MyGrid_Type = GetGadgetData(Gdt)
Protected ky,mf, prvState,mx,my,x,y,w,h,ar,ac,col,row,mv,dlt,i,keepOn,crs
If eScrollGdt = *mg\ColScroll
MyGrid_SynchronizeGrid(Gdt, 1)
ProcedureReturn
EndIf
If eScrollGdt = *mg\RowScroll
MyGrid_SynchronizeGrid(Gdt, 0)
ProcedureReturn
EndIf
Select eType
Case #PB_EventType_KeyDown
ky = GetGadgetAttribute(gdt, #PB_Canvas_Key )
Select ky
Case #PB_Shortcut_Left
If GetGadgetAttribute(gdt, #PB_Canvas_Modifiers ) = #PB_Canvas_Control
MyGrid_FocusCell(gdt, *mg\Row, *mg\FrozenCol + 1)
Else
MyGrid_MoveHorizontal(gdt, -1)
EndIf
Case #PB_Shortcut_Right, #PB_Shortcut_Tab
If GetGadgetAttribute(gdt, #PB_Canvas_Modifiers ) = #PB_Canvas_Control
MyGrid_FocusCell(gdt, *mg\Row, *mg\Cols)
Else
MyGrid_MoveHorizontal(gdt, 1)
EndIf
Case #PB_Shortcut_Up :
If GetGadgetAttribute(gdt, #PB_Canvas_Modifiers ) = #PB_Canvas_Control
MyGrid_FocusCell(gdt, *mg\FrozenRow + 1, *mg\Col)
Else
MyGrid_MoveVertical(gdt, -1)
EndIf
Case #PB_Shortcut_Down :
If GetGadgetAttribute(gdt, #PB_Canvas_Modifiers ) = #PB_Canvas_Control
MyGrid_FocusCell(gdt, *mg\Rows, *mg\Col)
Else
MyGrid_MoveVertical(gdt, 1)
EndIf
Case #PB_Shortcut_Prior : MyGrid_MoveVertical(gdt, -20)
Case #PB_Shortcut_Next : MyGrid_MoveVertical(gdt, 20)
Case #PB_Shortcut_Home :
mf = GetGadgetAttribute(gdt, #PB_Canvas_Modifiers )
If mf = #PB_Canvas_Control
MyGrid_FocusCell(gdt, *mg\FrozenRow + 1, *mg\FrozenCol + 1)
EndIf
Case #PB_Shortcut_End
mf = GetGadgetAttribute(gdt, #PB_Canvas_Modifiers )
If mf = #PB_Canvas_Control
MyGrid_FocusCell(gdt, *mg\Rows, *mg\Cols)
EndIf
Case #PB_Shortcut_Delete, #PB_Shortcut_Back
__MyGrid_SelectStyle(*mg, *mg\Row, *mg\Col)
If *mg\LstStyle()\Editable
_MyGrid_SetCellText(*mg, *mg\Row, *mg\Col, "")
_MyGrid_DrawCurrentCell(*mg)
EndIf
Case #PB_Shortcut_Return
; text input takes place in current cell regardless of mouse position
If MyGrid_ShowCell(gdt, *mg\Row, *mg\Col)
_MyGrid_ManageEdit(*mg , "", #True, #False)
EndIf
EndSelect
Case #PB_EventType_Input ;, #PB_EventType_LeftDoubleClick
; text input takes place in current cell regardless of mouse position
If MyGrid_ShowCell(gdt, *mg\Row, *mg\Col)
_MyGrid_ManageEdit(*mg , Chr(GetGadgetAttribute(gdt, #PB_Canvas_Input)), #False, #False )
EndIf
Case #PB_EventType_MouseWheel
dlt = GetGadgetAttribute(gdt, #PB_Canvas_WheelDelta)
; when moving wheel down towards me (like pressing key-down) => dlt < 0
; when moving wheel up towards screen (like pressing key-up) => dlt > 0
If dlt < 0
If _MyGrid_CanScrollDown(*mg)
row = *mg\TopRow
_MyGrid_ChangeCurTopRow(*mg, -dlt)
If row <> *mg\TopRow : _MyGrid_Draw(*mg) : EndIf
EndIf
ElseIf dlt > 0
If _MyGrid_CanScrollUp(*mg)
row = *mg\TopRow
_MyGrid_ChangeCurTopRow(*mg, -dlt)
If row <> *mg\TopRow : _MyGrid_Draw(*mg) : EndIf
EndIf
EndIf
Case #PB_EventType_LeftDoubleClick
; text input takes place in current cell regardless of mouse position
x = GetGadgetAttribute(gdt, #PB_Canvas_MouseX)
y = GetGadgetAttribute(gdt, #PB_Canvas_MouseY)
ac = _MyGrid_AreaCol_Of_X(*mg, x)
ar = _MyGrid_AreaRow_Of_Y(*mg, y)
If ar > 0 And ac > 0
; cell area
If MyGrid_ShowCell(gdt, *mg\Row, *mg\Col)
_MyGrid_ManageEdit(*mg , "", #True, #False)
EndIf
Else
; header area ?
ac = _MyGrid_AreaResizeCol(*mg, x, y)
If ac >= 0
SelectElement(*mg\LstAreaCol() , ac)
MyGrid_Col_AutoWidth(gdt, *mg\LstAreaCol()\Col)
Else
ar = _MyGrid_AreaResizeRow(*mg, x, y)
If ar >= 0
SelectElement(*mg\LstAreaRow() , ar)
MyGrid_Row_AutoHeight(gdt, *mg\LstAreaRow()\Row)
EndIf
EndIf
EndIf
Case #PB_EventType_MouseEnter
Case #PB_EventType_MouseMove
; 1. Change cursor to allow resizing: Col/Row
; 2. Resizing Col/Row
; 3. Scrolling Up/Down
; 4. selecting a block of cell
x = GetGadgetAttribute(gdt, #PB_Canvas_MouseX)
y = GetGadgetAttribute(gdt, #PB_Canvas_MouseY)
If GetGadgetAttribute(gdt, #PB_Canvas_Buttons) = #PB_Canvas_LeftButton
; continuing the current move-action if any ... or starting new one
mv = *mg\MoveStatus
Select mv
Case #MyGrid_MouseMove_Nothing
; starting new move-action
crs = GetGadgetAttribute(*mg\Gadget, #PB_Canvas_Cursor)
Select crs
Case #PB_Cursor_LeftRight
*mg\PreviousX = x : *mg\PreviousY = y
*mg\MoveStatus = #MyGrid_MouseMove_Resize
Case #PB_Cursor_UpDown
*mg\PreviousX = x : *mg\PreviousY = y
*mg\MoveStatus = #MyGrid_MouseMove_Resize
EndSelect
Case #MyGrid_MouseMove_Block
Case #MyGrid_MouseMove_Resize
Case #MyGrid_MouseMove_Scroll
EndSelect
Else
*mg\MoveStatus = #MyGrid_MouseMove_Nothing ; no move-action
_MyGrid_ChangeMouse(*mg, x, y)
EndIf
Case #PB_EventType_MouseLeave
Case #PB_EventType_LeftButtonUp
x = GetGadgetAttribute(gdt, #PB_Canvas_MouseX)
y = GetGadgetAttribute(gdt, #PB_Canvas_MouseY)
mv = *mg\MoveStatus
Select mv
Case #MyGrid_MouseMove_Nothing
; a simple click in a cell
row = _MyGrid_Row_Of_Y(*mg, y)
col = _MyGrid_Col_Of_X(*mg, x)
If row = *mg\Row And col = *mg\Col
_MyGrid_ManageEdit(*mg, "", #False, #True)
EndIf
Case #MyGrid_MouseMove_Block
Case #MyGrid_MouseMove_Resize
_MyGrid_UserResize(*mg, x, y)
_MyGrid_Draw(*mg)
*mg\MoveStatus = #MyGrid_MouseMove_Nothing
Case #MyGrid_MouseMove_Scroll
EndSelect
Case #PB_EventType_LeftButtonDown
x = GetGadgetAttribute(gdt, #PB_Canvas_MouseX)
y = GetGadgetAttribute(gdt, #PB_Canvas_MouseY)
ac = _MyGrid_AreaCol_Of_X(*mg, x)
ar = _MyGrid_AreaRow_Of_Y(*mg, y)
If ar > 0 And ac > 0
SelectElement(*mg\LstAreaRow() , ar)
SelectElement(*mg\LstAreaCol() , ac)
MyGrid_FocusCell(gdt, *mg\LstAreaRow()\Row, *mg\LstAreaCol()\Col)
EndIf
Case #PB_EventType_RightButtonDown
If IsMenu(*mg\AttachedPopupMenu)
; launches the attachd popup menu - that's all
; selected menu-items will need be handled by caller (via EvenMenu())!
x = GetGadgetAttribute(gdt, #PB_Canvas_MouseX)
y = GetGadgetAttribute(gdt, #PB_Canvas_MouseY)
If _MyGrid_OverCellArea(*mg, x, y)
row = _MyGrid_Row_Of_Y(*mg, y)
col = _MyGrid_Col_Of_X(*mg, x)
MyGrid_FocusCell(gdt, row, col)
;DisplayPopupMenu(*mg\AttachedPopupMenu, WindowID(*mg\Window), x, y)
DisplayPopupMenu(*mg\AttachedPopupMenu, WindowID(*mg\Window))
EndIf
EndIf
Default ; any other event is simply ignored ... for now
ProcedureReturn #False
EndSelect
EndProcedure
;{ Test
CompilerIf #PB_Compiler_IsMainFile
Enumeration
#Win_Nbr
#Grid_Nbr
#Grid_ColScroll
#Grid_RowScroll
#Grid_PopupMenu
#MenuItem_1
#MenuItem_2
#MenuItem_3
#MenuItem_4
#MenuItem_5
EndEnumeration
Global ii,EvGd, Evnt, EvTp, EvMn
If OpenWindow(#Win_Nbr, 0, 0, 1000, 670, "MyGrid Said", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered|#PB_Window_SizeGadget)
SetWindowColor(#Win_Nbr,#White)
If CreatePopupMenu(#Grid_PopupMenu) ; creation of the pop-up menu begins...
MenuItem(#MenuItem_1, "Show")
MenuItem(#MenuItem_2, "Hide")
MenuItem(#MenuItem_3, "Freeze here")
MenuBar()
OpenSubMenu("Sub-menu")
MenuItem(#MenuItem_4, "sub 1")
MenuItem(#MenuItem_5, "sub 2")
CloseSubMenu()
EndIf
MyGrid_New(#Win_Nbr, 0, #Grid_Nbr, #Grid_ColScroll, #Grid_RowScroll,10, 10, 920, 650,20000,100, #True)
; customize the grid ...
MyGrid_AttachPopup(#Grid_Nbr, #Grid_PopupMenu)
MyGrid_NoRedraw(#Grid_Nbr)
MyGrid_Col_Freeze(#Grid_Nbr, 3)
MyGrid_Row_Freeze(#Grid_Nbr, 5)
; example of extra style ( checkboxes at col# 9)
ii = _MyGrid_AddExtraStyle(GetGadgetData(#Grid_Nbr), #MyGrid_Align_Center, $E6D8AD,#Blue,Font_A8,#MyGrid_CellType_Checkbox,#True)
_MyGrid_SetExtraStyle(GetGadgetData(#Grid_Nbr), #MyGrid_RC_Data, 9, ii)
;MyGrid_Col_Hide(#Grid_Nbr, 0, 1)
;MyGrid_Row_Hide(#Grid_Nbr, 0, 1)
MyGrid_Col_Hide(#Grid_Nbr, 7, 1)
MyGrid_Redraw(#Grid_Nbr)
Repeat
EvGd = -1
EvTp = -1
EvMn = -1
Evnt = WaitWindowEvent()
Select Evnt
Case #PB_Event_SizeWindow
MyGrid_Resize(#Grid_Nbr, #PB_Ignore, #PB_Ignore, WindowWidth(#Win_Nbr) - 80, WindowHeight(#Win_Nbr) - 20)
Case #PB_Event_Gadget
EvGd = EventGadget()
EvTp = EventType()
Select EvGd
Case #Grid_Nbr
MyGrid_ManageEvent(EvGd, EvTp, 0)
Case #Grid_ColScroll
MyGrid_ManageEvent(#Grid_Nbr, EvTp, #Grid_ColScroll)
Case #Grid_RowScroll
MyGrid_ManageEvent(#Grid_Nbr, EvTp, #Grid_RowScroll)
EndSelect
Case #PB_Event_Menu
EvMn = EventMenu()
Select EvMn
Case #MenuItem_1 : Debug " popup menu 1 "
Case #MenuItem_2 : Debug " popup menu 2 "
Case #MenuItem_3 : Debug " popup menu 3 "
Case #MenuItem_4 : Debug " popup menu 4 "
Case #MenuItem_5 : Debug " popup menu 5 "
EndSelect
EndSelect
Until Evnt = #PB_Event_CloseWindow
EndIf
CompilerEndIf
;}
