Grid gadget?
Grid gadget?
Where can I find a grid gadget with abilities to manage the cells individually and by row/column? I don't see one for PB.
Also, it should be compatible with the Linux version of PB as well.
Also, it should be compatible with the Linux version of PB as well.
Currently you can use the listicon gadget and the Win API stuff to manipulate the rows and columns but it can get complex. I hear rumors of a grid control coming soon to PB. Stay tuned!
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Not me, no...
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
NelsonN:
Hope this helps.
Hope this helps.
Code: Select all
; Grid - PB 3.81
; by Einander
#LightGray = $BDBDBD : #SAND = $BBFFFF
Dim Selected.l(1)
Global Grid, Colum, Rows, _X, _Y, WCell, HCell, XGrid, YGrid, NColumns, NRows, NCells, WGrid, HGrid,SmallFont
SmallFont=LoadFont(0, "Tahoma ", 8)
Procedure inmous(x, y, x1, y1, mx, my)
ProcedureReturn mx >= x And my >= y And mx <= x1 And my <= y1
EndProcedure
Procedure CleanCell(COLU, ROW)
Box(XGrid + 1 + (COLU - 1) * WCell, YGrid + 1 + (ROW - 1) * HCell, WCell - 1, HCell - 1, #SAND)
Selected(0) = 0
EndProcedure
Procedure DrawCell(Ev)
MX = WindowMouseX() - GetSystemMetrics_(#SM_CYSIZEFRAME)
MY = WindowMouseY() - GetSystemMetrics_(#SM_CYCAPTION) - GetSystemMetrics_(#SM_CYSIZEFRAME)
If inmous(xGrid + 1, yGrid + 1, xGrid + wGrid - 2, yGrid + hGrid - 2, MX, MY)
COLU = (MX - XGrid) / WCell + 1 : ROW = (MY - YGrid) / HCell + 1
SEL = (ROW - 1) * NColumns + COLU
If Ev = #WM_LBUTTONDOWN : ProcedureReturn SEL : EndIf
If Selected(0) <> COLU Or Selected(1) <> ROW
If Selected(0) : CleanCell(SELECTED(0), Selected(1)) : EndIf
x = XGrid + (COLU - 1) * WCell + 1 : y = YGrid + ((ROW - 1) * HCell) + 1
Box(x, y, WCell - 1, HCell - 1, #GREEN)
DrawingMode(1)
FrontColor(0, 0, 0)
DrawingFont(SmallFont)
Locate(x, y) :DrawText(Str(SEL))
DrawingMode(0)
Selected(0) = COLU : Selected(1) = ROW
EndIf
ElseIf selected(0)
CleanCell(Selected(0), Selected(1))
ProcedureReturn 0
EndIf
EndProcedure
Procedure DrawGrid()
Grid = CreateImage(1, wGrid , hGrid )
StartDrawing(ImageOutput())
Box(0,0, wGrid, hGrid, #SAND)
Pos = HCell * NRows
x1 = 0 : y1 = 0
For i = 0 To NColumns
LineXY(x1, 0, x1, Pos, #LightGray)
x1 + WCell
Next i
Pos = WCell * NColumns
For i = 0 To NRows
LineXY(0, y1, Pos, y1)
y1 + HCell
Next i
StopDrawing()
EndProcedure
_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68
hWnd = OpenWindow(0, 0, 0, _X, _Y, #WS_OVERLAPPEDWINDOW, "Grid")
XGrid = 100 : YGrid = 120 ;grid position
NColumns = 10 : NRows = 20 ;number of rows & columns
WCell = 60 : HCell = 16 ;cell sizes
NCells = NColumns * NRows
WGrid = WCell * NColumns+1 : HGrid = HCell * NRows+1
CreateGadgetList(hWnd)
TextGadget(2, _x / 2, yGrid + hGrid + 10, 100, 20, "", #PB_Text_Center | #PB_Text_Border )
DrawGrid()
StartDrawing(WindowOutput())
Repeat
Ev = WindowEvent()
SEL = DrawCell(Ev)
If SEL : SetGadgetText(2, "Selected " + Str(SEL)) : selected(0) = 0 : EndIf
If Ev=#Wm_Paint : DrawImage(Grid, xgrid,ygrid) : EndIf
Until Ev = #PB_Event_CloseWindow
StopDrawing()
End
Here is the grid with a few changes to get input text.
Improvements welcommed!
Improvements welcommed!
Code: Select all
; Grid with input text
; December 26 -2003- PB 3.81
; by Einander
Enumeration
#Ret
#Txt
#Input
EndEnumeration
#LightGray = $BDBDBD : #SAND = $BBFFFF
Dim Selected.l(1): Dim textcell$(0) : Dim xcell.W(0) : Dim ycell.W(0)
Global Mx, My, Mk,S$
Global Grid, Colum, Rows, _X, _Y, WCell, HCell, XGrid, YGrid, NColumns, NRows, NCells, WGrid, HGrid, SmallFont
S$=" "
Procedure inmous(x, y, x1, y1)
ProcedureReturn mx >= x And my >= y And mx <= x1 And my <= y1
EndProcedure
Procedure CleanCell(COLU, ROW)
x = XGrid + 1 + (COLU - 1) * WCell+1
y = YGrid + 1 + (ROW - 1) * HCell+1
Box(X, Y-1, WCell-2, HCell-1, #SAND)
SEL = (ROW - 1 ) * NColumns + COLU
DrawingFont(SmallFont)
FrontColor(0, 0, 0)
Locate(x , y) : DrawText(textcell$(SEL - 1))
Selected(0) = 0
EndProcedure
Procedure DrawCell(Ev)
If inmous(xGrid + 1, yGrid + 1, xGrid + wGrid - 2, yGrid + hGrid - 2)
COLU = (MX - XGrid) / WCell + 1 : ROW = (MY - YGrid) / HCell + 1
SEL = (ROW - 1 ) * NColumns + COLU
If Ev = #WM_LBUTTONDOWN : ProcedureReturn SEL : EndIf
If Selected(0) <> COLU Or Selected(1) <> ROW
If Selected(0) : CleanCell(SELECTED(0), Selected(1)) : EndIf
x = XGrid + (COLU - 1) * WCell + 1 : y = YGrid + ((ROW - 1) * HCell) + 1
Box(x+1, y, WCell-2 , HCell-1 , #GREEN)
DrawingMode(1)
FrontColor(0, 0, 0)
DrawingFont(SmallFont)
Locate(x + 1, y+1) : DrawText(textcell$(SEL - 1))
DrawingMode(1)
Selected(0) = COLU : Selected(1) = ROW
EndIf
ElseIf selected(0)
CleanCell(Selected(0), Selected(1))
ProcedureReturn 0
EndIf
EndProcedure
Procedure DrawGrid()
Grid = CreateImage(1, wGrid, hGrid )
StartDrawing(ImageOutput())
DrawingMode(1)
Box(0, 0, wGrid, hGrid, #SAND)
Pos = HCell * NRows
x1 = 0 : y1 = 0
For i = 0 To NColumns
LineXY(x1, 0, x1, Pos, #LightGray)
x1 + WCell
Next i
Pos = WCell * NColumns
For i = 0 To NRows
LineXY(0, y1, Pos, y1)
y1 + HCell
Next i
FrontColor(0, 0, 0)
DrawingFont(SmallFont)
For i = 0 To Ncells
Locate(xcell(i) + 2, ycell(i)+2) : DrawText(textcell$(i))
Next
StopDrawing()
EndProcedure
_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68
hWnd = OpenWindow(0, 0, 0, _X, _Y, #WS_OVERLAPPEDWINDOW, "Grid")
AddKeyboardShortcut(0, #PB_Shortcut_Return, #Ret)
XGrid = 100 : YGrid = 120 ; grid position
NColumns = 8 : NRows = 12 ; number of rows & columns
WCell = 72 : HCell = 22 ; cell sizes
SmallFont = LoadFont(0, "Tahoma ", hcell/2)
NCells = NColumns * NRows
WGrid = WCell * NColumns + 1 : HGrid = HCell * NRows + 1
Dim TextCell$(Ncells)
Dim XCell.w(Ncells)
Dim YCell.w(Ncells)
For i = 0 To ncells
If i > 0 And i % ncolumns = 0 : x = 0 : y + hcell : EndIf
TextCell$(i) = Str(i + 1)
Xcell(i) = x : ycell(i) = y
x + wcell
Next
CreateGadgetList(hWnd)
TextGadget(#Txt, _x / 2, yGrid + hGrid + 10, 100, 40, "", #PB_Text_Center | #PB_Text_Border )
StringGadget(#Input, 0, 0, 0, 0, "")
DrawGrid()
StartDrawing(WindowOutput())
Repeat
MX = WindowMouseX() - GetSystemMetrics_(#SM_CYSIZEFRAME)
MY = WindowMouseY() - GetSystemMetrics_(#SM_CYCAPTION) - GetSystemMetrics_(#SM_CYSIZEFRAME)
If #WM_LBUTTONDOWN : mk = 1 : Else : mk = 0 : EndIf
Ev = WindowEvent()
SEL = DrawCell(Ev)
If SEL
If mk
HideGadget(#input, 0)
ResizeGadget(#Input, mx, my, 200, 20)
Repeat
ActivateGadget(#Input)
ev = WaitWindowEvent()
t$ = GetGadgetText(#Input)
If TextLength(t$+"W")>wcell:Break:EndIf ; limit for text too long
Until ev = #PB_Event_Menu And EventMenuID() = #Ret
If Len(t$): textcell$(sel - 1) = t$ : EndIf
StopDrawing()
drawgrid()
StartDrawing(WindowOutput())
SetGadgetText(#input, "")
ResizeGadget(#input, 0, 0, 0, 0)
EndIf
SetGadgetText(#Txt, "Selected " + Str(SEL)+s$+textcell$(sel-1))
selected(0) = 0
EndIf
If Ev = #Wm_Paint : DrawImage(Grid, xgrid, ygrid) : EndIf
Until Ev = #PB_Event_CloseWindow
StopDrawing()
End
Here is a piece of code which I haven't had time to complete as yet but offers a grid in which selections of multiple cells / columns / rows can be made.
It's approach is not quite as subtle as Einander's but as I say it does allow for click and drag type selections.
It's unlikely that I will fully complete the code but most of the 'leg work' is done.
It's approach is not quite as subtle as Einander's but as I say it does allow for click and drag type selections.
It's unlikely that I will fully complete the code but most of the 'leg work' is done.
Code: Select all
;PureGrid version 1.0 by Stephen Rodriguez.
;
;Nov 2003.
;********************************************
;This source file allows the programmer to utilise a small grid control within an application.
;This file should ideally be 'XIncludeFile' at the beginning of an application.
;The programmer first needs to construct a '_PureGrid' structure and pass a pointer to this to the OpenPureGrid procedure.
;On return from this module, the '_PureGrid' structure will be modified to reflect changes made by the
;user etc. In particular,the underlying data array will reflect any changes made.
Structure _PureGrid
PtrDataArray.l; This should contain the address of a string array used to hold the underlying data.
; Dim DataArray.s (NumberRows, NumberCols). PtrDataArray = DataArray().
NumberRows.w; The number of rows in the underlying DataArray excluding row(0) which contains column headings (optional)
NumberColumns.w; The number of columns in the underlying DataArray excluding column(0) which contains optional row headings.
ColumnHeadings.b; 1 = Yes. Flag to indicate whether read-only column headings are included within the DataArray
RowHeadings.b; 1 = Yes. Flag to indicate whether read-only row headings are included within the DataArray.
ReadOnly.b; 1 = Read only. Flag to indicate whether the underlying data array can be written to.
EndStructure
Enumeration
#PureGrid_Window = 900
#PureGrid_ZoomWindow
#PureGrid_Menu
EndEnumeration
;Menu enumeration.
Enumeration
#MenuPureGrid_Copy
#MenuPureGrid_Cut
#MenuPureGrid_Paste
#MenuPureGrid_Clear
#MenuPureGrid_Zoom
EndEnumeration
;Gadget enumeration.
Enumeration
#PureGrid_Container=900
#PureGrid_HScroll
#PureGrid_VScroll
#PureGrid_ZoomEdit
#PureGrid_ZoomButtonOkay
#PureGrid_ZoomButtonCancel
#PureGrid_StringBase
EndEnumeration
;Font enumeration
Enumeration
#PureGrid_Font1=900
#PureGrid_Font2
EndEnumeration
Enumeration; Used for selecting rectangular regions.
#Inactive
#BeginSelect
#SizingSelect
#RectangleSelected
EndEnumeration
;Declare constants.
#PureGrid_Yes.b = 1 : #PureGrid_No.b = 0 : #PureGrid_DefaultCellWidth.b = 100 : #PureGrid_DefaultCellHeight.b = 20
#PureGrid_EnableZoomBox.b = #PureGrid_Yes; Change this option if you do not wish to offer the Zoom Box facility.
;Declare globals.
Global PureGrid_DisplayedRows.b, PureGrid_DisplayedColumns; No. of rows/columns to be displayed.
Global PureGrid_DefaultDisplayedRows.b, PureGrid_DefaultDisplayedColumns.b; Default no. of rows/columns to be displayed.
Global PureGrid_Left.w, PureGrid_Top.w; Used to indicate which data item occupies grid cell (1, 1).
Global PureGrid_x.w, PureGrid_y.w; Points to the grid cell with the focus; NOT the corresponding element within the data array.
Global PureGrid_DataRows.w, PureGrid_DataColumns.w, PureGrid_RowHeadings.b, PureGrid_ColumnHeadings.b, PureGrid_PtrDataArray, PureGrid_ReadOnly.b; These are used to record information about the underlying data array.
Global PureGrid_SelectingRectangle.b, PureGrid_Rectangle.RECT; Used when selecting a region.
Global BlackBrush.l, WhiteBrush.l; Used when highlighting selected cells.
;Declare fonts used.
LoadFont(#PureGrid_Font1, "Arial", 10, #PB_Font_Bold)
LoadFont(#PureGrid_Font2, "Arial", 10)
;Declare procedures.
Declare InitialisePureGridVariables()
Declare OpenPureGrid(*Grid._PureGrid, Title$)
Declare CreatePureGridGadgets(Title$)
Declare PaintPureGrid(flag.b)
Declare PureGridWriteDataFromCell(tempx.w, tempy.w)
Declare PureGridRowColumnIdentify(*temp.point)
Declare WindowCallBack(WindowID,Message,wParam,lParam)
Declare PureGridZoom()
;Set up some dummy data for testing purposes.
PureGrid._PureGrid
PureGrid\NumberRows = 20
PureGrid\NumberColumns = 16
PureGrid\ColumnHeadings = #PureGrid_No
PureGrid\RowHeadings = #PureGrid_No
PureGrid\ReadOnly = #PureGrid_No
Dim DataArray.s (20,16)
For PureGrid_LoopRow = 1 To PureGrid\NumberRows
For PureGrid_LoopCol = 1 To PureGrid\NumberColumns
DataArray(PureGrid_LoopRow, PureGrid_LoopCol) = "(" + Str(PureGrid_LoopRow) + ", " + Str(PureGrid_LoopCol) + ")"
Next PureGrid_LoopCol
Next PureGrid_LoopRow
PureGrid\PtrDataArray = DataArray()
OpenPureGrid(@PureGrid, "TESTING.")
End
;End of setting up dummy data.
;The following procedure initialises global variables etc.
Procedure InitialisePureGridVariables()
;First calculate the possible number of rows and columns which can fit on the screen.
;This obviously depends upon the screen resolution etc.
PureGrid_DefaultDisplayedRows = 15
PureGrid_DefaultDisplayedColumns = WindowWidth()/#PureGrid_DefaultCellWidth - 2
PureGrid_Left = 1
PureGrid_Top = 1
PureGrid_x = 1
PureGrid_y = 1
PureGrid_Rectangle\left = -1:PureGrid_Rectangle\Top = -1:PureGrid_Rectangle\right = -1:PureGrid_Rectangle\bottom = -1
PureGrid_SelectingRectangle = #Inactive
;Create brushes used in highlighting selected cells.
BlackBrush = CreateSolidBrush_($0)
WhiteBrush = CreateSolidBrush_($ffffff)
EndProcedure
Procedure CreatePureGridGadgets(Title$)
Protected LoopRow, LoopColumn, OldAddress, ContainerWidth, ContainerHeight, Style
;The TempDataArray essentially points to the actual underlying data array.
Dim TempDataArray.s(PureGrid_DataRows, PureGrid_DataColumns)
OldAddress = TempDataArray()
TempDataArray() = PureGrid_PtrDataArray
;Finished setting up TempDataArray.
;First load the underlying data array with default row and column headings if none are given.
If PureGrid_ColumnHeadings = #PureGrid_No
For LoopColumn = 1 To PureGrid_DataColumns
TempDataArray(0, LoopColumn) = "Col " + Str(LoopColumn)
Next LoopColumn
EndIf
If PureGrid_RowHeadings = #PureGrid_No
For LoopRow = 1 To PureGrid_DataRows
TempDataArray(LoopRow,0) = "Row " + Str(LoopRow)
Next LoopRow
EndIf
;Finished loading row and column headings.
;Now set up the main gadgets.
ContainerWidth = (PureGrid_DisplayedColumns+1)*(#PureGrid_DefaultCellWidth+1)+20
ContainerHeight = (PureGrid_DisplayedRows+1)*(#PureGrid_DefaultCellHeight+1)+20
CreateGadgetList(WindowID(#PureGrid_Window))
ContainerGadget(#PureGrid_Container,(WindowWidth() - ContainerWidth)/2,(WindowHeight() - ContainerHeight)/3,ContainerWidth,ContainerHeight,#PB_Container_BorderLess)
For LoopRow = 0 To PureGrid_DisplayedRows
For LoopColumn = 0 To PureGrid_DisplayedColumns
If LoopRow = 0 Or LoopColumn = 0
ButtonGadget(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,(#PureGrid_DefaultCellWidth+1)*(LoopColumn),(#PureGrid_DefaultCellHeight+1)*(LoopRow),#PureGrid_DefaultCellWidth,#PureGrid_DefaultCellHeight,"")
SetGadgetFont(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,UseFont(#PureGrid_Font1))
Else
Style = #PB_String_BorderLess | #PB_String_Multiline
If PureGrid_ReadOnly = #PureGrid_Yes
Style = Style | #PB_String_ReadOnly
EndIf
StringGadget(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,(#PureGrid_DefaultCellWidth+1)*(LoopColumn),(#PureGrid_DefaultCellHeight+1)*(LoopRow),#PureGrid_DefaultCellWidth,#PureGrid_DefaultCellHeight,"", Style)
SetGadgetFont(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,UseFont(#PureGrid_Font2))
EndIf
SetGadgetText(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn, TempDataArray(LoopRow, LoopColumn))
Next LoopColumn
Next LoopRow
;Now for the scroll bar gadgets.
ScrollBarGadget(#PureGrid_HScroll, #PureGrid_DefAultCellWidth+1, (PureGrid_DisplayedRows+1)*(#PureGrid_DefaultCellHeight+1),(PureGrid_DisplayedColumns)*(#PureGrid_DefaultCellWidth+1), 20, 1, PureGrid_DataColumns, PureGrid_DisplayedColumns)
ScrollBarGadget(#PureGrid_VScroll, (PureGrid_DisplayedColumns+1)*(#PureGrid_DefaultCellWidth+1),#PureGrid_DefAultCellHeight+1, 20, (PureGrid_DisplayedRows)*(#PureGrid_DefaultCellHeight+1), 1, PureGrid_DataRows, PureGrid_DisplayedRows, #PB_ScrollBar_Vertical)
CloseGadgetList()
ActivateGadget(#PureGrid_StringBase+1*(PureGrid_DisplayedColumns+1) +1); Cell (1, 1)
;Tidy up.
TempDataArray() = OldAddress; Restore temporary array.
Dim TempDataArray.s(0,0); Free temporary array
;End of tidying up.
EndProcedure
;The following procedure re-paints the grid, typically after it has been scrolled etc.
Procedure PaintPureGrid(flag.b); Flag = 1 for setting fonts only; 0 for writing data.
Protected LoopRow, LoopColumn, OldAddress
;The TempDataArray essentially points to the actual underlying data array.
Dim TempDataArray.s(PureGrid_DataRows, PureGrid_DataColumns)
OldAddress = TempDataArray()
TempDataArray() = PureGrid_PtrDataArray
;Finished setting up TempDataArray.
;Now re-paint the grid with the correct contents taken from the underlying data array.
For LoopRow = flag To PureGrid_DisplayedRows
For LoopColumn = flag To PureGrid_DisplayedColumns
If LoopRow = 0 And LoopColumn = 0; Ignore this cell.
ElseIf LoopRow = 0
SetGadgetText(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,TempDataArray(LoopRow, LoopColumn+PureGrid_Left-1))
ElseIf LoopColumn = 0
SetGadgetText(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,TempDataArray(LoopRow+PureGrid_Top-1, LoopColumn))
Else
If flag = 0; Write data only if required.
SetGadgetText(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,TempDataArray(LoopRow+PureGrid_Top-1, LoopColumn+ PureGrid_Left-1))
EndIf
;The following SetGadgetFont statement will cause the WindowCallBack procedure to be called which will
;set the background colour as appropriate.
SetGadgetFont(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn,UseFont(#PureGrid_Font2))
EndIf
Next LoopColumn
Next LoopRow
;Adjust cursor position after any possible scrolling etc.
;Activate relevant string gadget.
If PureGrid_x < PureGrid_Left
PureGrid_x = PureGrid_Left
EndIf
If PureGrid_x >= PureGrid_Left + PureGrid_DisplayedColumns
PureGrid_x = PureGrid_Left + PureGrid_DisplayedColumns-1
EndIf
If PureGrid_y < PureGrid_Top
PureGrid_y = PureGrid_Top
EndIf
If PureGrid_y >= PureGrid_Top + PureGrid_DisplayedRows
PureGrid_y = PureGrid_Top + PureGrid_DisplayedRows - 1
EndIf
;Now highlight the text within the selected string gadget.
ActivateGadget(#PureGrid_StringBase+(PureGrid_y-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + PureGrid_x-PureGrid_Left+1)
;Tidy up.
TempDataArray() = OldAddress; Restore temporary array.
Dim TempDataArray.s(0,0); Free temporary array
;End of tidying up.
EndProcedure
;The following procedure performs all writing of data to the underlying array.
;This ensures that we can introduce an 'Undo' facility later.
Procedure PureGridWriteDataFromCell(tempx.w, tempy.w); (tempx, tempy) point to the underlying data array.
Protected LoopRow.b, LoopColumn.b, OldAddress
;The TempDataArray essentially points to the actual underlying data array.
Dim TempDataArray.s(PureGrid_DataRows, PureGrid_DataColumns)
OldAddress = TempDataArray()
TempDataArray() = PureGrid_PtrDataArray
;Finished setting up TempDataArray.
;Now copy data from the grid ONLY if it HAS NOT been altered at all. This will allow for an UNDO action later.
If TempDataArray(tempy, tempx) <> GetGadgetText(#PureGrid_StringBase+(tempy-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + tempx-PureGrid_Left+1)
;INSERT CODE FOR DEALING WITH AN UNDO FACILITY.
TempDataArray(tempy, tempx) = GetGadgetText(#PureGrid_StringBase+(tempy-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + tempx-PureGrid_Left+1)
EndIf
;Tidy up.
TempDataArray() = OldAddress; Restore temporary array.
Dim TempDataArray.s(0,0); Free temporary array
;End of tidying up.
EndProcedure
;The following procedure involves calling the Windows API to convert the cursor screen coordinates
;into coordinates relative to the top left of the container gadget.
;This could be done using PB's WindowMouseX and WindowMouseY functions but that then leaves the task
;of determining where in the gadget the cursor is pointing to the programmer.
;The coordinates are then converted into the (row,column) position of the underlying data array which has the focus.
;(NOT the respective string gadget.) This data is then placed into the PureGrid_Rectangle structure as appropriate.
Procedure PureGridRowColumnIdentify(*temp.point)
Protected Column.w, Row.w, temporary.f
GetCursorPos_(*temp)
MapWindowPoints_(0,GadgetID(#PureGrid_Container),*temp,1)
;First identify the (row, column) grid coordinates of the gadget with the focus.
Column = Round(*temp\x /(#PureGrid_DefaultCellWidth+1),0); Ensures calculation is rounded down.
Row = Round(*temp\y /(#PureGrid_DefaultCellHeight+1),0);Avoids problems with -0.6 being rounded to 0 etc.
;Now convert to the coordinates of the respective cell in the underlying data array.
*temp\x = Column+PureGrid_Left-1
*temp\y = Row+PureGrid_Top-1
EndProcedure
;The following procedure deals with the zoom facility.
Procedure PureGridZoom()
OpenWindow(#PureGrid_ZoomWindow,175,0,639,243,#PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered,"ZOOM BOX", WindowID(#PureGrid_Window))
CreateGadgetList(WindowID(#PureGrid_ZoomWindow))
EditorGadget(#PureGrid_ZoomEdit,49,37,450,150,#PB_String_ReadOnly)
;Send an API message to set read only if appropriate.
sendmessage_(GadgetID(#PureGrid_ZoomEdit),#EM_SETREADONLY, PureGrid_ReadOnly, 0)
ButtonGadget(#PureGrid_ZoomButtonOkay,520,116,85,30,"OKAY")
ButtonGadget(#PureGrid_ZoomButtonCancel,520,156,85,30,"CANCEL")
SetGadgetText(#PureGrid_ZoomEdit,GetGadgetText(#PureGrid_StringBase+(PureGrid_y-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + PureGrid_x-PureGrid_Left+1))
ActivateGadget(#PureGrid_ZoomEdit)
Repeat
EventID=WaitWindowEvent()
Until EventID=#PB_EventCloseWindow Or (EventID = #PB_EventGadget And EventGadgetID() = #PureGrid_ZoomButtonOkay) Or (EventID = #PB_EventGadget And EventGadgetID() = #PureGrid_ZoomButtonCancel)
;Now write data back to the grid only if the proceed button was pushed.
If EventID = #PB_EventGadget And EventGadgetID() = #PureGrid_ZoomButtonOkay
SetGadgetText(#PureGrid_StringBase+(PureGrid_y-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + PureGrid_x-PureGrid_Left+1, GetGadgetText(#PureGrid_ZoomEdit))
EndIf
CloseWindow(#PureGrid_ZoomWindow)
ActivateGadget(#PureGrid_StringBase+(PureGrid_y-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + PureGrid_x-PureGrid_Left+1)
EndProcedure
;The main procedure.
Procedure OpenPureGrid(*Grid._PureGrid, Title$)
Protected temp.point, x.w, y.w, flag.b
If Title$ <> ""
Title$ = Title$ + " "
EndIf
Title$ = Title$ + "PRESS F2 TO OPEN A 'ZOOM' BOX."
OpenWindow(#PureGrid_Window,0,0,400,400, #PB_Window_Invisible | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget,Title$)
ShowWindow_(WindowID(#PureGrid_Window), #SW_maximize)
; SetClassLong_(WindowID(), #GCL_STYLE, GetClassLong_(WindowID(), #GCL_STYLE)|#CS_DBLCLKS); This allows the trapping of double click events.
;Initialise global variables.
InitialisePureGridVariables()
;Load data array and associated information.
PureGrid_PtrDataArray = *Grid\PtrDataArray; This gives direct access to the underlying DataArray.
PureGrid_DataRows = *Grid\NumberRows
PureGrid_DataColumns = *Grid\NumberColumns
PureGrid_RowHeadings = *Grid\RowHeadings
PureGrid_ColumnHeadings = *Grid\ColumnHeadings
PureGrid_ReadOnly = *Grid\ReadOnly
;The PureGrid_DisplayedRows / Columns variables denote the number of visible rows / columns.
;These are either default values (depending on window size) or the actual dimensions of the underlying
;data array; whichever is the smaller.
PureGrid_DisplayedRows = PureGrid_DefaultDisplayedRows
If PureGrid_DataRows < PureGrid_DefaultDisplayedRows : PureGrid_DisplayedRows = PureGrid_DataRows : EndIf
PureGrid_DisplayedColumns = PureGrid_DefaultDisplayedColumns
If PureGrid_DataColumns < PureGrid_DefaultDisplayedColumns : PureGrid_DisplayedColumns = PureGrid_DataColumns : EndIf
;End of loading data.
;Create menu.
CreateMenu(#PureGrid_Menu, WindowID(#PureGrid_Window))
MenuTitle("Edit")
MenuItem(#MenuPureGrid_Copy, "Copy" + Chr(9) + "(Ctrl+c)")
MenuItem(#MenuPureGrid_Cut, "Cut"+Chr(9)+"(Ctrl+x)")
MenuItem(#MenuPureGrid_Paste, "Paste"+Chr(9)+"(Ctrl+v)")
MenuItem(#MenuPureGrid_Clear, "Clear")
MenuItem(#MenuPureGrid_Zoom, "Zoom box"+Chr(9)+"(F2)")
;Create menu shortcuts.
AddKeyboardShortcut(#PureGrid_Window, #PB_Shortcut_F2, #MenuPureGrid_Zoom)
CreatePureGridGadgets(Title$)
SetWindowCallback(@WindowCallback())
;Main event loop.
Repeat
;Check to see if the user has pressed the tab key.
;In which case we must ensure correct movement through the grid.
If GetAsyncKeyState_(#VK_tab) & 1 = 1; Bit 0 is set if the tab key was pressed since the last check.
flag = 2; Used to determine how the grid will be painted. 2 means NO PAINT required.
;Write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
If PureGrid_x < PureGrid_DataColumns; Scroll right.
PureGrid_x = PureGrid_x + 1
;Check if we've moved to far right.
If PureGrid_x >= PureGrid_Left + PureGrid_DisplayedColumns
SetGadgetState(#PureGrid_HScroll, GetGadgetState(#PureGrid_HScroll)+1)
PureGrid_Left = GetGadgetState(#PureGrid_HScroll)
flag = 0; Complete paint required, including text.
EndIf
ElseIf PureGrid_y < PureGrid_DataRows; Need to move the focus down a row.
PureGrid_x = 1
SetGadgetState(#PureGrid_HScroll, 1)
If PureGrid_Left > 1
PureGrid_Left = 1
flag = 0
EndIf
PureGrid_y = PureGrid_y + 1
If PureGrid_y >= PureGrid_Top + PureGrid_displayedRows
SetGadgetState(#PureGrid_VScroll, GetGadgetState(#PureGrid_VScroll)+1)
PureGrid_Top = GetGadgetState(#PureGrid_VScroll)
flag = 0
EndIf
EndIf
;Clear any current selection.
PureGrid_Rectangle\right = -1 : PureGrid_Rectangle\bottom = -1
If PureGrid_SelectingRectangle = #RectangleSelected
If flag > 0 : flag = 1 : EndIf; Only the font properties etc. need painting.
PureGrid_SelectingRectangle = #Inactive
EndIf
If flag < 2
PaintPureGrid(flag)
EndIf
;Now highlight the relevant gadget.
ActivateGadget(#PureGrid_StringBase+(PureGrid_y-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + PureGrid_x-PureGrid_Left+1)
sendmessage_(GadgetID(#PureGrid_StringBase+(PureGrid_y-PureGrid_Top+1)*(PureGrid_DisplayedColumns+1) + PureGrid_x-PureGrid_Left+1),#EM_SETSEL, 0, -1)
EndIf
EventID=WaitWindowEvent()
If EventType() = #PB_EventType_Change; Indicates that the contents of a string gadget have changed.
;Clear any current selection.
PureGrid_Rectangle\right = -1 : PureGrid_Rectangle\bottom = -1
If PureGrid_SelectingRectangle <> #Inactive
PaintPureGrid(1)
PureGrid_SelectingRectangle = #Inactive;
EndIf
EndIf
Select eventid
Case #WM_LBUTTONDOWN
;Here the user is probably about to select a region to copy / cut etc.
;First write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
;We call a function to get the mouse (x, y) co-ordinates relative to the top-left of the container gadget
;and the coordinates are then converted into the (row,column) position of the underlying data array which has the focus.
PureGridRowColumnIdentify(@temp); The point structure will hold the retrieved data.
;Check whether the 'data point' is within the visible grid.
If temp\x >= PureGrid_Left And temp\x < PureGrid_Left + PureGrid_DisplayedColumns And temp\y >= PureGrid_Top And temp\y < PureGrid_Top + PureGrid_DisplayedRows
;Clear any current selection.
PureGrid_Rectangle\right = -1 : PureGrid_Rectangle\bottom = -1
;Set the initial top-left corner of the PureGrid_Rectangle structure to the current point.
x = temp\x
y = temp\y
;And the current cursor position.
PureGrid_x = temp\x
PureGrid_y = temp\y
If PureGrid_SelectingRectangle = #RectangleSelected Or PureGrid_SelectingRectangle = #SizingSelect
PaintPureGrid(1); This will remove the current selection.
EndIf
;Flag that the selection process has begun.
PureGrid_SelectingRectangle = #BeginSelect
ElseIf temp\x = PureGrid_left-1 And temp\y = PureGrid_top -1; Indicates that the whole data set has been selected.
PureGrid_Rectangle\left = 1
PureGrid_Rectangle\Top = 1
PureGrid_Rectangle\right = PureGrid_DataColumns
PureGrid_Rectangle\bottom = PureGrid_DataRows
PaintPureGrid(1); This will highlight the current selection.
PureGrid_SelectingRectangle = #RectangleSelected
ElseIf temp\x = PureGrid_Left-1 And temp\y >= PureGrid_Top And temp\y < PureGrid_Top + PureGrid_DisplayedRows; Indicates that a row has been selected.
x = 0 : y = temp\y; The 0 indicates that a whole row has been selected.
;Highlight the selected row.
PureGrid_Rectangle\left = 1
PureGrid_Rectangle\Top = temp\y
PureGrid_Rectangle\right = PureGrid_DataColumns
PureGrid_Rectangle\bottom = temp\y
PaintPureGrid(1); This will highlight the current selection.
PureGrid_SelectingRectangle = #SizingSelect
ElseIf temp\y = PureGrid_Top-1 And temp\x >= PureGrid_Left And temp\x < PureGrid_Left + PureGrid_DisplayedColumns; Indicates that a column has been selected.
y = 0 : x = temp\x; The 0 indicates that a whole column has been selected.
;Highlight the selected column.
PureGrid_Rectangle\left = temp\x
PureGrid_Rectangle\Top = 1
PureGrid_Rectangle\right = temp\x
PureGrid_Rectangle\bottom = PureGrid_DataRows
PaintPureGrid(1); This will highlight the current selection.
PureGrid_SelectingRectangle = #SizingSelect
EndIf
Case #WM_LBUTTONUP
Select PureGrid_SelectingRectangle
Case #BeginSelect
PureGrid_SelectingRectangle = #Inactive
Case #SizingSelect
PureGrid_SelectingRectangle = #RectangleSelected
EndSelect
Case #WM_MOUSEMOVE
;If the user is in the middle of selecting a rectangle then we need to adjust the selection rectangle etc.
If PureGrid_SelectingRectangle = #BeginSelect Or PureGrid_SelectingRectangle = #SizingSelect
flag = 1; Indicate that repainting requires only change of background colour etc.
;We call a function to get the mouse (x, y) co-ordinates relative to the top-left of the container gadget
;and the coordinates are then converted into the (row,column) position of the underlying data array which has the focus.
PureGridRowColumnIdentify(@temp); The point structure will hold the retrieved data.
;CODE FOR SCROLLING SELECTION.
;Check if the cursor is too far right.
If (temp\x >= PureGrid_Left + PureGrid_DisplayedColumns)
SetGadgetState(#PureGrid_HScroll, GetGadgetState(#PureGrid_HScroll)+1)
PureGrid_Left = GetGadgetState(#PureGrid_HScroll)
flag = 0
EndIf
;Check if the cursor is too far left. Must also check that row selection is not engaged.
If (temp\x < PureGrid_Left) And x > 0
SetGadgetState(#PureGrid_HScroll, GetGadgetState(#PureGrid_HScroll)-1)
PureGrid_Left = GetGadgetState(#PureGrid_HScroll)
flag = 0
EndIf
;Check if the cursor is too far down.
If (temp\y >= PureGrid_Top + PureGrid_DisplayedRows)
SetGadgetState(#PureGrid_VScroll, GetGadgetState(#PureGrid_VScroll)+1)
PureGrid_Top = GetGadgetState(#PureGrid_VScroll)
flag = 0
EndIf
;Check if the cursor is too far up. Must also check that column selection is not engaged.
If (temp\y < PureGrid_Top) And y > 0
SetGadgetState(#PureGrid_VScroll, GetGadgetState(#PureGrid_VScroll)-1)
PureGrid_Top = GetGadgetState(#PureGrid_VScroll)
flag = 0
EndIf
If x = 0; Row selection.
If temp\y < y
PureGrid_Rectangle\bottom = y
PureGrid_Rectangle\top = temp\y
Else
PureGrid_Rectangle\top = y
PureGrid_Rectangle\bottom = temp\y
EndIf
ElseIf y = 0; Column selection.
If temp\x < x
PureGrid_Rectangle\right = x
PureGrid_Rectangle\left = temp\x
Else
PureGrid_Rectangle\left = x
PureGrid_Rectangle\right = temp\x
EndIf
;Adjust coordinates so that (PureGrid_Rectangle\left, PureGrid_Rectangle\top) points to the top left of the selection etc.
Else
PureGrid_Rectangle\right = temp\x
PureGrid_Rectangle\bottom = temp\y
If x > PureGrid_Rectangle\right
PureGrid_Rectangle\left = PureGrid_Rectangle\right
PureGrid_Rectangle\right = x
Else
PureGrid_Rectangle\left = x
EndIf
If y > PureGrid_Rectangle\bottom
PureGrid_Rectangle\top = PureGrid_Rectangle\bottom
PureGrid_Rectangle\bottom = y
Else
PureGrid_Rectangle\top = y
EndIf
EndIf
PaintPureGrid(flag); This will highlight the current selection.
PureGrid_SelectingRectangle = #SizingSelect
EndIf
Case #PB_EventMenu
;Write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
Select EventMenuID()
Case #MenuPureGrid_Zoom
;Clear any current selection.
PureGrid_Rectangle\right = -1 : PureGrid_Rectangle\bottom = -1
If PureGrid_SelectingRectangle <> #Inactive
PaintPureGrid(1)
PureGrid_SelectingRectangle = #Inactive;
EndIf
;Call Zoom procedure.
PureGridZoom()
;Write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
EndSelect
Case #PB_EventGadget
Select EventGadgetID()
Case = #PureGrid_HScroll; Indicates that the horziontal scroll bar has been adjusted.
If PureGrid_Left <> GetGadgetState(#PureGrid_HScroll); Save some processing time by making this check.
;Write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
PureGrid_Left = GetGadgetState(#PureGrid_HScroll)
PaintPureGrid(0)
EndIf
Case = #PureGrid_VScroll; Indicates that the vertical scroll bar has been adjusted.
If PureGrid_Top <> GetGadgetState(#PureGrid_VScroll); Save some processing time by making this check.
;Write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
PureGrid_Top = GetGadgetState(#PureGrid_VScroll)
PaintPureGrid(0)
EndIf
EndSelect
Default
EndSelect
Until EventID=#PB_EventCloseWindow
;Write data back to the data array if it has changed.
PureGridWriteDataFromCell(PureGrid_x, PureGrid_y)
;Delete the rosources given over to the two brushes.
DeleteObject_(BlackBrush)
DeleteObject_(WhiteBrush)
EndProcedure
;The following callback procedure intercepts the drawing of each string gadget.
;This makes it possible to highlight any selected gadgets.
Procedure WindowCallBack(WindowID,Message,wParam,lParam)
ReturnValue=#PB_ProcessPureBasicEvents
If Message=#WM_CTLCOLOREDIT; This indicates that one of the string gadgets is about to be drawn.
;We first need to identify which string gadget is being drawn.
For LoopRow = 1 To PureGrid_DisplayedRows
For LoopColumn = 1 To PureGrid_DisplayedColumns
If lParam = GadgetID(#PureGrid_StringBase + (LoopRow)*(PureGrid_DisplayedColumns+1) + LoopColumn)
Break 2; Break out of the 2 loops.
EndIf
Next LoopColumn
Next LoopRow
;(LoopRow, LoopColumn) identifies the string gadget being drawn.
;Now check if the string gadget is within a selected region.
SetBkMode_(wParam,#OPAQUE)
If (PureGrid_Rectangle\right <>-1) And ((LoopColumn + PureGrid_Left-1) >= PureGrid_Rectangle\left) And ((LoopColumn + PureGrid_Left-1) <= PureGrid_Rectangle\right) And ((LoopRow + PureGrid_Top-1) >= PureGrid_Rectangle\top) And ((LoopRow + PureGrid_Top-1) <= PureGrid_Rectangle\bottom)
SetTextColor_(wParam,$ffffff)
SetBkColor_(wParam,$0000)
ReturnValue=BlackBrush
Else
SetBkColor_(wParam,$ffffff)
ReturnValue=WhiteBrush
EndIf
EndIf
ProcedureReturn ReturnValue
EndProcedure
Yes please, a flexible Table/Grid Gadget is needed!
I too am in desperate need for a flexible Table/Grid Gadget.
One that supports:
- Multiple selection modes: row, column, cell, all.
- In-line cell editing (like a spreadsheet).
- Header and column justification (left, right, center).
- Definable fonts on a per-column and/or row basis (including color.).
- Definable background color on a per-column and/or row basis.
- Column sorting.
- Multi-line text within a cell (word wrap).
- Dynamically add/remove columns.
- Set whether there are row and/or column grid lines (and colors?).
- Adjustable row height.
- # rows/columns only limited by system memory.
- CROSS-PLATFORM PLEASE!
I don't want much, do I?
Thanks!
One that supports:
- Multiple selection modes: row, column, cell, all.
- In-line cell editing (like a spreadsheet).
- Header and column justification (left, right, center).
- Definable fonts on a per-column and/or row basis (including color.).
- Definable background color on a per-column and/or row basis.
- Column sorting.
- Multi-line text within a cell (word wrap).
- Dynamically add/remove columns.
- Set whether there are row and/or column grid lines (and colors?).
- Adjustable row height.
- # rows/columns only limited by system memory.
- CROSS-PLATFORM PLEASE!
I don't want much, do I?
Thanks!
USCode,
Here's a professional grid (~ 50k) that you can use with PureBasic. Possibly Windows only (it's a DLL).
Works solidly with PowerBASIC. I haven't used it much with PureBasic, but as you can see there is an include file for Pure.
http://www.softwareinnovators.com/default.php
--blueb
Here's a professional grid (~ 50k) that you can use with PureBasic. Possibly Windows only (it's a DLL).
Works solidly with PowerBASIC. I haven't used it much with PureBasic, but as you can see there is an include file for Pure.
http://www.softwareinnovators.com/default.php
--blueb
SI Grid - not cross-platform
Thanks blueb, that's a nice grid but I want one that will also work with Linux and in the future, Mac OS X. This is only a Windows DLL.
-
- Enthusiast
- Posts: 767
- Joined: Sat Jan 24, 2004 6:56 pm
Yes, -I'm afraid it will not run on Linux!do you know whether this code would run on Linux as well?
It uses a few (not too many mind) Win-Api calls. Most of them could easily be removed but a couple will remain; e.g. the setting of the gadget background colours - used when highlighting cells. I don't know how to achieve this without using the API.
I'm about to start work on a new 'grid' which will have many more features and 'should' be platform independent. Should start work today.
I may look like a mule, but I'm not a complete ass.