Canvas based Grid gadget
Canvas based Grid gadget
Here is a simple canvas based editable grid gadget ...
It is far from being complete but i believe it has many essential features, feel free to improve!
You have the option to get Polo's grid or Srod's one as well, they could be better than mine in many aspects (i personally have bought both!)
I hope my grid will be helpful to someone (mostly new comers) and thanks to Fred and the team for their great work.
Best,
Said
History and update:
Nov 2017
22-Nov-2017
Revised update with some more bug fixes and updated help file, available at this link:
https://github.com/said7/PureBasic/blob ... 2Nov17.zip
14-Nov-2017
New update with chm help file and much better clean code along with many bug fixes!
Can be downloaded at this link:
https://github.com/said7/PureBasic/blob ... 4Nov17.zip
11-Nov-2017
Many new improvements:
1. adapted to the latest PB 5.61
2. in a module now
3. includes sort single (on screen) and multi from code
4. can now display image as well
5. uses its own editor (MyEdit.pb packed in the zip file)
6. plus some new extra features
You can get the new version at my page at github or use the following link (a zip file that contains 2 PB files:
1. MyGrid_11Nov17.PBI
2. MyEdit.pbi ( a one line-editor)
https://github.com/said7/PureBasic/blob ... 1Nov17.zip
Happy coding
Aug 2015 : Slight update of the same old version (allowing to hide Focus rectangle) and moved the includes to GitHub
* MyGrid_01Aug2015.PBI
* MyGrid_PB520.PBI (the same old release of aug-2013)
Both files can be downloaded here:
https://github.com/said7/PureBasic/tree/master
Aug-2013 : Revised for PB 5.20 B12 LTS, many new stuff, too big now you need to download the file MyGrid_PB520.pbi :
.... old link removed (dead link, now the same is also available on GitHub)
The file contains notes and examples.
Cell can now be : text/checkbox/combo/button ...
Below is the old release of Mar-2013
Revised on 24-Mar to allow recovering rows/cols re-sized to 0 by user plus few fine-tuning and cleaning
removed original post (available at github in case!)
It is far from being complete but i believe it has many essential features, feel free to improve!
You have the option to get Polo's grid or Srod's one as well, they could be better than mine in many aspects (i personally have bought both!)
I hope my grid will be helpful to someone (mostly new comers) and thanks to Fred and the team for their great work.
Best,
Said
History and update:
Nov 2017
22-Nov-2017
Revised update with some more bug fixes and updated help file, available at this link:
https://github.com/said7/PureBasic/blob ... 2Nov17.zip
14-Nov-2017
New update with chm help file and much better clean code along with many bug fixes!
Can be downloaded at this link:
https://github.com/said7/PureBasic/blob ... 4Nov17.zip
11-Nov-2017
Many new improvements:
1. adapted to the latest PB 5.61
2. in a module now
3. includes sort single (on screen) and multi from code
4. can now display image as well
5. uses its own editor (MyEdit.pb packed in the zip file)
6. plus some new extra features
You can get the new version at my page at github or use the following link (a zip file that contains 2 PB files:
1. MyGrid_11Nov17.PBI
2. MyEdit.pbi ( a one line-editor)
https://github.com/said7/PureBasic/blob ... 1Nov17.zip
Happy coding
Aug 2015 : Slight update of the same old version (allowing to hide Focus rectangle) and moved the includes to GitHub
* MyGrid_01Aug2015.PBI
* MyGrid_PB520.PBI (the same old release of aug-2013)
Both files can be downloaded here:
https://github.com/said7/PureBasic/tree/master
Aug-2013 : Revised for PB 5.20 B12 LTS, many new stuff, too big now you need to download the file MyGrid_PB520.pbi :
.... old link removed (dead link, now the same is also available on GitHub)
The file contains notes and examples.
Cell can now be : text/checkbox/combo/button ...
Below is the old release of Mar-2013
Revised on 24-Mar to allow recovering rows/cols re-sized to 0 by user plus few fine-tuning and cleaning
removed original post (available at github in case!)
Last edited by said on Wed Nov 22, 2017 10:18 pm, edited 9 times in total.
Re: Canvas based Grid gadget
and here comes part II (with an example) - revised [24Mar13]
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
;}
Last edited by said on Sun Mar 24, 2013 10:58 am, edited 3 times in total.
- Zebuddi123
- Enthusiast
- Posts: 794
- Joined: Wed Feb 01, 2012 3:30 pm
- Location: Nottinghamshire UK
- Contact:
Re: Canvas based Grid gadget
Thanks for sharing Said must admit copied it pasted it and ran it with out looking at the code in any detail, and was perplexed initially at the freezing of line 5 in the displayed gadget.
A quick search for the the number 5 pulled very nice
Great Work
Zebuddi.
A quick search for the the number 5 pulled
Code: Select all
MyGrid_Row_Freeze(#Grid_Nbr, 5)
Great Work
Zebuddi.
malleo, caput, bang. Ego, comprehendunt in tempore
Re: Canvas based Grid gadget
very nice
Re: Canvas based Grid gadget
yes, it does look nice.
Re: Canvas based Grid gadget
Very slick.
Many thanks for sharing.
Many thanks for sharing.
Re: Canvas based Grid gadget
Said, that is excellent; thank you for sharing.
BTW, Fred gave us a handy new feature recently that is useful for testing out pbi files. Instead of this:
use this:
You may also use the inverse:
This feature allows you to test the file with the test code, and also Include it in a project without editing it to omit the test code.
BTW, Fred gave us a handy new feature recently that is useful for testing out pbi files. Instead of this:
Code: Select all
;{ Test
CompilerIf #True ; #False
Code: Select all
;{ Test
CompilerIf #PB_Compiler_IsMainFile = 1
Code: Select all
CompilerIf #PB_Compiler_IsIncludeFile = 0
Re: Canvas based Grid gadget
Nice work, thank you for sharing!
To stay cross-platform, you should change the color names to their RGB values because the predefined color names are only defined in Windows. To run your example on Linux or MacOS X, the following color constants have to be changed:
#Gray => $808080
#White => $FFFFFF
#Blue => $FF0000
Furthermore for a first run the constant definitions of #MyGrid_Text_MarginX and the following ones should also be copied behind the CompilerCase for Linux and MacOS.
To stay cross-platform, you should change the color names to their RGB values because the predefined color names are only defined in Windows. To run your example on Linux or MacOS X, the following color constants have to be changed:
#Gray => $808080
#White => $FFFFFF
#Blue => $FF0000
Furthermore for a first run the constant definitions of #MyGrid_Text_MarginX and the following ones should also be copied behind the CompilerCase for Linux and MacOS.
Re: Canvas based Grid gadget
Thank you all for the nice words, you are welcome
Tenaja, thanks for the tips, I created this since with 4.61 and still using it in projects that are not updated yet to 5.xx ... many new features would cut down many lines of codes indeed, PB is just getting better every day!
Tenaja, thanks for the tips, I created this since with 4.61 and still using it in projects that are not updated yet to 5.xx ... many new features would cut down many lines of codes indeed, PB is just getting better every day!
Re: Canvas based Grid gadget
Hi, your work is excellent.
I request the Pb team, these objects are added to the software.
I request the Pb team, these objects are added to the software.
Re: Canvas based Grid gadget
Very Nice said
Comment:
The event loop in _MyGrid_ManageEdit() blocks users from closing window.
It also shows how complex an edit routine becomes if you want to use cursors keys to navigate within a cell.
Probably depends on your user preference, but I force users to hit [Return] to accept entry or [Escape] key to exit.
The cursor keys[left,right,up,down,end,home] are then available to navigate within the cell.
Helpful if editing a very long entry.
Great work regardless!
Comment:
The event loop in _MyGrid_ManageEdit() blocks users from closing window.
It also shows how complex an edit routine becomes if you want to use cursors keys to navigate within a cell.
Probably depends on your user preference, but I force users to hit [Return] to accept entry or [Escape] key to exit.
The cursor keys[left,right,up,down,end,home] are then available to navigate within the cell.
Helpful if editing a very long entry.
Great work regardless!
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Re: Canvas based Grid gadget
Nice work Said! It's just impressive all we can do with this canvas gadget
Re: Canvas based Grid gadget
Shardik: i amended as per your suggestions for crossplatform (thanks)
Skywalk: your comment is very valid and it i been customized as my users' preferences! However both modes could/should be incorporated (maybe later) ...
Polo: thanks!
Skywalk: your comment is very valid and it i been customized as my users' preferences! However both modes could/should be incorporated (maybe later) ...
Polo: thanks!
Re: Canvas based Grid gadget
I slightly revised MyGrid_Resize() above in part II, after a re-size the scrolls were not updated properly, added one line of code at the end