;/ =================================== ;/ = GridExModule [PB 5.6x] = ;/ =================================== ;/ ;/ Extended Grid Gadget ;/ ( editing, formatting, marking cells / calculations / sorting / different cell types / ... ) ;/ ;/ based on 'MyGrid' by 'said' (11/2017) ;/ ;/ Module by Thorsten1867 (10/2017) ;/ #Example = 1 ; Example 1: Sort & Formatting & Marking / Example 2: Grid Functions ; TODO: Load/Save Grid ; --------------------------- ; Last Update: 24.11.2017 ; --------------------------- ;{ ----- Modifications ------ ; BugFix: Scrollbars ; Changed: All elements (Canvas/Scrollbar...) are now in a container ; Added: Frames for Grid (#Border_Flat/#Border_Raised/#Border_Single/#Border_Double) ; Changed: Array gData.s(0) --> Map Grid.GridEx_Structure() [for sort functions] ; Added: Set/Get Data for grid gadget and for grid rows ; Added: Sorting by clicking on the Column header with flags for the Column header (#Integer/#Float/#Date/#Time/#Cash) ; Added: German sorting rules (lexicon/phone book) ; Added: Multiple sorting of rows (e. g. name & first name & gender) ; Added: User-defined multiple sorting. Selectable by the assigned name. ; Added: Multiple sorting for column header click ; Added: Formatting the display of cell contents (#Integer/#Float/#Date/#Time/#Cash) ; Added: Mark the contents of the cell in color if the condition applies (Negative/Positive/Equal/Compare/Like) ; Added: Adding calculations to cells (Sum/Count/Average/Min/Max/...) ; Added: GetSelectedCells(GID.i, Array Cells.s(2)) ; Added: Autocomplete for editable cells (#AutoComplete) ; Added: Load/Save Grid size & rows height and colums width ; Added: Sort arrows for column header ; Added: Editable ComboBox (enter text or select from list) (#Combo|#Edit) ; Added: CellTyp automatically sets appropriate formatting ; Added: Image as cell content (#Image) ; Added: Additional colored lines (e.g. for calculation row) ; Added: Additional colored frames for single cells ; Added: Checking the validity of entries for editable cells (#Check) => colored border & background ; Added: GetSelection(), to use selected cells for external procedures (e.g. merge cells) ; Added: Copy selected cells to/from ClipBoard (CSV or Tabulator) ; Changed: Completely new event management ; Added: Allow or forbid to change the size of the column and row (whole grid or single rows and columns). ; Added: Themes for grid (e.g. header colors ...) ; Added: Accept only valid entries for editable cells (#Valid) ; Added: Cell type grades (DE/AT/GB/US/FR/ES/IT) ; Added: Update calculations if a cell has been edited with the #Update flag ; Changed: Changed font and image management ; Added: Ctrl - MouseClick / Shift - MouseClick --> Copy & Paste selected rows ;} -------------------------- ;{ ----- GridEx Commands ----- ; GridEx::AddCellTerm() ; Add a term for calculation to the cell ; GridEx::AddComboItems() ; Adding elements to a ComboBox ; GridEx::AddListItems() ; List of words for autocomplete ; GridEx::AddRow() ; Similar to AddGadgetItem() ; GridEx::AttachPopup() ; Assign popup menu to a cell ; GridEx::AllowColumnResize() ; Allow to resize the column ; GridEx::AllowMouseResize() ; Allow to resize columns and rows ; GridEx::AllowRowResize() ; Allow to resize the row ; GridEx::AutoColumnWidth() ; Set automatic Column width ; GridEx::AutoRowHeight() ; Set automatic row height ; GridEx::ClearCells() ; Clear all cells ; GridEx::ClearMultiSort() ; Remove multiple sorting definition ; GridEx::ClearSelectedCells() ; Clear selected cells ; GridEx::CopyToClipboard() ; Copy selected cells to clipboard (CSV) ; GridEx::DateInputFormat() ; Change input format (mask) for cells with date ; GridEx::DefineMultiSort() ; Define multiple sorting (e.g. Column "Name" & Column "First name") ; GridEx::DefineSortRows() ; Specify the first and last rows for sorting. ; GridEx::DeleteRow() ; Delete grid row ; GridEx::DisableRedraw() ; Disables redrawing to make several changes to the grid ; GridEx::ExportFileCSV() ; Export Grid to CVS file ; GridEx::FormatCells() ; Set cell formatting [#Integer/#Float/#Date/#Time/#Cash] ; GridEx::Free() ; Free the gadget ; GridEx::FreezeColumn() ; Freeze Column ; GridEx::FreezeRow() ; Freeze Row ; GridEx::Gadget() ; Similar to ListIconGadget() ; GridEx::GetAttribute() ; Query information about the grid ; GridEx::GetCellText() ; Similar to GetGadgetItemText() ; GridEx::GetColor() ; Get grid colors [#FrontColor/#BackColor/#LineColor/#FocusBorder/#BlockBack/#LabelBorder] ; GridEx::GetColumnFlags() ; Get Column type [#String/#Integer/#Float/#Date/#Time/#Cash/] ; GridEx::GetGridData() ; Similar to GetGadgetData() ; GridEx::GetRowData() ; Similar to GetGadgetItemData() ; GridEx::GetRowText() ; Get the text of all columns in a row with separators ; GridEx::GetSelectedCells() ; Insert the contents of the selected cells into the Array Cells(row, col) -> Result: #Area/#Rows ; GridEx::GetSelectedRows() ; Insert the contents of the selected rows (Crtl-Click) into the Array Cells(row, col) ; GridEx::GetSelection() ; Get selection => Area\Row\First, Area\Col\Last, ... ; GridEx::Hide() ; Hide GrideEx gadget ; GridEx::HideColumn() ; Hide selected Column ; GridEx::HideRow() ; Hide selected row ; GridEx::ImportFileCSV() ; Import CSV file in grid ; GridEx::IsSelected() ; Verify that the cell is selected ; GridEx::IsValidCell() ; Check if it is a valid cell ; GridEx::LastCellText() ; Last changed text ; GridEx::LoadThemes() ; Load user themes ; GridEx::MarkCells() ; Mark the contents of the cell in color if the condition applies [#Negativ/#Positiv/#Zero/#Equal/#Less/#Greater/#Like/#Between/#Beyond] ; GridEx::MergeCells() ; Merge cells ; GridEx::MultiSortGridRows() ; Perform defined multiple sorting ; GridEx::PasteFromClipboard() ; Paste CSV data from the clipboard into the selected cells ; GridEx::ReDefine() ; Change the numbers of rows (& columns) ; GridEx::Refresh() ; Redraw grid ; GridEx::RemoveCellFlags() ; Remove individual flags with cell properties from the cell. (e.g. at #AnyRow/#AnyCol) ; GridEx::RemoveSelection() ; Remove the selection ; GridEx::RemoveTerm() ; Remove the calculation for this cell ; GridEx::ResetCells() ; Removes all cell properties ; GridEx::Resize() ; Resize grid ; GridEx::ResizeHandler() ; Automatic resize (#PB_Event_SizeWindow) ; GridEx::Save() ; GridEx::SaveGridSize() ; Saves columns width and rows height of the grid ; GridEx::SaveThemes() ; Save user added themes ; GridEx::SelectAll() ; Select all cells ; GridEx::SelectCells() ; Select a cell range ; GridEx::SetCellAlign() ; Set cell alignment [#Left/#Center/#Right] ; GridEx::SetCellCheck() ; Checking cell content for validity (e.g. for editing) ; GridEx::SetCellColor() ; Set cell colors [#FrontColor/#BackColor/#MarkColor/#Gradient] ; GridEx::SetCellEditMode() ; Set edit mode [#Over/#Append] ; GridEx::SetCellFlags() ; Set flags for cell properties (without cell type presets) ; GridEx::SetCellFont() ; Set cell font ; GridEx::SetCellFrame() ; Add a additional colored frame to cell ; GridEx::SetCellImage() ; Add a image to the cell ; GridEx::SetCellLanguage() ; Set language for foreign month names or grades ; GridEx::SetCellText() ; Similar to SetGadgetItemText() ; GridEx::SetCellType() ; Set flags for cell properties with default settings for different cell types (#Integer/#Float/#Cash/#Date/#Time/#Grades) ; GridEx::SetColor() ; Set grid colors ; GridEx::SetColumnWidth() ; Change Column width ; GridEx::SetDateFormat() ; Define the mask for date formatting (%dd/%0d/%mm/%MM/%yy/%yyyy) ; GridEx::SetFont() ; Change default font for grid ; GridEx::SetGridData() ; Similar to SetGadgetData() ; GridEx::SetGridLine() ; Add a additional colored line (e.g. for calculation row) ; GridEx::SetHeaderSort() ; Set column header flag for sort [#String/#Integer/#Float/#Cash/#Date/#Time/#Default] ; GridEx::SetHeaderStyle() ; Defining the header look ; GridEx::SetLanguage() ; Set language for month names ; GridEx::SetMultiSortColumn() ; Set multisort for Column and the name of the corresponding definition ; GridEx::SetNumberFormat() ; Define decimal point and thousand separators ; GridEx::SetRowData() ; Similar to SetGadgetItemData() ; GridEx::SetRowHeight() ; Change row height ; GridEx::SetRowText() ; Set the text for all columns of a row ; GridEx::SetSortColumnMarker() ; Marking for sorted column by header click ; GridEx::SetTheme() ; Select color theme for grid ; GridEx::SetTimeFormat() ; Define the mask for time formatting (%hh/%ii/%ss) ; GridEx::SetTopColumn() ; Make this Column the front Column ; GridEx::SetTopRow() ; Make this row the top row ; GridEx::ShowCell() ; Set the focus on this cell ; GridEx::SortGridRows() ; Sorts the rows of the grid according to the selected Column ; GridEx::TimeInputFormat() ; Change input format (mask) for cells with time ; GridEx::UnMergeCells() ; Canceling the merging of cells ; GridEx::UpdateCalculations() ; Update the calculations in the cells ; GridEx::UseImageDecoder() ; Loads the imaged decoder plugin to show images ;} --------------------------- DeclareModule GridEx ; ===== Country specific adjustments ================== #DefaultLanguage = "DE" ; DE / AT / GB / US / FR / ES / IT #DefaultDateMask = "%dd.%mm.%yyyy" ; is required to evaluate date #DefaultTimeMask = "%hh:%ii:%ss" ; is required to evaluate time #DefaultCurrency = "€" #DecimalPoint = "," #ThousandSeparator = "." ; ===================================================== ;{ ----- Constants ----- #Area = 1 #Rows = 2 #Ascending = 0 ; [0] #PB_Sort_Ascending EnumerationBinary ;{ CellFlags ; Definition #Format ; [1] #PB_Sort_Descending #Edit ; [2] #PB_Sort_NoCase #Sort #Calc #Mark #Check #Valid #AutoComplete ; CellType #Cell #Checkbox #Button #Combo #Image ; CellData #Cash #Float #Integer #Date #Time #String #Grades ; Extra #Resize #Frame #NoFrame #NoEdit #NoResize #NoMark #NoCheck #Update #NoUpdate EndEnumeration ;} Enumeration 1 ; Edit modes ; in both modes: Double-Click and Enter will open editing with append, Esc/click away will exit #Over #Append EndEnumeration Enumeration ; Cell alignment #Left = 0 ; [0] #Center = 1 ; [1] #PB_Text_Center #Right = 2 ; [2] #PB_Text_Right #Align_Fit = 3 ; only for images EndEnumeration Enumeration ; Cell color #FrontColor = 1 ; [1] #PB_Gadget_FrontColor #BackColor = 2 ; [2] #PB_Gadget_BackColor (grey area color) #LineColor = 3 ; [3] #PB_Gadget_LineColor (grid line color) #FocusBack = 4 ; (while editing text cells) #FocusBorder = 5 #LabelBorder = 6 #BlockBack = 7 ; (block highlight) #MarkColor = 8 ; e.g. negative numbers #ErrorBack = 9 #Gradient = 10 EndEnumeration EnumerationBinary ; Sort grid rows #Descending ; [1] #PB_Sort_Descending #NoCase ; [2] #PB_Sort_NoCase #Default #MultiSort #Standard #Namen #Lexikon #NoFlag ; ----- ;#String ;#Integer ;#Float ;#Date ;#Time ;#Cash EndEnumeration EnumerationBinary ; MarkColSort #Arrow #Font #Color EndEnumeration Enumeration ; Format #FullDate = 1 #Day = 2 #Month = 3 #Year = 4 #FullTime = 1 #Hour = 2 #Minute = 3 #Second = 4 EndEnumeration EnumerationBinary ; Grid #NoHeader #Labels #ClipBoard #Semicolon #Comma #Tabulator #CSV #Window #Grid EndEnumeration Enumeration ; Lines ; #Left = 0 #Top = 1 ; #Right = 1<<1 #Bottom = 1<<2 #Vertical = 1<<3 #Horizontal = 1<<4 EndEnumeration #Thin = 1 #Thick = 2 Enumeration ; Grid #Header = 0 #Label = 0 #Column = 1 #Row = 2 #AnyCol = -1 #AnyRow = -1 EndEnumeration ; ContainerFlags #BorderLess = 0 ; #PB_Container_BorderLess EnumerationBinary #Border_Flat ; #PB_Container_Flat #Border_Raised ; #PB_Container_Raised #Border_Single ; #PB_Container_Single #Border_Double ; #PB_Container_Double #ScrollBars #NoScrollBars #DrawGrid #DoNotDraw EndEnumeration Enumeration 1 ; Attribute #CellType #CellData #CellAlign #CellFont #CellFormat #CellMark #CellCeck #CellValid #EditMode EndEnumeration Enumeration 1 ;{ Attribute #Attrib_Row ; row of current cell #Attrib_Col #Attrib_RowCount #Attrib_ColCount #Attrib_RowHeight #Attrib_ColWdith #Attrib_TopRow #Attrib_TopCol #Attrib_FrozenRow #Attrib_FrozenCol #Attrib_Block_Row2 #Attrib_Block_Col2 #Attrib_NonHiddenRow #Attrib_NonHiddenCol #Attrib_ChangedRow ; Cell where last change has occured via editing #Attrib_ChangedCol #Attrib_ClickedRow ; Cell where last click has occured #Attrib_ClickedCol #Attrib_GadgetRowScroll ; Gadget nbr of Row-Scroll - in case #Attrib_GadgetColScroll ; Gadget nbr of Column-Scroll EndEnumeration ;} ;{ Default for OS CompilerSelect #PB_Compiler_OS CompilerCase #PB_OS_Linux #Default_ColWidth = 60 #Default_RowHeight = 20 CompilerCase #PB_OS_MacOS #Default_ColWidth = 60 #Default_RowHeight = 24 CompilerDefault #Default_ColWidth = 60 #Default_RowHeight = 20 CompilerEndSelect ;} Enumeration #PB_Event_FirstCustomValue + 200 ; external events returned to caller application #Event_Change ; fired when cell content has changed from outside / #Property_ChangedRow and #Property_ChangedCol can be used to see what cell has changed #Event_Click ; fired when a button-cell received a full clikc / #Property_ClickedRow and #Property_ClickedCol can be used to see what cell has been clicked EndEnumeration #PB_ImagePlugin_GIF = 1 ;} --------------------- ;{ ----- Structures ------ Structure Cell_Select_Structure First.i Last.i EndStructure Structure Area_Select_Structure Row.Cell_Select_Structure Col.Cell_Select_Structure EndStructure ;} Global Dim Cells.s(0,0) Global NewList Rows.i() Global Area.Area_Select_Structure Declare AddCellTerm(GID.i, Row.i, Col.i, Term$, Flag.i=#Float) Declare AddListItems(GID.i, Row.i, Col.i, Items$, ItemSep.s=#LF$) Declare AddComboItems(GID.i, Row.i, Col.i, Items$, ItemSep.s=#LF$) Declare.i AddRow(GID.i, Value$="", Position.i=-1, ColSep$=#LF$) Declare AllowColumnResize(GID.i, Col.i, State.i=#True) Declare AllowMouseResize(GID.i, State.i=#True) Declare AllowRowResize(GID.i, Row.i, State.i=#True) Declare AttachPopup(GID.i, Popup.i) Declare.i AutoColumnWidth(GID.i, Col.i) Declare AutoRowHeight(GID.i, Row.i) Declare ClearCells(GID.i) Declare ClearMultiSort(GID.i, Name$) Declare ClearSelectedCells(GID.i) Declare CopyToClipboard(GID.i, Flags.i=#Tabulator) Declare SelectCells(GID.i, Row1.i, Col1.i, Row2.i, Col2.i) Declare DateInputFormat(GID.i, Mask$=#DefaultDateMask) Declare DefineMultiSort(GID.i, Name$, Col.i, SortLen.i, Flags.i=#False) Declare DefineSortRows(GID.i, First.i=#False, Last.i=#False) Declare DeleteRow(GID.i, Row.i) Declare DisableRedraw(GID.i, State=#True) Declare ExportFileCSV(GID.i, File$, Flags.i) Declare FormatCells(GID.i, Row.i, Col.i, CellType.i, Mask$="", Language$="", Digits.i=2) Declare Free(GID.i) Declare FreezeColumn(GID.i, Col.i) Declare FreezeRow(GID.i, Row.i) Declare.i Gadget(WinID.i, GadgetID.i, X.i, Y.i, Width.i, Height.i, Rows.i=#PB_Ignore, Cols.i=#PB_Ignore, Flags.i=#DrawGrid|#Border_Single|#ScrollBars) Declare.i GetAttribute(GID.i, Attribute.i=#Attrib_Row, RowOrCol.i = 0) Declare.i GetColor(GID.i, Attribute.i=#LineColor) Declare.i GetColumnFlags(GID.i, Col.i) Declare.s GetCellText(GID.i, Row.i, Col.i) Declare.i GetGridData(GID.i) Declare.i GetRowData(GID.i, Row.i) Declare.s GetRowText(GID.i, Row.i, ColSep$=#LF$) Declare GetSelectedCells(GID.i, Flags.i=#False) Declare GetSelection(GID.i) Declare Hide(GID.i, State=#False) Declare HideColumn(GID.i, Col.i, State) Declare HideRow(GID.i, Row.i, State) Declare ImportFileCSV(GID.i, File$, Flag.i=#False) Declare IsSelected(GID.i) Declare IsValidCell(GID.i, Row.i, Col.i) Declare.s LastCellText(GID.i) Declare LoadGridSize(Gid.i, File$="", Flags.i=#Grid) Declare LoadThemes(File$="") Declare MarkCells(GID.i, Row.i, Col.i, CellType.i, Term$, Color.i, Color2.i=#PB_Default) Declare.i MergeCells(GID.i, Row1.i, Col1.i, Row2.i, Col2.i) Declare MultiSortGridRows(GID.i, Name$, Flags.i=#Ascending|#NoCase) Declare PasteFromClipboard(GID.i) Declare ReDefine(GID.i, Rows.i, Cols.i=#False) Declare Refresh(GID.i) Declare RemoveCellFlags(GID.i, Row.i, Col.i, Flags.i) Declare RemoveSelection(GID.i) Declare RemoveTerm(GID.i, Row.i, Col.i) Declare ResetCells(GID.i) Declare Resize(GID.i, X.i, Y.i, Width.i, Height.i) Declare ResizeHandler(GID.i) Declare Save(GID.i, File$="") Declare SaveGridSize(Gid.i, File$="") Declare SaveThemes(File$="") Declare SelectAll(GID.i) Declare SelectCells(GID.i, Row1.i, Col1.i, Row2.i, Col2.i) Declare SetCellAlign(GID.i, Row.i, Col.i, Align.i) Declare SetCellCheck(GID.i, Row.i, Col.i) Declare SetCellColor(GID.i, Row.i, Col.i, ColorType.i, Color.i) Declare SetCellEditMode(GID.i, Row.i, Col.i, EditMode.i) Declare SetCellFlags(GID.i, Row.i, Col.i, Flags.i) Declare SetCellFont(GID.i, Row.i, Col.i, Name$, Size.i, Flags.i=#False) Declare SetCellFrame(GID.i, Row.i, Col.i, Color.i=$A9A9A9) Declare SetCellImage(GID.i, Row.i, Col.i, File$) Declare SetCellLanguage(GID.i, Row.i, Col.i, Language$="") Declare SetCellText(GID.i, Row.i, Col.i, Text$) Declare SetCellType(GID.i, Row.i, Col.i, Flags.i) Declare SetColor(GID.i, Attribute.i=#LineColor, Value.i=$CCCCCC) Declare SetColumnWidth(GID.i, Col.i, Width.i=#Default_ColWidth) Declare SetDateFormat(GID.i, Mask$=#DefaultDateMask) Declare SetFont(GID.i, Name$, Size.i, Flags.i=#False) Declare SetGridData(GID.i, Value.i) Declare SetGridLine(GID.i, Row.i, Col.i=#False, Last.i=#False, Flags.i=#Horizontal|#Top, Color.i=$D1AE93, Thickness.i=1) Declare SetHeaderSort(GID.i, Col.i, Value.i) Declare SetHeaderStyle(GID.i, FrontColor.i=$600000, BackColor.i=$F0D2BE, Border.i= $D1AE93 , Align.i=#Center) Declare SetLanguage(GID.i, Language.s=#DefaultLanguage) Declare SetMultiSortColumn(GID.i, Col.i, Name$) Declare SetNumberFormat(GID.i, ThousandSeparator.s, DecimalPoint.s, Digits.i=#False) Declare SetRowData(GID.i, Row.i, Value.i) Declare SetRowHeight(GID.i, Row.i, Height.i=#Default_RowHeight) Declare SetRowText(GID.i, Row.i, Value$, ColSep$=#LF$) Declare SetSortColumnMarker(GID.i, MarkType.i=#Arrow, Value.i=#PB_Default, Font$="Arial|8|256") Declare SetTheme(GID.i, Titel$) Declare SetTimeFormat(GID.i, Mask$=#DefaultTimeMask) Declare SetTopColumn(GID.i, TopCol.i) Declare SetTopRow(GID.i, TopRow.i) Declare ShowCell(GID.i, Row.i, Col.i, SetCellFocus=#False) Declare SortGridRows(GID.i, Col.i, Flags.i=#Ascending|#NoCase) Declare TimeInputFormat(GID.i, Mask$=#DefaultTimeMask) Declare UnMergeCells(GID.i, Row.i, Col.i) Declare UpdateCalculations(GID.i) Declare UseImageDecoder(Flag.i) EndDeclareModule Module GridEx EnableExplicit ;{ ----- Constants ----- #JSON = 1 #XML = 1 #File = 1 #Menu = 0 CompilerSelect #PB_Compiler_OS CompilerCase #PB_OS_Linux ;{ Linux Constants #Text_MarginX = 4 ; left/right margin in pixel #Text_MarginY = 2 ; left/right margin in pixel #RowSep_Margin = 6 #ColSep_Margin = 6 ; mouse-margin in pixel #Scroll_Width = 16 #Default_ColWidth = 60 #Default_RowHeight = 20 #CheckBox_Width = 16 #CheckBox_Color = $600000 ; square border color #Combo_Height = 80 ; height of listview associated with combo-cells ;} CompilerCase #PB_OS_MacOS ;{ MacOS Constants #Text_MarginX = 4 ; left/right margin in pixel #Text_MarginY = 2 ; left/right margin in pixel #RowSep_Margin = 4 #ColSep_Margin = 4 ; mouse-margin in pixel #Scroll_Width = 16 #Default_ColWidth = 60 #Default_RowHeight = 24 #CheckBox_Width = 16 #CheckBox_Color = $C95718 ; square border color #Combo_Height = 80 ;} CompilerDefault ;{ Windows Constants #Text_MarginX = 4 ; left/right margin in pixel #Text_MarginY = 2 ; left/right margin in pixel #RowSep_Margin = 6 #ColSep_Margin = 6 ; mouse-margin in pixel #Scroll_Width = 16 #Default_ColWidth = 60 #Default_RowHeight = 20 #CheckBox_Width = 16 ; 14, 16 #CheckBox_Color = $C95718 ; square border color #Combo_Height = 80 ;} CompilerEndSelect #ArrowWidth = 16 #NoResult = -1 #NoElement = -1 #Any = 0 #Scroll_Max = 10000 #Scroll_PageSize = 20 #Arrow_Width = 15 EnumerationBinary #Enter #Click #DoubleClick #Modify #Validate #Cancel EndEnumeration Enumeration #Key_Return #Key_Escape #Key_Left #Key_Right #Key_Up #Key_Down #Key_Tab EndEnumeration Enumeration MouseMove #MouseMove_Nothing ; just changing the cursor ... #MouseMove_Resize ; resizing Col/row #MouseMove_Select ; selecting a block EndEnumeration Enumeration Move #Move_Focus ; what to move #Move_TopRC #Move_Block EndEnumeration #Condition1 = 1 #Condition2 = 2 #Number = 1 #Points = 2 #Character = 3 ;} --------------------- ;{ ----- Structures ----- Structure Rectangle_Structure ; Retangle Type Structure X.i Y.i Width.i Height.i EndStructure Structure Months_Structure Map Name.s() Map Initials.s() EndStructure Structure Grades_Structure Flag.i ; #Number/#Character/#Points Best.i Worst.i Term.s Map Notation.s() EndStructure Structure Select_Area_Structure Row1.i Row2.i Col1.i Col2.i EndStructure Structure Calc_Var_Structure Float.f Integer.i String.s EndStructure Structure Calc_Term_Structure Type.s ; Calculation Type Expr.s ; Expression Array Operator.s(1) Map Cell.s() EndStructure ; --------------------------- Structure GridEx_Theme_Structure GridFront.i GridLine.i ; grid-line color GridBack.i ; grey-area color GridFont.s FocusBack.i ; background while editing cells FocusBorder.i ; border while editing cells HeaderFront.i HeaderBack.i HeaderBorder.i HeaderAlign.i HeaderFont.s BlockBack.i ; Block highlight Mistake.i EndStructure ; --------------------------- Structure Save_Cell_Structure Flags.i Style.i Calc.i Image.s Value.s EndStructure Structure Save_Entry_Structure RowData.i Array Cell.Save_Cell_Structure(1) EndStructure Structure Save_GridData_Structure Array Rows.Save_Cell_Structure(1) Array Cols.Save_Cell_Structure(1) Array Entry.Save_Entry_Structure(1) EndStructure ; --------------------------- Structure Grid_Size_Structure ; Grid()\Size\... X.i Y.i Width.i Height.i EndStructure Structure Export_Size_Structure ; Save / Export Win.Grid_Size_Structure Grid.Grid_Size_Structure Array Rows.i(1) Array Cols.i(1) EndStructure ; =============================== ;{ ----- Grid()\... --------------------------- Structure Grid_Calc_Structure ; Grid()\Calc()\... Flag.i ; #String/#Integer/#Float/#Date/#Time/#Cash/#Grades Row.i Col.i Term.s EndStructure Structure Grid_Image_Structure ; Grid()\Image()\... ID.i File.s EndStructure Structure Grid_Format_Structure ; Grid()\Format\... Font.s FontBold.s Language.s Currency.s ParseDate.s DateSeperator.s DefaultDate.s ParseTime.s TimeSeperator.s DefaultTime.s Digits.i DefaultFloat.s DecimalPoint.s ThousandSeparator.s EndStructure Structure Grid_Color_Structure ; Grid()\Color\... GridFront.i GridLine.i ; grid-line color GridBack.i ; grey-area color FocusBack.i ; background while editing cells FocusBorder.i ; border while editing cells LabelBorder.i BlockBack.i ; block highlight Mistake.i EndStructure Structure Grid_Style_Structure ; Grid()\Style()\... Font.s Language.s ; Language for month names and grades MarkTerm.s ; Condition for highlighting FormatMask.s ; Mask for formatting date or time Map Value.i() ; Settings by name e.g. "Align" List Items.s() ; Items when celltype is a combo EndStructure ; --------------------------- Structure Grid_Edit_Structure Flag.i Row.i Col.i X.i Y.i Width.i Height.f Mode.i Lng.s Wrong.i WordList.i ; #True/False List Words.s() EndStructure Structure Grid_List_Structure Row.i Col.i X.i Y.i Width.i Height.i EndStructure ; --------------------------- Structure Grid_Header_Structure ; Grid()\Header\... Rows.i Cols.i Width.i Height.i EndStructure Structure Grid_Block_Structure ; Grid()\Block\... ; Block ... one block only ; Block starts in (Row, Col) and ends in cell (Row2, Col2) / end cell can be above/before start cell ! X.i Y.i Row1.i Row2.i Col1.i Col2.i Width.i Height.i EndStructure Structure Grid_MultiCell_Structure ; Grid()\MultiCellList()\... Row1.i Col1.i Row2.i Col2.i EndStructure Structure Grid_Cell_Structure ; Grid()\Cell\... LastCol.i ; last changed cell (Col) via user-editing LastRow.i ; last changed cell (row) via user-editing LastText.s ; last-changed cell previous text ClickedCol.i ; last clicked cell (Col) via user-editing ClickedRow.i ; last clicked cell (row) via user-editing Map Selected.i() EndStructure Structure Grid_Mouse_Structure ; Grid()\Mouse\... DeltaX.i ; will be used to relativise absolute X,Y DeltaY.i DownX.i DownY.i MoveStatus.i ; what the mouse-move is doing right now DownAreaRow.i DownAreaCol.i EndStructure ; --------------------------- Structure Grid_Gadget_Structure ; Grid()\Header\... Container.i Canvas.i String.i ListView.i VScroll.i HScroll.i PopupMenu.i EndStructure ; --------------------------- Structure Cell_Structure Flags.i ; #Cell/#Checkbox/#Button/#Combo & #String/#Integer/#Float/#Date/#Time/#Cash/#Grades & .... Style.i ; ListIndex of Grid()\Cell() Calc.i ; ListIndex of Grid()\Calc() Image.s ; Filename of image Value.s ; Content of the cell EndStructure ;} ;{ ----- Grid()\Lines\... --------------------- Structure Lines_Structure First.i Last.i Color.i Thickness.i EndStructure Structure Grid_Lines_Structure Map Top.Lines_Structure() ; Cells with line at the top Map Bottom.Lines_Structure() ; Cells with line at the bottom Map Left.Lines_Structure() ; Cells with line at the left border Map Right.Lines_Structure() ; Cells with line at the right border EndStructure ;} ;{ ----- Grid()\Sort\... ---------------------- Structure Sort_Order_Structure ; Grid()\Sort\Multi(name$)\Order(nr$)\... Col.i Type.i SortLen.i EndStructure Structure Grid_MultiSort_Structure ; Grid()\Sort\Multi(name$)\... Map Order.Sort_Order_Structure() EndStructure Structure Grid_Sort_Structure ; Grid()\Sort\... Flag.i ; #Font / #Color / #Arrow Column.i Font.s Color.i Direction.i Map Multi.Grid_MultiSort_Structure() EndStructure ;} ;{ ----- Grid()\Col\... ----------------------- Structure Col_AreaList_Structure ; Grid()\Col\AreaList()\... ; Areas are dynamic depends on width of shown-columns and height of shown-rows X.i ; Area of the canvas gadget that can receive events Width.i ; actual drawn width AreaCol.i ; related Col >= 0 EndStructure Structure Grid_Col_Structure ; Grid()\Col\... Number.i ; Number of columns Current.i ; Current Cell TopCell.i ; (Row, Col) of Cell shown in Area(1,1) FirstTop.i FirstVisible.i LastTop.i LastVisible.i LastFrozen.i ; Last fixed Col - cant scroll ScrollMin.i ; Min-State for scrollbar ColScroll ScrollMax.i ; Max-State for scrollbar ColScroll StateFactor.f ; CurTop = Factor * State List AreaList.Col_AreaList_Structure() ; List of all defined Col-screen-areas EndStructure ;} ;{ ----- Grid()\Row\... ----------------------- Structure Row_AreaList_Structure ; Grid()\Row\AreaList()\... ; Areas are dynamic depends on width of shown-columns/And height of shown-rows Y.i ; Area of the canvas gadget that can receive events Height.i ; actual drawn height AreaRow.i ; related row >= 0 EndStructure Structure Grid_Row_Structure ; Grid()\Row\... Number.i ; number of rows Current.i ; Current Cell TopCell.i ; (Row, Col) of cell shown in Area(1,1) FirstTop.i FirstVisible.i FirstSelected.i ; First selected row for Shift-MouseClick LastTop.i LastVisible.i LastFrozen.i ; Last fixed row - cant scroll StartSort.i EndSort.i ScrollMin.i ; Min-State for scrollbar RowScroll ScrollMax.i ; Max-State for scrollbar RowScroll StateFactor.f Map Selected.i() List AreaList.Row_AreaList_Structure() ; List of all defined row-screen-areas EndStructure ;} ;{ ----- Grid()\Cols(col)\... ----------------- Structure Grid_Cols_Structure ; Grid()\Cols(col)\... Area.i Resize.i Width.i SortFlags.i SortMulti.s Header.Cell_Structure EndStructure ;} ;{ ----- Grid()\Rows(row)\... ----------------- Structure Grid_Rows_Structure ; Grid()\Rows(row)\... Area.i Resize.i Height.i Header.Cell_Structure EndStructure ;} ;{ ----- Grid()\Entry(row)\Cell(col)\... ------ Structure Grid_Entry_Structure ; Grid()\Entry(row)\... RowData.i SortPos.i SortStrg.s SortInt.i SortFloat.f Array Cell.Cell_Structure(1) EndStructure ;} ;{ ===== Grid(#gadget)\... ==================== Structure GridEx_Structure GridData.i WinID.i ; Window number containing the grid (active) ; --------------------------- ScrollBars.i ; ScrollBars enabled (#True/#False) WrapText.i MouseResize.i ; Resizing of rows/columns allowed (#True/#False) NoRedraw.i ; Stop continuous redrawing (#True/#False) ; --------------------------- GId.Grid_Gadget_Structure ; Gadgets Numbers/IDs ; --------------------------- Window.Grid_Size_Structure ; Size of parent Window Size.Grid_Size_Structure ; Size of Canvas Gadget Header.Grid_Header_Structure ; Size of Header (Rows/Cols) Block.Grid_Block_Structure ; --------------------------- EditVisible.i ; String gadget visible (#True/#False) EditStrg.Grid_Edit_Structure ListVisible.i ; ListView gadget visible (#True/#False) ListView.Grid_List_Structure ; --------------------------- Row.Grid_Row_Structure Col.Grid_Col_Structure Cell.Grid_Cell_Structure Mouse.Grid_Mouse_Structure ; --------------------------- Sort.Grid_Sort_Structure Color.Grid_Color_Structure Format.Grid_Format_Structure Lines.Grid_Lines_Structure ; --------------------------- Map Image.Grid_Image_Structure() ; Grid()\Image("filename")\'imageID' Map Font.i() ; Grid()\Font("Name|Size|Flag")\'fontID' List Calc.Grid_Calc_Structure() ; ------------------- List Style.Grid_Style_Structure() List MultiCellList.Grid_MultiCell_Structure() ; MultiCellList (cell span / merged cells) ; ------------------- Array Cols.Grid_Cols_Structure(1) Array Rows.Grid_Rows_Structure(1) Array Entry.Grid_Entry_Structure(1) EndStructure ;} ;} ------------------------------------------------- Global NewMap Grid.GridEx_Structure() Global NewMap Theme.GridEx_Theme_Structure() Global NewMap Months.Months_Structure() Global NewMap Grades.Grades_Structure() ;----------------------------------------------------------------------------- ;- Internal - Validation ;----------------------------------------------------------------------------- Procedure _IsValidRow(GID.i, Row.i) If Row >= 0 And Row <= Grid(Str(GID))\Row\Number ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _IsValidCol(GID.i, Col.i) If Col >= 0 And Col <= Grid(Str(GID))\Col\Number ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _IsValidGenericRow(GID.i, Row.i) If (Row >= 0 And Row <= Grid(Str(GID))\Row\Number) Or Row = #AnyRow ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _IsValidGenericCol(GID.i, Col.i) If (Col >= 0 And Col <= Grid(Str(GID))\Col\Number) Or Col = #AnyCol ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _IsValidCell(GID.i, Row.i, Col.i) Define gid$ = Str(GID) If Row >= 0 And Row <= Grid(gid$)\Row\Number And Col >= 0 And Col <= Grid(gid$)\Col\Number ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _IsNumber(String$) Define.i c String$ = Trim(String$) If String$ = "" : ProcedureReturn #False : EndIf For c=1 To Len(String$) Select Asc(Mid(String$, c, 1)) Case 48 To 57 Continue Case 45, 46 Continue Case Asc(#DecimalPoint) Continue Default ProcedureReturn #False EndSelect Next If CountString(String$, #DecimalPoint) > 1 Or CountString(String$, "-") > 1 ProcedureReturn #False EndIf ProcedureReturn #True EndProcedure Procedure _IsHeaderRow(GID.i, Row.i) If FindMapElement(Grid(), Str(GID)) If Row >= 0 And Row < Grid()\Header\Rows ProcedureReturn #True EndIf EndIf EndProcedure Procedure _IsDataRow(GID.i, Row.i) If FindMapElement(Grid(), Str(GID)) If Row >= Grid()\Header\Rows And Row <= Grid()\Row\Number ProcedureReturn #True EndIf EndIf EndProcedure Procedure _IsDataCol(GID.i, Col.i) If FindMapElement(Grid(), Str(GID)) If Col >= Grid()\Header\Cols And Col <= Grid()\Col\Number ProcedureReturn #True EndIf EndIf EndProcedure Procedure _IsHeaderCol(GID.i, Col.i) If Col >= 0 And Col < Grid(Str(GID))\Header\Cols ProcedureReturn #True EndIf EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Flags ;----------------------------------------------------------------------------- Procedure.i CombineCellFlags(GID.i, Row.i, Col.i, Flag.i) Define CellFlags.i, gid$ = Str(GID) CellFlags = Grid(gid$)\Entry(Row)\Cell(Col)\Flags ;{ Definition If Flag & #Format : CellFlags | #Format : EndIf If Flag & #Edit CellFlags & ~#Calc CellFlags | #Edit ElseIf Flag & #Calc CellFlags & ~#Edit CellFlags | #Calc EndIf If Flag & #Sort : CellFlags | #Sort : EndIf If Flag & #Mark : CellFlags | #Mark : EndIf If Flag & #Check : CellFlags | #Check : EndIf If Flag & #Valid : CellFlags | #Valid : EndIf If Flag & #Frame : CellFlags | #Frame : EndIf If Flag & #Update : CellFlags | #Update : EndIf ;} ;{ CellType If Flag & #Cell CellFlags & ~#Checkbox CellFlags & ~#Button CellFlags & ~#Combo CellFlags & ~#Image CellFlags | #Cell ElseIf Flag & #Checkbox CellFlags & ~#Cell CellFlags & ~#Button CellFlags & ~#Combo CellFlags & ~#Image CellFlags | #Checkbox ElseIf Flag & #Button CellFlags & ~#Cell CellFlags & ~#Checkbox CellFlags & ~#Combo CellFlags & ~#Image CellFlags | #Button ElseIf Flag & #Combo CellFlags & ~#Cell CellFlags & ~#Checkbox CellFlags & ~#Button CellFlags & ~#Image CellFlags | #Combo ElseIf Flag & #Image CellFlags & ~#Cell CellFlags & ~#Checkbox CellFlags & ~#Button CellFlags & ~#Combo CellFlags | #Image EndIf ;} ;{ CellData If Flag & #String CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #String ElseIf Flag & #Integer CellFlags & ~#String CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Integer ElseIf Flag & #Float CellFlags & ~#Integer CellFlags & ~#String CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Float ElseIf Flag & #Cash CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#String CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Cash ElseIf Flag & #Date CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#String CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Date ElseIf Flag & #Time CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#String CellFlags & ~#Grades CellFlags | #Time ElseIf Flag & #Grades CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#String CellFlags & ~#Time CellFlags | #Grades EndIf ;} ;{ Remove If Flag & #NoEdit : CellFlags & ~#Edit : EndIf If Flag & #NoCheck : CellFlags & ~#Check : EndIf If Flag & #NoFrame : CellFlags & ~#Frame : EndIf If Flag & #NoMark : CellFlags & ~#Mark : EndIf If Flag & #NoUpdate : CellFlags & ~#Update : EndIf ;} ProcedureReturn CellFlags EndProcedure Procedure IsCellFlag(GID.i, Row.i, Col.i, Flag.i) Define Flags.i If FindMapElement(Grid(), Str(GID)) If _IsValidCell(GID, Row, Col) = #False : ProcedureReturn #False : EndIf If Row = #Header ProcedureReturn Grid()\Cols(Col)\Header\Flags ElseIf Col = #Header ProcedureReturn Grid()\Rows(Row)\Header\Flags Else Flags = Grid()\Entry(Row)\Cell(Col)\Flags If Row > #Header And Grid()\Entry(Row)\Cell(#Any)\Flags > 0 Flags = CombineCellFlags(GID, Row, #Any, Flags) EndIf If Col > #Header And Grid()\Entry(#Any)\Cell(Col)\Flags > 0 Flags = CombineCellFlags(GID, #Any, Col, Flags) EndIf If Flags & Flag : ProcedureReturn #True : EndIf EndIf EndIf ProcedureReturn #False EndProcedure Procedure AddCellFlag(GID.i, Row.i, Col.i, Flag.i) Define CellFlags.i If IsValidCell(GID, Row, Col) If FindMapElement(Grid(), Str(GID)) CellFlags = Grid()\Entry(Row)\Cell(Col)\Flags ;{ Definition If Flag & #Format : CellFlags | #Format : EndIf If Flag & #Edit CellFlags & ~#Calc CellFlags & ~#NoEdit CellFlags | #Edit ElseIf Flag & #Calc CellFlags & ~#Edit CellFlags | #Calc EndIf If Flag & #Frame CellFlags & ~#NoFrame CellFlags | #Frame EndIf If Flag & #Mark CellFlags & ~#NoMark CellFlags | #Mark EndIf If Flag & #Check CellFlags & ~#NoCheck CellFlags | #Check EndIf If Flag & #Update CellFlags & ~#NoUpdate CellFlags | #Update EndIf If Flag & #Valid : CellFlags | #Valid : EndIf If Flag & #Sort : CellFlags | #Sort : EndIf ;} ;{ CellType If Flag & #Cell CellFlags & ~#Checkbox CellFlags & ~#Button CellFlags & ~#Combo CellFlags & ~#Image CellFlags | #Cell ElseIf Flag & #Checkbox CellFlags & ~#Cell CellFlags & ~#Button CellFlags & ~#Combo CellFlags & ~#Image CellFlags | #Checkbox ElseIf Flag & #Button CellFlags & ~#Cell CellFlags & ~#Checkbox CellFlags & ~#Combo CellFlags & ~#Image CellFlags | #Button ElseIf Flag & #Combo CellFlags & ~#Cell CellFlags & ~#Checkbox CellFlags & ~#Button CellFlags & ~#Image CellFlags | #Combo ElseIf Flag & #Image CellFlags & ~#Cell CellFlags & ~#Checkbox CellFlags & ~#Button CellFlags & ~#Combo CellFlags | #Image EndIf ;} ;{ CellData If Flag & #String CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #String ElseIf Flag & #Integer CellFlags & ~#String CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Integer ElseIf Flag & #Float CellFlags & ~#Integer CellFlags & ~#String CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Float ElseIf Flag & #Cash CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#String CellFlags & ~#Date CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Cash ElseIf Flag & #Date CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#String CellFlags & ~#Time CellFlags & ~#Grades CellFlags | #Date ElseIf Flag & #Time CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#String CellFlags & ~#Grades CellFlags | #Time ElseIf Flag & #Grades CellFlags & ~#Integer CellFlags & ~#Float CellFlags & ~#Cash CellFlags & ~#Date CellFlags & ~#String CellFlags & ~#Time CellFlags | #Grades EndIf ;} ;{ Remove If Flag & #NoEdit : CellFlags & ~#Edit : EndIf If Flag & #NoCheck : CellFlags & ~#Check : EndIf If Flag & #NoFrame : CellFlags & ~#Frame : EndIf If Flag & #NoMark : CellFlags & ~#Mark : EndIf If Flag & #NoUpdate : CellFlags & ~#Update : EndIf If Row > 0 And Col > 0 If Flag & #NoEdit : CellFlags | #NoEdit : EndIf If Flag & #NoCheck : CellFlags | #NoCheck : EndIf If Flag & #NoFrame : CellFlags | #NoFrame : EndIf If Flag & #NoMark : CellFlags | #NoMark : EndIf If Flag & #NoUpdate : CellFlags | #NoUpdate : EndIf EndIf ;} Grid()\Entry(Row)\Cell(Col)\Flags = CellFlags EndIf EndIf EndProcedure Procedure GetCellFlags(GID.i, Row.i, Col.i) Define CellFlags.i, Flags.i If IsValidCell(GID, Row, Col) = #False : ProcedureReturn #False : EndIf If FindMapElement(Grid(), Str(GID)) If Row = #Header ProcedureReturn Grid()\Cols(Col)\Header\Flags ElseIf Col = #Header ProcedureReturn Grid()\Rows(Row)\Header\Flags Else CellFlags = Grid()\Entry(Row)\Cell(Col)\Flags If Grid()\Entry(Row)\Cell(#Any)\Flags > 0 Flags = CombineCellFlags(GID, Row, #Any, CellFlags) EndIf If Grid()\Entry(#Any)\Cell(Col)\Flags > 0 Flags = CombineCellFlags(GID, #Any, Col, CellFlags) EndIf ProcedureReturn Flags EndIf EndIf EndProcedure Procedure.i GetColumnFlags(GID.i, Col.i) Define Flags.i If _IsValidCol(GID, Col) Flags = Grid(Str(GID))\Cols(Col)\SortFlags If Flags & #String ProcedureReturn Flags ElseIf Flags & #Integer ProcedureReturn Flags ElseIf Flags & #Float ProcedureReturn Flags ElseIf Flags & #Cash ProcedureReturn Flags ElseIf Flags & #Date ProcedureReturn Flags ElseIf Flags & #Time ProcedureReturn Flags ElseIf Flags & #Grades ProcedureReturn Flags ElseIf Flags & #MultiSort ProcedureReturn Flags ElseIf Flags & #Default ProcedureReturn Flags Else ProcedureReturn #NoFlag EndIf EndIf EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Reading and writing cells ;----------------------------------------------------------------------------- Procedure _SetRowText(GID.i, Row.i, Value$, ColSep$=#LF$) Define.i c, Count If FindMapElement(Grid(), Str(GID)) Count = CountString(Value$, ColSep$) + 1 If Row = #Header For c = 1 To Count Grid()\Cols(c)\Header\Value = StringField(Value$, c, ColSep$) Next Else For c = 1 To Count Grid()\Entry(Row)\Cell(c)\Value = StringField(Value$, c, ColSep$) Next EndIf EndIf EndProcedure Procedure.s _GetRowText(GID.i, Row.i, ColSep$=#LF$) Define gid$ = Str(GID), Row$, c.i If Row = #Header For c = 1 To Grid(gid$)\Col\Number Row$ + Grid(gid$)\Cols(c)\Header\Value + ColSep$ Next Else For c = 1 To Grid(gid$)\Col\Number Row$ + Grid(gid$)\Entry(Row)\Cell(c)\Value + ColSep$ Next EndIf ProcedureReturn RTrim(Row$, ColSep$) EndProcedure Procedure _SetCellText(GID.i, Row.i, Col.i, Value$) Define gid$ = Str(GID) If Row = 0 And IsCellFlag(GID, Row, Col, #Image) Grid(gid$)\Entry(0)\Cell(Col)\Value = Value$ ElseIf Row = #Header Grid(gid$)\Cols(Col)\Header\Value = Value$ ElseIf Col = #Header Grid(gid$)\Rows(Row)\Header\Value = Value$ Else Grid(gid$)\Entry(Row)\Cell(Col)\Value = Value$ EndIf EndProcedure Procedure.s _GetCellText(GID.i, Row.i, Col.i) Define gid$ = Str(GID) If Row = #Header ProcedureReturn Grid(gid$)\Cols(Col)\Header\Value ElseIf Col = #Header ProcedureReturn Grid(gid$)\Rows(Row)\Header\Value Else ProcedureReturn Grid(gid$)\Entry(Row)\Cell(Col)\Value EndIf EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Diverse procedures ;----------------------------------------------------------------------------- Procedure _ExtractTags(Text$, Left$, Right$, Array Items.s(1)) ; Extract string between tags Define.i i, Pos=1, idxL, idxR, Count Count = CountString(Text$, Left$) If Count = 0 : ProcedureReturn #False : EndIf Dim Items(Count-1) For i = 0 To Count -1 idxL = FindString(Text$, Left$, Pos) Pos = idxL + 1 idxR = FindString(Text$, Right$, Pos) Pos = idxR + 1 If idxL And idxR idxL + Len(Left$) Items(i) = Mid(Text$, idxL, idxR-idxL) EndIf Next If Items(Count-1) = "" : ReDim Items(Count-2) : EndIf ProcedureReturn ArraySize(Items()) EndProcedure Procedure.s _ExtractTag(Text$, Left$, Right$) Define.i idxL, idxR idxL = FindString(Text$, Left$, 1) idxR = FindString(Text$, Right$, idxL + 1) If idxL And idxR idxL + Len(Left$) ProcedureReturn Mid(Text$, idxL, idxR-idxL) EndIf EndProcedure Procedure.i _ExtractFields(Text$, CharSep$, List Split$()) Define.i Count, i Count = CountString(Text$, CharSep$) If Count For i=1 To Count+1 AddElement(Split$()) Split$() = StringField(Text$, i, CharSep$) Next Else AddElement(Split$()) Split$() = Text$ EndIf ProcedureReturn Count+1 EndProcedure Procedure.i _BlendColor(Color1.i, Color2.i, Scale.i=50) Define.i R1, G1, B1, R2, G2, B2 Define.f Blend = Scale / 100 R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1) R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2) ProcedureReturn RGB((R1*Blend) + (R2 * (1-Blend)), (G1*Blend) + (G2 * (1-Blend)), (B1*Blend) + (B2 * (1-Blend))) EndProcedure Procedure.i _PosTextToWidth(Text$, Width.i) ; Return under current Drawing, the left part of Text$ that has a TextWidth() <= Width Define.i txtWidth, w0, e0, e1, e = Len(Text$) Repeat txtWidth = TextWidth(Mid(Text$, e0+1, e-e0)) If (w0 + txtWidth) <= Width e0 = e : e = e1 : w0 = w0 + txtWidth ; e0 succeeded so far Else e1 = e ; e1 denotes last failure e = e0 + ((e-e0)/2) EndIf If e0 >= e : Break : EndIf ForEver ProcedureReturn e0 EndProcedure Procedure.s _GetMonthInitials(Month$, Language$) If FindMapElement(Months(), Language$) ProcedureReturn Months()\Initials(Month$) Else ProcedureReturn Months("GB")\Initials(Month$) EndIf EndProcedure Procedure.s _GetDateString(GID.i, Date$, Flag.i=#FullDate, Mask$="", Language$="") Define i.i, Day$, Month$, Year$, Sep$, Parse$, Mask$ If Date$ = "" : ProcedureReturn "" : EndIf If Language$ = "" : Language$ = Grid(Str(GID))\Format\Language : EndIf Parse$ = Grid(Str(GID))\Format\ParseDate Sep$ = Grid(Str(GID))\Format\DateSeperator For i=1 To 3 Select StringField(Parse$, i, Sep$) Case "%dd" Day$ = RSet(StringField(Date$, i, Sep$), 2, " ") Case "%mm" Month$ = RSet(StringField(Date$, i, Sep$), 2, "0") Case "%yy" Year$ = StringField(Date$, i, Sep$) If Len(Year$) = 2 : Year$ = "20" + Year$ : EndIf Case "%yyyy" Year$ = StringField(Date$, i, Sep$) If Len(Year$) = 2 : Year$ = "20" + Year$ : EndIf EndSelect Next If Mask$ = "" Mask$ = Grid(Str(GID))\Format\DefaultDate If Mask$ = "" : Mask$ = Parse$ : EndIf EndIf Select Flag Case #FullDate Date$ = ReplaceString(Mask$, "%0d", ReplaceString(Day$, " ", "0")) Date$ = ReplaceString(Date$, "%dd", Day$) Date$ = ReplaceString(Date$, "%MM", _GetMonthInitials(Month$, Language$)) Date$ = ReplaceString(Date$, "%mm", Month$) Date$ = ReplaceString(Date$, "%yyyy", Year$) Date$ = ReplaceString(Date$, "%yy", Right(Year$, 2)) ProcedureReturn Date$ Case #Day ProcedureReturn Day$ Case #Month ProcedureReturn Month$ Case #Year ProcedureReturn Year$ EndSelect ProcedureReturn Date$ EndProcedure Procedure.s _ConvertUSTime(Time$, Sep$=":") Define apm$, Second$, Hour.i apm$ = LCase(RemoveString(StringField(Time$, 2, " "), ".")) Time$ = ReplaceString(StringField(Time$, 1, " "), ".", " ") Hour = Val(StringField(Time$, 1, Sep$)) If CountString(apm$, "pm") = 1 Hour + 12 EndIf Second$ = StringField(Time$, 3, Sep$) If Trim(Second$) = "" ProcedureReturn Str(Hour) + Sep$ + StringField(Time$, 2, Sep$) Else ProcedureReturn Str(Hour) + Sep$ + StringField(Time$, 2, Sep$) + Sep$ + Second$ EndIf EndProcedure Procedure.s _GetTimeString(GID.i, Time$, Flag.i=#FullTime, Mask$="") Define i.i, Hour$, Minute$, Second$, Sep$, Parse$, Mask$ If Time$ = "" : ProcedureReturn "" : EndIf Parse$ = Grid(Str(GID))\Format\ParseTime Sep$ = Grid(Str(GID))\Format\TimeSeperator Time$ = _ConvertUSTime(Time$, Sep$) For i=1 To 3 Select StringField(Parse$, i, Sep$) Case "%hh" Hour$ = RSet(StringField(Time$, i, Sep$), 2, " ") Case "%ii" Minute$ = RSet(StringField(Time$, i, Sep$), 2, "0") Case "%ss" Second$ = RSet(StringField(Time$, i, Sep$), 2, "0") EndSelect Next If Mask$ = "" Mask$ = Grid(Str(GID))\Format\DefaultTime If Mask$ = "" : Mask$ = Parse$ : EndIf EndIf Select Flag Case #FullTime Time$ = ReplaceString(Mask$, "%0h", Hour$) Time$ = ReplaceString(Time$, "%hh", Hour$) Time$ = ReplaceString(Time$, "%ii", Minute$) Time$ = ReplaceString(Time$, "%ss", Second$) ProcedureReturn Time$ Case #Hour ProcedureReturn Hour$ Case #Minute ProcedureReturn Minute$ Case #Second ProcedureReturn Second$ EndSelect ProcedureReturn Time$ EndProcedure Procedure _CompareValues(GID, Value1$, Compare$, Value2$, Flag.i) Define Float.f, Integer.i, IsString.i = #False Select Flag Case #Date Value1$ = _GetDateString(GID, Value1$, #FullDate, "%yyyy%mm%0d") Value2$ = _GetDateString(GID, Value2$, #FullDate, "%yyyy%mm%0d") Flag = #Integer Case #Time Value1$ = _GetTimeString(GID, Value1$, #FullTime, "%0h%ii%ss") Value2$ = _GetTimeString(GID, Value2$, #FullTime, "%0h%ii%ss") Flag = #Integer EndSelect If _IsNumber(Value1$) = #False Or _IsNumber(Value2$) = #False Flag = #String EndIf Select Flag Case #Integer, #Grades ;{ Select Compare$ Case "=" If Val(Value1$) = Val(Value2$) : ProcedureReturn #True : EndIf Case "<" If Val(Value1$) < Val(Value2$) : ProcedureReturn #True : EndIf Case ">" If Val(Value1$) > Val(Value2$) : ProcedureReturn #True : EndIf Case ">=" If Val(Value1$) >= Val(Value2$) : ProcedureReturn #True : EndIf Case "<=" If Val(Value1$) <= Val(Value2$) : ProcedureReturn #True : EndIf Case "<>" If Val(Value1$) <> Val(Value2$) : ProcedureReturn #True : EndIf EndSelect ;} Case #Float, #Cash ;{ Value1$ = ReplaceString(Value1$, #DecimalPoint, ".") Value2$ = ReplaceString(Value2$, #DecimalPoint, ".") Select Compare$ Case "=" If ValF(Value1$) = ValF(Value2$) : ProcedureReturn #True : EndIf Case "<" If ValF(Value1$) < ValF(Value2$) : ProcedureReturn #True : EndIf Case ">" If ValF(Value1$) > ValF(Value2$) : ProcedureReturn #True : EndIf Case ">=" If ValF(Value1$) >= ValF(Value2$) : ProcedureReturn #True : EndIf Case "<=" If ValF(Value1$) <= ValF(Value2$) : ProcedureReturn #True : EndIf Case "<>" If ValF(Value1$) <> ValF(Value2$) : ProcedureReturn #True : EndIf EndSelect ;} Case #String ;{ Select Compare$ Case "=" If Value1$ = Value2$ : ProcedureReturn #True : EndIf Case "<" If Value1$ < Value2$ : ProcedureReturn #True : EndIf Case ">" If Value1$ > Value2$ : ProcedureReturn #True : EndIf Case ">=" If Value1$ >= Value2$ : ProcedureReturn #True : EndIf Case "<=" If Value1$ <= Value2$ : ProcedureReturn #True : EndIf Case "<>" If Value1$ <> Value2$ : ProcedureReturn #True : EndIf EndSelect ;} EndSelect ProcedureReturn #False EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Areas ;----------------------------------------------------------------------------- Procedure.i _AddAreaRow(GID.i, Row.i, Y.i, Height.i) If FindMapElement(Grid(), Str(GID)) AddElement(Grid()\Row\AreaList()) Grid()\Row\AreaList()\Y = Y Grid()\Row\AreaList()\AreaRow = Row Grid()\Row\AreaList()\Height = Height Grid()\Rows(Row)\Area = ListIndex(Grid()\Row\AreaList()) EndIf EndProcedure Procedure.i _AddAreaCol(GID.i, Col.i, X.i, Width.i) If FindMapElement(Grid(), Str(GID)) AddElement(Grid()\Col\AreaList()) Grid()\Col\AreaList()\X = X Grid()\Col\AreaList()\AreaCol = Col Grid()\Col\AreaList()\Width = Width Grid()\Cols(Col)\Area = ListIndex(Grid()\Col\AreaList()) EndIf EndProcedure Procedure.i _BuildAreas(GID.i) ; Builds screen-areas Rows and Cols ; based on: TopRow, TopCol, visible rows, visisble cols Define gid$ = Str(GID) Define.i X, Y, Width, Height Define.i i, r, iCol, iRow, nCols, nRows, avl, act If FindMapElement(Grid(), Str(GID)) ; --- initializing all non hidden Rows, Cols to non visible For r=0 To Grid()\Row\Number Grid()\Rows(r)\Area = -1 Next ClearList(Grid()\Row\AreaList()) ClearList(Grid()\Col\AreaList()) Grid()\Header\Height = 0 Grid()\Header\Width = 0 _AddAreaRow(GID, 0, 0, Grid()\Rows(0)\Height) _AddAreaCol(GID, 0, 0, Grid()\Cols(0)\Width) ; --- building row areas ; adjusts TopRow [ FrozenRow + 1 ... Rows ] If Grid()\Row\TopCell <= Grid()\Row\LastFrozen Grid()\Row\TopCell = Grid()\Row\LastFrozen + 1 EndIf Repeat If Grid()\Row\TopCell > Grid()\Row\Number Grid()\Row\TopCell = 0 Break EndIf If Grid()\Rows(Grid()\Row\TopCell)\Height > 0 : Break : EndIf Grid()\Row\TopCell = Grid()\Row\TopCell + 1 ForEver Y = Grid()\Rows(0)\Height - 1 If Y < 0 : Y = 0 : EndIf For iRow = 1 To Grid()\Row\Number If Y >= Grid()\Size\Height : Break : EndIf Height = Grid()\Rows(iRow)\Height If Height > 0 ; skip rows that are ] FrozenRow, TopRow [ If iRow > Grid()\Row\LastFrozen And iRow < Grid()\Row\TopCell : Continue : EndIf _AddAreaRow(GID, iRow, Y, Height) If _IsHeaderRow(GID, iRow) : Grid()\Header\Height + Height : EndIf Y = Y + Height - 1 EndIf Next iRow ; -- building Col areas ; adjusts TopCol [ FrozenCol + 1 ... Cols ] If Grid()\Col\TopCell <= Grid()\Col\LastFrozen Grid()\Col\TopCell = Grid()\Col\LastFrozen + 1 EndIf Repeat If Grid()\Col\TopCell > Grid()\Col\Number Grid()\Col\TopCell = 0 Break EndIf If Grid()\Cols(Grid()\Col\TopCell)\Width > 0 : Break : EndIf Grid()\Col\TopCell = Grid()\Col\TopCell + 1 ForEver X = Grid()\Cols(0)\Width - 1 : If X < 0 : X = 0 : EndIf For iCol = 1 To Grid()\Col\Number If X >= Grid()\Size\Width : Break : EndIf Width = Grid()\Cols(iCol)\Width If Width > 0 ; skip cols that are ] FrozenCol , TopCol [ If iCol > Grid()\Col\LastFrozen And iCol < Grid()\Col\TopCell : Continue : EndIf _AddAreaCol(GID, iCol, X, Width) If _IsHeaderCol(GID, iCol) : Grid()\Header\Width + Width : EndIf X = X + Width - 1 EndIf Next iCol EndIf EndProcedure Procedure.i _AreaRow_Of_Y(GID.i, Y.i) Define gid$ = Str(GID) ForEach Grid(gid$)\Row\AreaList() If Y <= Grid(gid$)\Row\AreaList()\Y Continue EndIf If Y > Grid(gid$)\Row\AreaList()\Y + Grid(gid$)\Row\AreaList()\Height Continue EndIf ProcedureReturn ListIndex(Grid(gid$)\Row\AreaList()) Next ProcedureReturn #NoElement ; outside any area! EndProcedure Procedure.i _AreaCol_Of_X(GID.i, X.i) Define gid$ = Str(GID) ForEach Grid(gid$)\Col\AreaList() If X <= Grid(gid$)\Col\AreaList()\X : Continue : EndIf If X > Grid(gid$)\Col\AreaList()\X + Grid(gid$)\Col\AreaList()\Width Continue EndIf ProcedureReturn ListIndex(Grid(gid$)\Col\AreaList()) Next ProcedureReturn #NoElement ; outside any area! EndProcedure Procedure.i _Row_Of_Y(GID.i, Y.i) Define.i AreaRow AreaRow = _AreaRow_Of_Y(GID, Y) If AreaRow >= 0 SelectElement(Grid(Str(GID))\Row\AreaList(), AreaRow) ProcedureReturn Grid(Str(GID))\Row\AreaList()\AreaRow EndIf ProcedureReturn #NoResult EndProcedure Procedure.i _Col_Of_X(GID.i, X.i) Define.i AreaCol AreaCol = _AreaCol_Of_X(GID, X) If AreaCol >= 0 SelectElement(Grid(Str(GID))\Col\AreaList(), AreaCol) ProcedureReturn Grid(Str(GID))\Col\AreaList()\AreaCol EndIf ProcedureReturn #NoResult EndProcedure Procedure.i _Area_Of_Row(GID.i, Row.i) ProcedureReturn Grid(Str(GID))\Rows(Row)\Area EndProcedure Procedure.i _Area_Of_Col(GID.i, Col.i) ProcedureReturn Grid(Str(GID))\Cols(Col)\Area EndProcedure Procedure.i _AreaResizeCol(GID.i, X.i, Y.i) ; return the Col area affected by user-resize starting at (X,Y) Define i.i If FindMapElement(Grid(), Str(GID)) If _IsHeaderRow(GID, _Row_Of_Y(GID, Y)) If X <= #ColSep_Margin If FirstElement(Grid()\Col\AreaList()) ; checks if there is any hidden column to the left? For i = Grid()\Col\AreaList()\AreaCol-1 To 0 Step -1 If Grid()\Cols(i)\Width = 0 : ProcedureReturn #False : EndIf Next EndIf Else ForEach Grid()\Col\AreaList() If Abs(Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width - X) <= #ColSep_Margin ProcedureReturn ListIndex(Grid()\Col\AreaList()) EndIf Next EndIf EndIf EndIf ProcedureReturn #NoResult EndProcedure Procedure.i _AreaResizeRow(GID.i, X.i, Y.i) ; return the row-area affected by user-resize starting at (x,y) If FindMapElement(Grid(), Str(GID)) If _IsHeaderCol(GID, _Col_Of_X(GID, X)) ForEach Grid()\Row\AreaList() If Abs(Grid()\Row\AreaList()\Y + Grid()\Row\AreaList()\Height - Y) <= #RowSep_Margin ProcedureReturn ListIndex(Grid()\Row\AreaList()) EndIf Next EndIf EndIf ProcedureReturn #NoResult EndProcedure Procedure _RectCoord(GID.i, R1.i, C1.i, R2.i, C2.i, *Block.Rectangle_Structure) ; return in *Block its (X,Y,Width,Height) built from block [(R1,C1) ... (R2,C2)] Define.i X, Y, Width, Height, RowArea, ColArea, iR, iC If FindMapElement(Grid(), Str(GID)) X = -1 : Y = -1 : Height = 0 : Width = 0 If R1 > R2 : Swap R1 , R2 : EndIf If C1 > C2 : Swap C1 , C2 : EndIf PushListPosition(Grid()\Row\AreaList()) For iR = R1 To R2 RowArea = _Area_Of_Row(GID, iR) If RowArea >= 0 SelectElement(Grid()\Row\AreaList(), RowArea) If Y < 0 : Y = Grid()\Row\AreaList()\Y : EndIf Height = Height + Grid()\Row\AreaList()\Height - 1 EndIf If Y + Height > Grid()\Size\Height : Break : EndIf Next PopListPosition(Grid()\Row\AreaList()) PushListPosition(Grid()\Col\AreaList()) For iC = C1 To C2 ColArea = _Area_Of_Col(GID, iC) If ColArea >= 0 SelectElement(Grid()\Col\AreaList() , ColArea) If X < 0 : X = Grid()\Col\AreaList()\X : EndIf Width = Width + Grid()\Col\AreaList()\Width - 1 EndIf If X + Width > Grid()\Size\Width : Break : EndIf Next PopListPosition(Grid()\Col\AreaList()) If Height > 0 And Width > 0 *Block\X = X *Block\Y = Y *Block\Width = Width + 1 *Block\Height = Height + 1 ProcedureReturn #True EndIf EndIf ProcedureReturn #False EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Mouse Areas ;----------------------------------------------------------------------------- Procedure _OverListView(GID.i, X.i, Y.i) If FindMapElement(Grid(), Str(GID)) If Grid()\ListView\X < X And X <= (Grid()\ListView\X + Grid()\ListView\Width) And Grid()\ListView\Y < Y And Y <= (Grid()\ListView\Y + Grid()\ListView\Height) ProcedureReturn #True EndIf EndIf ProcedureReturn #False EndProcedure Procedure _OverEditor(GID.i, X.i, Y.i) If FindMapElement(Grid(), Str(GID)) If Grid()\EditStrg\X < X And X <= (Grid()\EditStrg\X + Grid()\EditStrg\Width) And Grid()\EditStrg\Y < Y And Y <= (Grid()\EditStrg\Y + Grid()\EditStrg\Height) ProcedureReturn #True EndIf EndIf ProcedureReturn #False EndProcedure Procedure _OverCellArea(GID.i, X.i, Y.i) If _AreaRow_Of_Y(GID, Y) > 0 And _AreaCol_Of_X(GID, X) > 0 ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _OverDataArea(GID.i, X.i, Y.i) If X > Grid(Str(GID))\Cols(0)\Width And Y > Grid(Str(GID))\Rows(0)\Height ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _OverResizeCol(GID.i, X.i, Y.i) If _AreaResizeCol(GID, X, Y) >= 0 ProcedureReturn #True EndIf EndProcedure Procedure _OverResizeRow(GID.i, X.i, Y.i) If _AreaResizeRow(GID, X, Y) >= 0 ProcedureReturn #True EndIf EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Blocks ;----------------------------------------------------------------------------- Procedure _ResetBlock(GID.i) Define gid$ = Str(GID) Grid(gid$)\Block\X = 0 Grid(gid$)\Block\Y = 0 Grid(gid$)\Block\Width = 0 Grid(gid$)\Block\Height = 0 Grid(gid$)\Block\Row1 = 0 Grid(gid$)\Block\Col1 = 0 Grid(gid$)\Block\Row2 = 0 Grid(gid$)\Block\Col2 = 0 EndProcedure Procedure _HasBlock(GID.i) Define gid$ = Str(GID) If Grid(gid$)\Block\Row2 > 0 And Grid(gid$)\Block\Col2 > 0 And (Grid(gid$)\Block\Row1 <> Grid(gid$)\Block\Row2 Or Grid(gid$)\Block\Col1 <> Grid(gid$)\Block\Col2) ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _BlockSize(GID.i) Define gid$ = Str(GID) Define Block.Rectangle_Structure _RectCoord(GID, Grid(gid$)\Row\Current, Grid(gid$)\Col\Current, Grid(gid$)\Block\Row2, Grid(gid$)\Block\Col2, @Block) Grid(gid$)\Block\X = Block\X Grid(gid$)\Block\Y = Block\Y Grid(gid$)\Block\Width = Block\Width Grid(gid$)\Block\Height = Block\Height EndProcedure Procedure _StartBlock(GID.i, Row1.i=-1, Col1.i=-1, Row2.i=-1, Col2.i=-1) ; start a new block ... reset existing one if any Define.i R1=Row1, C1=Col1, R2=Row2, C2=Col2 If FindMapElement(Grid(), Str(GID)) If _HasBlock(GID) : _ResetBlock(GID) : EndIf If R1 = -1 : R1 = Grid()\Row\Current : EndIf If R2 = -1 : R2 = Grid()\Row\Current : EndIf If C1 = -1 : C1 = Grid()\Col\Current : EndIf If C2 = -1 : C2 = Grid()\Col\Current : EndIf If Not _IsValidCell(GID, R1, C1) : ProcedureReturn #False : EndIf If Not _IsValidCell(GID, R2, C2) : ProcedureReturn #False : EndIf Grid()\Row\Current = R1 : Grid()\Col\Current = C1 Grid()\Block\Row1 = R1 : Grid()\Block\Col1 = C1 Grid()\Block\Row2 = R2 : Grid()\Block\Col2 = C2 _BlockSize(GID) EndIf ProcedureReturn #True EndProcedure Procedure _OverBlock(GID.i, X.i, Y.i) Define gid$ = Str(GID) If Grid(gid$)\Block\X < X And X <= (Grid(gid$)\Block\X + Grid(gid$)\Block\Width) And Grid(gid$)\Block\Y < Y And Y <= (Grid(gid$)\Block\Y + Grid(gid$)\Block\Height) ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure _BlocksHaveIntersection(AR1, AR2, AC1, AC2, BR1, BR2, BC1, BC2) ; return true if there are cells in common between the two blocks A and B ; A is defined by AR1,AR2,AC1,AC2 .... R1 <= R2 and C1 <= C2 ; B is defined by BR1,BR2,BC1,BC2 If AR2 >= BR1 And BR2 >= AR1 And AC2 >= BC1 And BC2 >= AC1 ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Navigation ;----------------------------------------------------------------------------- Declare.i DrawCell(GID.i, Row.i, Col.i) Declare.i DrawFocus(GID.i) Procedure.i _MultiOfCell(GID.i, Row.i, Col.i) If FindMapElement(Grid(), Str(GID)) ForEach Grid()\MultiCellList() If Row < Grid()\MultiCellList()\Row1 Or Grid()\MultiCellList()\Row2 < Row : Continue : EndIf If Col < Grid()\MultiCellList()\Col1 Or Grid()\MultiCellList()\Col2 < Col : Continue : EndIf ProcedureReturn ListIndex(Grid()\MultiCellList()) Next EndIf ProcedureReturn #NoElement EndProcedure Procedure.i _AboveRow(GID.i, Row.i, Col.i, MultiAsOneCell) ; return the above row (up) having height > 0 OR -1 Define gid$ = Str(GID) Define.i Result, MultiIdx, Base = Row - 1 If MultiAsOneCell MultiIdx = _MultiOfCell(GID, Row, Col) If MultiIdx >= 0 SelectElement(Grid(gid$)\MultiCellList(), MultiIdx) Base = Grid(gid$)\MultiCellList()\Row1 - 1 EndIf EndIf For Result = Base To 1 Step -1 If Grid(gid$)\Rows(Result)\Height > 0 : ProcedureReturn Result : EndIf Next ProcedureReturn -1 EndProcedure Procedure.i _BelowRow(GID.i, Row.i, Col.i, MultiAsOneCell) ; return the below row (down) having height > 0 OR -1 Define gid$ = Str(GID) Define.i Result, MultiIdx, Base = Row + 1 If MultiAsOneCell MultiIdx = _MultiOfCell(GID, Row, Col) If MultiIdx >= 0 SelectElement(Grid(gid$)\MultiCellList(), MultiIdx) Base = Grid(gid$)\MultiCellList()\Row2 + 1 EndIf EndIf For Result = Base To Grid(gid$)\Row\Number If Grid(gid$)\Rows(Result)\Height > 0 : ProcedureReturn Result : EndIf Next ProcedureReturn -1 EndProcedure Procedure.i _NearestTopRow(GID.i, Row.i) ; return the TopRow that requires least moves so Row is visible Define.i Height, rowHeight, colY, r, i If FindMapElement(Grid(), Str(GID)) If _IsDataRow(GID, Row) = #False : ProcedureReturn #NoResult : EndIf If Grid()\Rows(Row)\Height <= 0 : ProcedureReturn #NoResult : EndIf Height = Grid()\Size\Height If Row < Grid()\Row\TopCell ;{ Row > TopRow If Row < Grid()\Row\FirstTop : ProcedureReturn Grid()\Row\FirstTop : EndIf ProcedureReturn Row ;} ElseIf Grid()\Rows(Row)\Area >= 0 ;{ Row is on screen fully/partially visible If SelectElement(Grid()\Row\AreaList(), Grid()\Rows(Row)\Area) colY = Grid()\Row\AreaList()\Y rowHeight = Grid()\Rows(Row)\Height For r = Grid()\Row\TopCell To Row If Grid()\Rows(r)\Height > 0 If colY + rowHeight <= Height : ProcedureReturn r : EndIf colY = colY - Grid()\Rows(r)\Height EndIf Next EndIf ProcedureReturn Row ;} Else ;{ Row not on screen rowHeight = 0 ForEach Grid()\Row\AreaList() i = Grid()\Row\AreaList()\AreaRow If i > Grid()\Row\LastFrozen : Break : EndIf rowHeight = rowHeight + (Grid()\Rows(i)\Height - 1) Next rowHeight = rowHeight + (Grid()\Rows(Row)\Height - 1) r = Row For i = Row-1 To Grid()\Row\FirstTop Step -1 If rowHeight + Grid()\Rows(i)\Height > Height : Break : EndIf rowHeight = rowHeight + (Grid()\Rows(i)\Height - 1) r = i Next ProcedureReturn r ;} EndIf EndIf EndProcedure Procedure.i _NearestTopCol(GID.i, Col.i) ; return the TopCol that requires least moves so Col is visible Define.i Width, colWidth, colX, c, i If FindMapElement(Grid(), Str(GID)) If _IsDataCol(GID, Col) = #False : ProcedureReturn #NoResult : EndIf If Grid()\Cols(Col)\Width <= #False : ProcedureReturn #NoResult : EndIf Width = Grid()\Size\Width If Col < Grid()\Col\TopCell ;{ First Top Col If Col < Grid()\Col\TopCell : ProcedureReturn Grid()\Col\FirstTop : EndIf ProcedureReturn Col ;} ElseIf Grid()\Cols(Col)\Area >= 0 ;{ col is on screen fully/partially visible If SelectElement(Grid()\Col\AreaList(), Grid()\Cols(Col)\Area) colX = Grid()\Col\AreaList()\X colWidth = Grid()\Cols(Col)\Width For c = Grid()\Col\TopCell To Col If Grid()\Cols(c)\Width > 0 If colX + colWidth <= Width : ProcedureReturn c : EndIf colX = colX - Grid()\Cols(c)\Width EndIf Next EndIf ProcedureReturn Col ;} Else ;{ col not on screen colWidth = 0 ForEach Grid()\Col\AreaList() i = Grid()\Col\AreaList()\AreaCol If i > Grid()\Col\LastFrozen : Break : EndIf colWidth = colWidth + (Grid()\Cols(i)\Width - 1) Next colWidth = colWidth + (Grid()\Cols(Col)\Width - 1) c = Col For i = Col-1 To Grid()\Col\FirstTop Step -1 If colWidth + Grid()\Cols(i)\Width > Width : Break : EndIf colWidth = colWidth + (Grid()\Cols(i)\Width - 1) c = i Next ProcedureReturn c ;} EndIf EndIf EndProcedure Procedure.i _PreviousCol(GID.i, Row.i, Col.i, MultiAsOneCell) ; return the previous col (left) having width > 0 OR -1 Define Result, Multi, Base = Col-1 If MultiAsOneCell Multi = _MultiOfCell(GID, Row, Col) If Multi >= 0 SelectElement(Grid()\MultiCellList(), Multi) Base = Grid()\MultiCellList()\Col1 - 1 EndIf EndIf For Result = Base To Grid()\Header\Cols Step -1 If Grid()\Cols(Result)\Width > 0 : ProcedureReturn Result : EndIf Next ProcedureReturn -1 EndProcedure Procedure.i _NextCol(GID.i, Row.i, Col.i, MultiAsOneCell) ; return the next col (right) having width > 0 OR -1 Define.i Result, Multi, Base = Col + 1 If MultiAsOneCell Multi = _MultiOfCell(GID, Row, Col) If Multi >= 0 SelectElement(Grid()\MultiCellList(), Multi) Base = Grid()\MultiCellList()\Col2 + 1 EndIf EndIf For Result = Base To Grid()\Col\Number If Grid()\Cols(Result)\Width > 0 : ProcedureReturn Result : EndIf Next ProcedureReturn -1 EndProcedure Procedure.i _MoveFocus(GID.i, Row.i, Col.i) If FindMapElement(Grid(), Str(GID)) If StartDrawing(CanvasOutput(Grid()\GId\Canvas)) DrawCell(GID, Grid()\Row\Current, Grid()\Col\Current) Grid()\Row\Current = Row Grid()\Col\Current = Col DrawFocus(GID) StopDrawing() EndIf EndIf EndProcedure Procedure.i _MoveUp(GID.i, xStep.i=1, Flag.i=#Move_Focus) Define.i i, stp, lmt, Row, Col If FindMapElement(Grid(), Str(GID)) If (Flag = #Move_Block) And (_HasBlock(GID) = #False) : _StartBlock(GID) : EndIf Select Flag Case #Move_Focus Row = Grid()\Row\Current lmt = Grid()\Row\FirstVisible Case #Move_TopRC Row = Grid()\Row\TopCell lmt = Grid()\Row\FirstTop Case #Move_Block Row = Grid()\Block\Row2 lmt = Grid()\Row\FirstVisible EndSelect If (xStep <= 0 ) Or (Row <= lmt) : ProcedureReturn #False : EndIf Col = Grid()\Col\Current Repeat i = _AboveRow(GID, Row, Col, Bool(Flag = #Move_Focus)) If i <= 0 : Break : EndIf Row = i stp = stp + 1 If stp >= xStep : Break : EndIf ForEver Select Flag Case #Move_Focus If Row = Grid()\Row\Current : ProcedureReturn #False : EndIf i = _NearestTopRow(GID, Row) If Grid()\Row\TopCell <> i Grid()\Row\TopCell = i Grid()\Row\Current = Row ProcedureReturn #True Else _MoveFocus(GID, Row, Col) EndIf Case #Move_TopRC If Row = Grid()\Row\TopCell : ProcedureReturn #False : EndIf Grid()\Row\TopCell = Row ProcedureReturn #True Case #Move_Block If Row = Grid()\Block\Row2 : ProcedureReturn #False : EndIf Grid()\Block\Row2 = Row Grid()\Row\TopCell = _NearestTopRow(GID, Grid()\Block\Row2) ProcedureReturn #True EndSelect EndIf EndProcedure Procedure.i _MoveDown(GID.i, xStep.i=1, Flag.i=#Move_Focus) Define.i i, stp, lmt, Row, Col If FindMapElement(Grid(), Str(GID)) If Flag = #Move_Block And _HasBlock(GID) = #False : _StartBlock(GID) : EndIf Select Flag Case #Move_Focus: Row = Grid()\Row\Current : lmt = Grid()\Row\LastVisible Case #Move_TopRC: Row = Grid()\Row\TopCell : lmt = Grid()\Row\LastTop Case #Move_Block: Row = Grid()\Block\Row2 : lmt = Grid()\Row\LastVisible EndSelect If (xStep <= 0 ) Or (Row >= lmt) : ProcedureReturn #False : EndIf Col = Grid()\Col\Current Repeat i = _BelowRow(GID, Row, Col, Bool(Flag = #Move_Focus)) If i <= 0 : Break : EndIf Row = i stp = stp + 1 : If stp >= xStep : Break : EndIf ForEver Select Flag Case #Move_Focus If Row = Grid()\Row\Current : ProcedureReturn #False : EndIf i = _NearestTopRow(GID, Row) If Grid()\Row\TopCell <> i Grid()\Row\TopCell = i Grid()\Row\Current = Row ProcedureReturn #True Else _MoveFocus(GID, Row, Col) EndIf Case #Move_TopRC If Row = Grid()\Row\TopCell : ProcedureReturn #False : EndIf Grid()\Row\TopCell = Row ProcedureReturn #True Case #Move_Block If Row = Grid()\Block\Row2 : ProcedureReturn #False : EndIf Grid()\Block\Row2 = Row Grid()\Row\TopCell = _NearestTopRow(GID, Grid()\Block\Row2) ProcedureReturn #True EndSelect EndIf EndProcedure Procedure.i _MoveLeft(GID.i, xStep=1, Flag.i=#Move_Focus) Define.i i, stp, lmt, Row, Col If Flag = #Move_Block And _HasBlock(GID) = #False : _StartBlock(GID) : EndIf Select Flag Case #Move_Focus: Col = Grid()\Col\Current : lmt = Grid()\Col\FirstVisible Case #Move_TopRC: Col = Grid()\Col\TopCell : lmt = Grid()\Col\FirstTop Case #Move_Block: Col = Grid()\Block\Col2 : lmt = Grid()\Col\FirstVisible EndSelect If xStep <= 0 Or Col <= lmt : ProcedureReturn #False : EndIf Row = Grid()\Row\Current Repeat If Flag = #Move_Focus i = _PreviousCol(GID, Row, Col, #True) Else i = _PreviousCol(GID, Row, Col, #False) EndIf If i < Grid()\Header\Cols : Break : EndIf Col = i stp = stp + 1 : If stp >= xStep : Break : EndIf ForEver Select Flag Case #Move_Focus If Col = Grid()\Col\Current : ProcedureReturn #False : EndIf i = _NearestTopCol(Grid(), Col) If Grid()\Col\TopCell <> i Grid()\Col\TopCell = i Grid()\Col\Current = Col ProcedureReturn #True Else _MoveFocus(Grid(), Row, Col) ProcedureReturn #True EndIf Case #Move_TopRC If Col = Grid()\Col\TopCell : ProcedureReturn #False : EndIf Grid()\Col\TopCell = Col ProcedureReturn #True Case #Move_Block If Col = Grid()\Block\Col2 : ProcedureReturn #False : EndIf Grid()\Block\Col2 = Col Grid()\Col\TopCell = _NearestTopCol(Grid(), Grid()\Block\Col2) ProcedureReturn #True EndSelect EndProcedure Procedure.i _MoveRight(GID.i, xStep.i = 1, Flag=#Move_Focus) Define i, stp, lmt, Row, Col If Flag = #Move_Block And _HasBlock(GID) = #False : _StartBlock(GID) : EndIf Select Flag Case #Move_Focus: Col = Grid()\Col\Current : lmt = Grid()\Col\LastVisible Case #Move_TopRC: Col = Grid()\Col\TopCell : lmt = Grid()\Col\LastTop Case #Move_Block: Col = Grid()\Block\Col2 : lmt = Grid()\Col\LastVisible EndSelect If (xStep <= 0 ) Or (Col >= lmt) : ProcedureReturn #False : EndIf Row = Grid()\Row\Current Repeat If Flag = #Move_Focus i = _NextCol(GID, Row, Col, #True) Else i = _NextCol(GID, Row, Col, #False) EndIf If i <= 0 : Break : EndIf Col = i stp = stp + 1 : If stp >= xStep : Break : EndIf ForEver Select Flag Case #Move_Focus If Col = Grid()\Col\Current : ProcedureReturn #False : EndIf i = _NearestTopCol(GID, Col) If Grid()\Col\TopCell <> i Grid()\Col\TopCell = i Grid()\Col\Current = Col ProcedureReturn #True Else _MoveFocus(GID, Row, Col) ProcedureReturn #True EndIf Case #Move_TopRC If Col = Grid()\Col\TopCell : ProcedureReturn #False : EndIf Grid()\Col\TopCell = Col ProcedureReturn #True Case #Move_Block If Col = Grid()\Block\Col2 : ProcedureReturn #False : EndIf Grid()\Block\Col2 = Col Grid()\Col\TopCell = _NearestTopCol(GID, Grid()\Block\Col2) ProcedureReturn #True EndSelect EndProcedure Procedure.i _ExtendBlock_XY(GID.i, X.i, Y.i) ; extends current block via pressed mouse-move ; X,Y are coord within canvas Define.i Row, Col, dskX, dskY, xStep, ret1, ret2, outside, mgnX, mgnY If FindMapElement(Grid(), Str(GID)) mgnX = 40 mgnY = 30 If Y < 0 xStep = 1 If Y < mgnY : xStep = 10 : EndIf _MoveUp(GID, xStep, #Move_Block) EndIf If Y > Grid()\Size\Height xStep = 1 If (Y - Grid()\Size\Height) > mgnY : xStep = 10 : EndIf _MoveDown(GID, 10, #Move_Block) EndIf If X < 0 xStep = 1 If X < mgnX : xStep = 10 : EndIf _MoveLeft(GID, 10, #Move_Block) EndIf If X > Grid()\Size\Width xStep = 1 If (X - Grid()\Size\Width) > mgnX : xStep = 10 : EndIf _MoveRight(GID, 10, #Move_Block) EndIf Row = _Row_Of_Y(GID, Y) Col = _Col_Of_X(GID, X) If (Row = Grid()\Block\Row2) And (Col = Grid()\Block\Col2) : ProcedureReturn #False : EndIf If (Col > 0) And (Grid()\Block\Col2 <> Col) xStep = Abs(Grid()\Block\Col2 - Col) If Col > Grid()\Block\Col2 : _MoveRight(GID, xStep, #Move_Block) : EndIf If Col < Grid()\Block\Col2 : _MoveLeft(GID, xStep, #Move_Block) : EndIf Grid()\Block\Col2 = Col EndIf If (Row > 0) And (Grid()\Block\Row2 <> Row) xStep = Abs(Grid()\Block\Row2 - Row) If Row > Grid()\Block\Row2 : _MoveDown(GID, xStep, #Move_Block) : EndIf If Row < Grid()\Block\Row2 : _MoveUp(GID, xStep, #Move_Block) : EndIf Grid()\Block\Row2 = Row EndIf ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Format cells ;----------------------------------------------------------------------------- Procedure.s _GetSeperator(GID.i, Flag.i, Date$) Define Mask$, Sep$ Select Flag Case #Date Mask$ = Grid(Str(GID))\Format\ParseDate Sep$ = RemoveString(Mask$, "%dd") Sep$ = RemoveString(Sep$, "%mm") Sep$ = RemoveString(Sep$, "%yyyy") Sep$ = RemoveString(Sep$, "%yy") Case #Time Mask$ = Grid(Str(GID))\Format\ParseTime Sep$ = RemoveString(Mask$, "%hh") Sep$ = RemoveString(Sep$, "%ii") Sep$ = RemoveString(Sep$, "%ss") EndSelect ProcedureReturn Left(Sep$, 1) EndProcedure Procedure.s _GetIntegerString(Integer.i, Mask$) ProcedureReturn ReplaceString(Mask$, "%i", FormatNumber(Integer, #False, #DecimalPoint, #ThousandSeparator)) EndProcedure Procedure.s _GetFloatString(Float.f, Mask$, DecimalPoint.s, ThousandSeparator.s) Define Float$, Digits Digits = CountString(Mask$, "d") Float$ = FormatNumber(Float, Digits, DecimalPoint, ThousandSeparator) Mask$ = ReplaceString(Mask$, "%i", StringField(Float$, 1, DecimalPoint)) Mask$ = ReplaceString(Mask$, LSet("%", digits+1, "d"), StringField(Float$, 2, DecimalPoint)) ProcedureReturn Mask$ EndProcedure Procedure.s _FormatCell(GID.i, Value$, Flags.i, *Style.Grid_Style_Structure, Mask$="") Define Format$, Best$, Worst$ If FindMapElement(Grid(), Str(GID)) If Value$ = "" : ProcedureReturn "" : EndIf If Flags & #Date ProcedureReturn _GetDateString(GID, Value$, #FullDate, Mask$, *Style\Language) ElseIf Flags & #Time ProcedureReturn _GetTimeString(GID, Value$, #FullTime, Mask$) ElseIf Flags & #Integer ;{ Integer number If Mask$ ProcedureReturn _GetIntegerString(Val(Value$), Mask$) Else ProcedureReturn FormatNumber(Val(Value$), #False, Grid()\Format\DecimalPoint, Grid()\Format\ThousandSeparator) EndIf ;} ElseIf Flags & #Float ;{ Floating point number Value$ = ReplaceString(Value$, Grid()\Format\DecimalPoint, ".") If Mask$ ProcedureReturn _GetFloatString(ValF(Value$), Mask$, Grid()\Format\DecimalPoint, Grid()\Format\ThousandSeparator) Else ProcedureReturn FormatNumber(ValF(Value$), *Style\Value("Digits"), Grid()\Format\DecimalPoint, Grid()\Format\ThousandSeparator) EndIf ;} ElseIf Flags & #Cash ;{ Amounts of money Value$ = ReplaceString(Value$, Grid()\Format\DecimalPoint, ".") If Mask$ ProcedureReturn _GetFloatString(ValF(Value$), Mask$, Grid()\Format\DecimalPoint, Grid()\Format\ThousandSeparator) Else Format$ = FormatNumber(ValF(Value$), 2, Grid()\Format\DecimalPoint, Grid()\Format\ThousandSeparator) If CountString(Format$, Grid()\Format\Currency) = 0 Format$ + " " + Grid()\Format\Currency EndIf ProcedureReturn Format$ EndIf ;} ElseIf Flags & #Grades ;{ Grades If FindMapElement(Grades(), *Style\Language) Select Grades()\Flag Case #Points Format$ = Value$ + " P" ProcedureReturn Format$ Case #Character If _IsNumber(Value$) ProcedureReturn Grades()\Notation(Value$) EndIf EndSelect EndIf ;} EndIf EndIf ProcedureReturn Value$ EndProcedure Procedure _IsMarked(GID.i, Row.i, Col.i, Cell$, Term$, Flag.i) Define.i Result1, Result2 Define Type$, Expr$, Compare$, Link$ If FindMapElement(Grid(), Str(GID)) Type$ = StringField(Term$, 1, "{") Expr$ = _ExtractTag(Term$, "{", "}") Link$ = _ExtractTag(Term$, "[", "]") If Link$ Select Left(Link$, 1) ;{ Link to another cell Case "R" Row = Val(LTrim(Link$, "R")) Cell$ = Grid()\Entry(Row)\Cell(Col)\Value Case "C" Col = Val(LTrim(Link$, "C")) Cell$ = Grid()\Entry(Row)\Cell(Col)\Value Default Row = Val(StringField(Link$, 1, ":")) Col = Val(StringField(Link$, 2, ":")) Cell$ = Grid()\Entry(Row)\Cell(Col)\Value EndSelect ;} EndIf Select UCase(Type$) Case "NEGATIVE", "NEGATIV" ;{ NEGATIVE If _CompareValues(GID, Cell$, "<", "0", Flag) ProcedureReturn #True EndIf ;} Case "POSITIVE", "POSITIV" ;{ POSITIVE If _CompareValues(GID, Cell$, ">", "0", Flag) ProcedureReturn #True EndIf ;} Case "EQUAL", "GLEICH" ;{ EQUAL{3.95} / EQUAL{String} If _CompareValues(GID, Cell$, "=", Expr$, Flag) ProcedureReturn #True EndIf ;} Case "LIKE" ;{ LIKE{*end} / LIKE{start*} / LIKE{*part*} If Left(Expr$, 1) = "*" And Right(Expr$, 1) = "*" Expr$ = Trim(Expr$, "*") If CountString(Cell$, Expr$) : ProcedureReturn #True : EndIf ElseIf Left(Expr$, 1) = "*" Expr$ = LTrim(Expr$, "*") If Right(Cell$, Len(Expr$)) = Expr$ : ProcedureReturn #True : EndIf ElseIf Right(Expr$, 1) = "*" Expr$ = RTrim(Expr$, "*") If Left(Cell$, Len(Expr$)) = Expr$ : ProcedureReturn #True : EndIf Else If Left(Cell$, Len(Expr$)) = Expr$ : ProcedureReturn #True : EndIf EndIf ;} Case "COMPARE", "VERGLEICH" ;{ COMPARE{<|12} => [?] < 12 If _CompareValues(GID, Cell$, StringField(Expr$, 1, "|"), StringField(Expr$, 2, "|"), Flag) ProcedureReturn #True EndIf ;} Case "BETWEEN", "ZWISCHEN" ;{ BETWEEN{10|20} => 10 < [?] < 20 Result1 = _CompareValues(GID, Cell$, ">", StringField(Expr$, 1, "|"), Flag) Result2 = _CompareValues(GID, Cell$, "<", StringField(Expr$, 2, "|"), Flag) If Result1 And Result2 ProcedureReturn #True EndIf ;} Case "BEYOND" ;{ BEYOND{3|4} => 3 > [?] OR [?] > 4 Result1 = _CompareValues(GID, Cell$, "<", StringField(Expr$, 1, "|"), Flag) Result2 = _CompareValues(GID, Cell$, ">", StringField(Expr$, 2, "|"), Flag) If Result1 ProcedureReturn #Condition1 ElseIf Result2 ProcedureReturn #Condition2 EndIf ;} EndSelect EndIf ProcedureReturn #False EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Check cell contents for validity ;----------------------------------------------------------------------------- Procedure IsInteger(GID.i, Value$) If Value$ = "" : ProcedureReturn #True : EndIf If _IsNumber(Value$) = #False ProcedureReturn #False Else If CountString(Value$, Grid(Str(GID))\Format\DecimalPoint) Or CountString(Value$, Grid(Str(GID))\Format\ThousandSeparator) ProcedureReturn #False EndIf EndIf ProcedureReturn #True EndProcedure Procedure IsFloat(Value$) If _IsNumber(Value$) = #False ProcedureReturn #False Else If CountString(Value$, ".") <> 1 ProcedureReturn #False EndIf EndIf ProcedureReturn #True EndProcedure Procedure IsCash(GID.i, Value$) Define Cash$, Euro$, Cent$ If Value$ = "" : ProcedureReturn #True : EndIf If CountString(Value$, "-") > 1 : ProcedureReturn #False : EndIf Cash$ = LTrim(Trim(Value$), "-") Euro$ = StringField(Cash$, 1, ".") Cent$ = StringField(Cash$, 2, ".") If Len(Cent$) <> 2 : ProcedureReturn #False : EndIf If Left(Euro$, 1) <> "0" And ValF(Cash$) = 0 ProcedureReturn #False EndIf If Val(Cent$) < 0 Or Val(Cent$) > 99 ProcedureReturn #False EndIf ProcedureReturn #True EndProcedure Procedure IsDate(GID.i, Value$) Define Date$, Day.i, Month.i, Year.i If Value$ = "" : ProcedureReturn #True : EndIf Date$ = _GetDateString(GID, Value$, #FullDate, "%dd|%mm|%yyyy") Day = Val(StringField(Date$, 1, "|")) Month = Val(StringField(Date$, 2, "|")) Year = Val(StringField(Date$, 3, "|")) If Day < 1 Or Day > 31 : ProcedureReturn #False : EndIf If Month < 1 Or Month > 12 : ProcedureReturn #False : EndIf If Year < 0 Or StringField(Date$, 3, "|") = "" ProcedureReturn #False EndIf Select Month Case 2 If Day > 29 : ProcedureReturn #False : EndIf Case 4, 6, 9, 11 If Day > 30 : ProcedureReturn #False : EndIf Case 1, 3, 5, 7, 8, 10, 12 If Day > 31 : ProcedureReturn #False : EndIf EndSelect ProcedureReturn #True EndProcedure Procedure IsTime(GID.i, Value$) Define Time$, Hour.i, Minute.i, Second.i If Value$ = "" : ProcedureReturn #True : EndIf Time$ = _GetTimeString(GID, Value$, #FullTime, "%hh|%ii|%ss") Hour = Val(StringField(Time$, 1, "|")) Minute = Val(StringField(Time$, 2, "|")) Second = Val(StringField(Time$, 3, "|")) If Hour < 0 Or Hour > 24 : ProcedureReturn #False : EndIf If Minute < 0 Or Minute > 59 : ProcedureReturn #False : EndIf If Second < 0 Or Second > 59 : ProcedureReturn #False : EndIf ProcedureReturn #True EndProcedure Procedure IsGrade(GID.i, Value$, Lng$="") Define Value.i, Best.s, Worst.s If Value$ = "" : ProcedureReturn #True : EndIf If FindMapElement(Grades(), Lng$) Select Grades()\Flag Case #Number, #Points If IsInteger(GID, Value$) = #False : ProcedureReturn #False : EndIf Value = Val(Value$) If Grades()\Best < Grades()\Worst ; 1 - 6 If Value >= Grades()\Best And Value <= Grades()\Worst ProcedureReturn #True EndIf Else ; 12 - 0 If Value >= Grades()\Worst And Value <= Grades()\Best ProcedureReturn #True EndIf EndIf Case #Character Best = Str(Grades()\Best) Worst = Str(Grades()\Worst) If Grades()\Best < Grades()\Worst If Value$ >= Grades()\Notation(Best) And Value$ <= Grades()\Notation(Worst) ProcedureReturn #True EndIf Else If Value$ >= Grades()\Notation(Worst) And Value$ <= Grades()\Notation(Best) ProcedureReturn #True EndIf EndIf EndSelect EndIf ProcedureReturn #False EndProcedure Procedure IsContentValid(GID.i, Value$, CellFlags.i, Lng$="") If (CellFlags & #Check Or CellFlags & #Valid) And Value$ <> "" If CellFlags & #Integer If IsInteger(GID, Value$) : ProcedureReturn #True : EndIf ElseIf CellFlags & #Float Value$ = ReplaceString(Value$, Grid(Str(GID))\Format\DecimalPoint, ".") If IsFloat(Value$) : ProcedureReturn #True : EndIf ElseIf CellFlags & #Cash Value$ = ReplaceString(Value$, Grid(Str(GID))\Format\DecimalPoint, ".") If IsCash(GID, Value$) : ProcedureReturn #True : EndIf ElseIf CellFlags & #Date If IsDate(GID, Value$) : ProcedureReturn #True : EndIf ElseIf CellFlags & #Time If IsTime(GID, Value$) : ProcedureReturn #True : EndIf ElseIf CellFlags & #Grades If IsGrade(GID, Value$, Lng$) : ProcedureReturn #True : EndIf Else ProcedureReturn #True EndIf ProcedureReturn #False Else ProcedureReturn #True EndIf EndProcedure Procedure SetCellCheck(GID.i, Row.i, Col.i) If Row = #AnyRow ;{ Any row of Col AddCellFlag(GID, #Any, Col, #Check) ;} ElseIf Col = #AnyCol ;{ Any Col of row AddCellFlag(GID, Row, #Any, #Check) ;} Else ;{ Selected Row & Col AddCellFlag(GID, Row, Col, #Check) ;} EndIf EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Styles / Images ;----------------------------------------------------------------------------- Procedure.i InitStyle(GID.i, Row.i, Col.i) If FindMapElement(Grid(), Str(GID)) If Col = #AnyCol ;{ Any Col of row AddCellFlag(GID, Row, #Any, #Cell) If LastElement(Grid()\Style()) AddElement(Grid()\Style()) Grid()\Style()\Value("Align") = #PB_Default Grid()\Style()\Value("BackColor") = #PB_Default Grid()\Style()\Value("FrontColor") = #PB_Default Grid()\Style()\Value("Gradient") = #PB_Default Grid()\Style()\Value("EditMode") = #PB_Default Grid()\Style()\Value("Digits") = #PB_Default Grid()\Style()\Value("MarkFlag") = #PB_Default Grid()\Style()\Value("MarkColor") = #PB_Default Grid()\Style()\Value("MarkColor2") = #PB_Default Grid()\Style()\Font = "" Grid()\Style()\Language = "" Grid()\Style()\FormatMask = "" Grid()\Style()\MarkTerm = "" If Row = #Header Grid()\Cols(#Any)\Header\Style = ListIndex(Grid()\Style()) Else Grid()\Entry(Row)\Cell(#Any)\Style = ListIndex(Grid()\Style()) EndIf ProcedureReturn ListIndex(Grid()\Style()) EndIf ;} ElseIf Row = #AnyRow ;{ Any row of Col AddCellFlag(GID, #Any, Col, #Cell) If LastElement(Grid()\Style()) AddElement(Grid()\Style()) Grid()\Style()\Value("Align") = #PB_Default Grid()\Style()\Value("BackColor") = #PB_Default Grid()\Style()\Value("FrontColor") = #PB_Default Grid()\Style()\Value("Gradient") = #PB_Default Grid()\Style()\Value("EditMode") = #PB_Default Grid()\Style()\Value("Digits") = #PB_Default Grid()\Style()\Value("MarkFlag") = #PB_Default Grid()\Style()\Value("MarkColor") = #PB_Default Grid()\Style()\Value("MarkColor2") = #PB_Default Grid()\Style()\Font = "" Grid()\Style()\Language = "" Grid()\Style()\FormatMask = "" Grid()\Style()\MarkTerm = "" If Col = #Header Grid()\Rows(#Header)\Header\Style = ListIndex(Grid()\Style()) Else Grid()\Entry(#Any)\Cell(Col)\Style = ListIndex(Grid()\Style()) EndIf ProcedureReturn ListIndex(Grid()\Style()) EndIf ;} ElseIf Row >= 0 And Col >= 0 ;{ Cell(row:col) AddCellFlag(GID, Row, Col, #Cell) If LastElement(Grid()\Style()) AddElement(Grid()\Style()) Grid()\Style()\Value("Align") = #PB_Default Grid()\Style()\Value("BackColor") = #PB_Default Grid()\Style()\Value("FrontColor") = #PB_Default Grid()\Style()\Value("Gradient") = #PB_Default Grid()\Style()\Value("EditMode") = #PB_Default Grid()\Style()\Value("Digits") = #PB_Default Grid()\Style()\Value("MarkFlag") = #PB_Default Grid()\Style()\Value("MarkColor") = #PB_Default Grid()\Style()\Value("MarkColor2") = #PB_Default Grid()\Style()\Font = "" Grid()\Style()\Language = "" Grid()\Style()\FormatMask = "" Grid()\Style()\MarkTerm = "" If Row = #Header Grid()\Cols(Col)\Header\Style = ListIndex(Grid()\Style()) ElseIf Col = #Header Grid()\Rows(Row)\Header\Style = ListIndex(Grid()\Style()) Else Grid()\Entry(Row)\Cell(Col)\Style = ListIndex(Grid()\Style()) EndIf EndIf ProcedureReturn ListIndex(Grid()\Style()) ;} EndIf EndIf ProcedureReturn #NoElement EndProcedure Procedure.i SelectCellsElement(GID.i, Row.i, Col.i) ; Cell(row:col) Define gid$ = Str(GID) Define ListIdx.i = #NoElement If Col = #AnyCol ;{ Any Col of row If Row = #Header ListIdx = Grid(gid$)\Cols(#Any)\Header\Style Else ListIdx = Grid(gid$)\Entry(Row)\Cell(#Any)\Style EndIf ;} ElseIf Row = #AnyRow ;{ Any row of Col If Col = #Header ListIdx = Grid(gid$)\Rows(#Any)\Header\Style Else ListIdx = Grid(gid$)\Entry(#Any)\Cell(Col)\Style EndIf ;} ElseIf Row >= 0 And Col >= 0 ;{ Cell(row:col) If Row = #Header ListIdx = Grid(gid$)\Cols(Col)\Header\Style ElseIf Col = #Header ListIdx = Grid(gid$)\Rows(Row)\Header\Style Else ListIdx = Grid(gid$)\Entry(Row)\Cell(Col)\Style EndIf ;} EndIf If ListIdx >= 0 And ListIdx < ListSize(Grid(gid$)\Style()) If SelectElement(Grid(gid$)\Style(), ListIdx) ProcedureReturn ListIdx EndIf EndIf ProcedureReturn #NoElement EndProcedure Procedure GetCellStyle(GID.i, Row.i, Col.i, *Style.Grid_Style_Structure) If FindMapElement(Grid(), Str(GID)) ;{ Load defaults form "Style 0" If FirstElement(Grid()\Style()) CopyMap(Grid()\Style()\Value(), *Style\Value()) *Style\Font = Grid()\Style()\Font *Style\FormatMask = Grid()\Style()\FormatMask *Style\MarkTerm = Grid()\Style()\MarkTerm *Style\Language = Grid()\Style()\Language EndIf ;} If Grid()\Entry(Row)\Cell(#Any)\Flags > 0 ;{ Any col of row If SelectCellsElement(GID, Row, #AnyCol) > 0 And Col <> #Header ForEach Grid()\Style()\Value() If Grid()\Style()\Value() <> #PB_Default *Style\Value(MapKey(Grid()\Style()\Value())) = Grid()\Style()\Value() EndIf Next If Grid()\Style()\Font <> "" : *Style\Font = Grid()\Style()\Font : EndIf If Grid()\Style()\FormatMask <> "" : *Style\FormatMask = Grid()\Style()\FormatMask : EndIf If Grid()\Style()\MarkTerm <> "" : *Style\MarkTerm = Grid()\Style()\MarkTerm : EndIf If Grid()\Style()\Language <> "" : *Style\Language = Grid()\Style()\Language : EndIf EndIf EndIf ;} If Grid()\Entry(#Any)\Cell(Col)\Flags <> #PB_Default ;{ Any row of col If SelectCellsElement(GID, #AnyRow, Col) > 0 And Row <> #Header ForEach Grid()\Style()\Value() If Grid()\Style()\Value() <> #PB_Default *Style\Value(MapKey(Grid()\Style()\Value())) = Grid()\Style()\Value() EndIf Next If Grid()\Style()\Font <> "" : *Style\Font = Grid()\Style()\Font : EndIf If Grid()\Style()\FormatMask <> "" : *Style\FormatMask = Grid()\Style()\FormatMask : EndIf If Grid()\Style()\MarkTerm <> "" : *Style\MarkTerm = Grid()\Style()\MarkTerm : EndIf If Grid()\Style()\Language <> "" : *Style\Language = Grid()\Style()\Language : EndIf EndIf EndIf ;} If SelectCellsElement(GID, Row, Col) > 0 ;{ Current cell ForEach Grid()\Style()\Value() If Grid()\Style()\Value() <> #PB_Default *Style\Value(MapKey(Grid()\Style()\Value())) = Grid()\Style()\Value() EndIf If Grid()\Style()\Font <> "" : *Style\Font = Grid()\Style()\Font : EndIf If Grid()\Style()\FormatMask <> "" : *Style\FormatMask = Grid()\Style()\FormatMask : EndIf If Grid()\Style()\MarkTerm <> "" : *Style\MarkTerm = Grid()\Style()\MarkTerm : EndIf If Grid()\Style()\Language <> "" : *Style\Language = Grid()\Style()\Language : EndIf Next EndIf ;} EndIf EndProcedure Procedure.i AddImage(GID.i, File$) Define.i ImageID If FindMapElement(Grid(), Str(GID)) ImageID = LoadImage(#PB_Any, File$) If ImageID AddMapElement(Grid()\Image(), LCase(GetFilePart(File$))) Grid()\Image()\ID = ImageID Grid()\Image()\File = File$ ProcedureReturn ImageID EndIf EndIf ProcedureReturn #False EndProcedure Procedure.i SelectImage(GID.i, File$) Define.i ImageID If FindMapElement(Grid(), Str(GID)) If FindMapElement(Grid()\Image(), LCase(GetFilePart(File$))) ProcedureReturn Grid()\Image()\ID Else ImageID = AddImage(GID, File$) If ImageID ProcedureReturn ImageID EndIf EndIf EndIf ProcedureReturn #NoElement EndProcedure Procedure.i GetCellImage(GID.i, Row.i, Col.i) Define Image$, ImageID, Flags.i If FindMapElement(Grid(), Str(GID)) If Row = #Header Flags = Grid()\Cols(Col)\Header\Flags If Flags & #Image Image$ = Grid()\Cols(Col)\Header\Image ProcedureReturn SelectImage(GID, Image$) EndIf ElseIf Col = #Header Flags = Grid()\Rows(Row)\Header\Flags If Flags & #Image Image$ = Grid()\Rows(Row)\Header\Image ProcedureReturn SelectImage(GID, Image$) EndIf Else If IsCellFlag(GID, #Any, Col, #Image) Image$ = Grid()\Entry(#Any)\Cell(Col)\Image ProcedureReturn SelectImage(GID, Image$) EndIf If IsCellFlag(GID, Row, #Any, #Image) Image$ = Grid()\Entry(Row)\Cell(#Any)\Image ProcedureReturn SelectImage(GID, Image$) EndIf If IsCellFlag(GID, Row, Col, #Image) Image$ = Grid()\Entry(Row)\Cell(Col)\Image ProcedureReturn SelectImage(GID, Image$) EndIf EndIf EndIf ProcedureReturn #NoResult EndProcedure Procedure AddFont(GID.i, Font$) Define.i FontID, Size, Flags Define.s Name If FindMapElement(Grid(), Str(GID)) Name = StringField(Font$, 1, "|") Size = Val(StringField(Font$, 2, "|")) Flags = Val(StringField(Font$, 3, "|")) FontID = LoadFont(#PB_Any, Name, Size, Flags) If FontID Grid()\Font(Font$) = FontID ProcedureReturn FontID EndIf EndIf ProcedureReturn #False EndProcedure Procedure SelectFont(GID.i, Font$) Define.i FontId If FindMapElement(Grid(), Str(GID)) If FindMapElement(Grid()\Font(), Font$) ProcedureReturn Grid()\Font() Else FontId = AddFont(GID, Font$) If FontID ProcedureReturn FontId EndIf EndIf EndIf ProcedureReturn #NoElement EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Drawing ;----------------------------------------------------------------------------- Declare.i _GridToScrolls(GID.i) Declare.i _AdjustScrolls(GID.i) Procedure.i DrawCellText(Text$, X.i, Y.i, Width.i, Height.i, Align=#False, Wrap=#False) Define.i x1, x2, y1, y2, marginX, actW, marginY, actH Define.i i, j, txtLen, txtW, txtH, x0, w0, h0, lines Define.i drawnSome, iWrd, nWrd Define.s cc NewList tWrd.s() marginX = #Text_MarginX ; default X-horizontal margin left/right marginY = #Text_MarginY ; default Y-vertical margin up/down actW = Width - 2 * marginX ; actual given width for drawing actH = Height - 2 * marginY ; actual given height for drawing txtLen = Len(Text$) If (actW <= 0) Or (actH <= 0) Or (txtLen <= 0) : ProcedureReturn #False : EndIf txtW = TextWidth(Text$) txtH = TextHeight(Text$) If actH < txtH : ProcedureReturn #False : EndIf If txtW <= actW ; we have enough room to write straight forward ... If Align = #Left x1 = X + marginX ElseIf Align = #Right x1 = X + marginX + (actW - txtW) ElseIf Align = #Center x1 = X + marginX + ((actW - txtW)/2) EndIf y1 = Y + marginY + ((actH - txtH)/2) DrawText(x1, y1, Text$) ProcedureReturn #False Else x1 = X + marginX : x2 = x1 + actW If Wrap = #False DrawText(x1, y1, Mid(Text$, 1, _PosTextToWidth(Text$, actW))) Else ; we need to wrap text on another line(s) ... when wrapping we do not consider alignment (for now!) y1 = Y + marginY : y2 = Y + height - marginY lines = Round(txtW/actW ,#PB_Round_Up) If actH - (lines*txtH) > 0 y1 = y1 + ((actH - (lines*txtH))/2) EndIf nWrd = _ExtractFields(Text$, " ", tWrd()) ForEach tWrd() x1 = DrawText(x1, y1, " ") ; 3 cases ; 1. enough room in avaliable width on current line ; 2. no enough room but a new line can hold the whole word ; 3. even a new line cant hold the word we split it on many lines txtW = TextWidth(tWrd()) If txtW <= (x2-x1) x1 = DrawText(x1, y1, tWrd()) drawnSome = #True Else ; move to a new line If drawnSome y1 = y1 + txtH : x1 = X + marginX EndIf If y1+txtH > y2 : Break : EndIf If txtW <= actW x1 = DrawText(x1,y1,tWrd()) : drawnSome = 1 Else txtLen = _PosTextToWidth(tWrd(), x2-x1) If txtLen > 0 x1 = DrawText(x1, y1, Mid(tWrd(), 1, txtLen)) : drawnSome = 1 tWrd() = Mid(tWrd(), txtLen + 1) EndIf EndIf EndIf If y1+txtH > y2 : Break : EndIf Next EndIf EndIf EndProcedure Procedure.i DrawCheckBox(X.i, Y.i, Width.i, Height.i, boxWidth.i, checked, borderColor.i) ; Draw a check-box /(X,Y,Width,Height) in the area given for drawing checkbox... assumes a StartDrawing! Define.i ww, hh, x0, y0, xa, ya, xb, yb, xc, yc ww = boxWidth hh = boxWidth If ww <= Width And hh <= Height x0 = X + ((Width - ww) / 2) y0 = Y + ((Height - hh) / 2) DrawingMode(#PB_2DDrawing_Default) Box(x0, y0, ww, hh, borderColor) Box(x0+1, y0+1, ww-2, hh-2, $D4D4D4) Box(x0+2, y0+2, ww-4, hh-4, $FFFFFF) If checked xb = x0 + (ww / 2) - 1 : yb = y0 + hh - 5 xa = x0 + 4 : ya = yb - xb + xa xc = x0 + ww - 4 : yc = yb + xb - xc FrontColor($C95718) ; color of the check mark LineXY(xb, yb, xa, ya) : LineXY(xb, yb, xc, yc) LineXY(xb, yb-1, xa, ya-1) : LineXY(xb, yb-1, xc, yc-1) ; move up by 1 LineXY(xb, yb-2, xa, ya-2) : LineXY(xb, yb-2, xc, yc-2) ; move up by 2 EndIf EndIf EndProcedure Procedure.i DrawArrowDown(X.i, Y.i, Width.i, Height.i, clr = $600000) ; draw a combo-box-arrow ... assumes a StartDrawing! Define.i xx, yy, ww, hh ; box coord and dimensions ww = 16 hh = 4 If ww < Width And hh < Height DrawingMode(#PB_2DDrawing_Default) xx = x + Width - ww + 1 ww = ww - 4 yy = (y+2) + (Height-8)/2 LineXY(xx + 2, yy + 1, xx + ww - 3, yy + 1, clr) LineXY(xx + 3, yy + 2, xx + ww - 4, yy + 2, clr) LineXY(xx + 4, yy + 3, xx + ww - 5, yy + 3, clr) LineXY(xx + 5, yy + 4, xx + ww - 6, yy + 4, clr) EndIf EndProcedure Procedure.i DrawArrowUp(X, Y, Width, Height, clr=$600000) ; draw a combo-box-arrow ... assumes a StartDrawing! Define.i xx, yy, ww, hh ; box coord and dimensions ww = 16 hh = 4 If ww < Width And hh < Height DrawingMode(#PB_2DDrawing_Default) xx = x + Width - ww + 1 ww = ww - 4 yy = (y+1) + (Height-8)/2 LineXY(xx + 2, yy + 4, xx + ww -3, yy + 4, clr) LineXY(xx + 3, yy + 3, xx + ww -4, yy + 3, clr) LineXY(xx + 4, yy + 2, xx + ww -5, yy + 2, clr) LineXY(xx + 5, yy + 1, xx + ww -6, yy + 1, clr) EndIf EndProcedure Procedure.i DrawCombo(X.i, Y.i, Width.i, Height.i) ; draw a combo-box-arrow ... assumes a StartDrawing! DrawArrowDown(X, Y, Width, Height) EndProcedure Procedure.i DrawButton(X.i, Y.i, Width.i, Height.i, bClr.i) ; draw a clickable button DrawingMode(#PB_2DDrawing_Default) Box(X, Y, Width, Height, #White) BackColor(_BlendColor(RGB(255, 255, 255), bClr, 70)) FrontColor(bClr) LinearGradient(X, Y, X, Y+Height) DrawingMode(#PB_2DDrawing_Gradient) Box(X+1, Y+1, Width-2, Height-2) EndProcedure ;- ------------------------------------------------------------------------------ Procedure.i DrawSingleCell(GID.i, Row.i, Col.i) ; basic routine called by higher ones: .......... assumes StartDrawing() ; DrawCurrentCell() / Draw() Define.i X, Y, Width, Height, W1, H1, bY, rX, FontID Define.i RowArea, ColArea, Image, newImage, Marked Define CellFlags.i, Cell$ Define Style.Grid_Style_Structure If FindMapElement(Grid(), Str(GID)) RowArea = _Area_Of_Row(GID, Row) ColArea = _Area_Of_Col(GID, Col) If RowArea < 0 Or ColArea < 0 : ProcedureReturn #False : EndIf SelectElement(Grid()\Col\AreaList(), ColArea) SelectElement(Grid()\Row\AreaList(), RowArea) X = Grid()\Col\AreaList()\X Y = Grid()\Row\AreaList()\Y Width = Grid()\Col\AreaList()\Width Height = Grid()\Row\AreaList()\Height GetCellStyle(GID, Row, Col, @Style) CellFlags = GetCellFlags(GID, Row, Col) Cell$ = _GetCellText(GID, Row, Col) If Style\Value("Gradient") > 0 DrawingMode(#PB_2DDrawing_Gradient) BackColor($F0F0F0) FrontColor(Style\Value("BackColor")) LinearGradient(X, Y, X, Y+Height/2) Box(X, Y, Width, Height) Else DrawingMode(#PB_2DDrawing_Default) If CellFlags & #Check If IsContentValid(GID, Cell$, CellFlags, Style\Language) = #False Box(X, Y, Width, Height, _BlendColor(Grid()\Color\GridBack, Grid()\Color\Mistake, 90)) EndIf Else Box(X, Y, Width, Height, Style\Value("BackColor")) EndIf EndIf DrawingMode(#PB_2DDrawing_Outlined) If Row = #Label Or Col = #Label Box(X, Y, Width, Height, Grid()\Color\LabelBorder) Else Box(X, Y, Width, Height, Grid()\Color\GridLine) EndIf If CellFlags & #Frame Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Style\Value("BackColor"), Style\Value("FrameColor"), 40)) EndIf If CellFlags & #Check ;{ Check cell content If IsContentValid(GID, Cell$, CellFlags, Style\Language) = #False Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Grid()\Color\GridLine, Grid()\Color\Mistake, 70)) Box(X+2, Y+2, Width-4, Height-4, Grid()\Color\Mistake) EndIf EndIf ;} If CellFlags & #Checkbox ;{ Checkbox DrawingMode(#PB_2DDrawing_Default) DrawCheckBox(X, Y, Width, Height, #CheckBox_Width, Val(Cell$), #CheckBox_Color) ;} ElseIf CellFlags & #Button ;{ Button DrawButton(X+1, Y+1, Width-2, Height-2, Style\Value("BackColor")) DrawingMode(#PB_2DDrawing_Transparent) FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf FrontColor(Style\Value("FrontColor")) DrawCellText(Cell$, X, Y, Width, Height, Style\Value("Align"), Grid()\WrapText) ;} ElseIf CellFlags & #Combo ;{ Combobox DrawingMode(#PB_2DDrawing_Transparent) FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf FrontColor(Style\Value("FrontColor")) DrawCellText(Cell$, X, Y, Width-16, Height, Style\Value("Align"), Grid()\WrapText) DrawingMode(#PB_2DDrawing_Default) DrawCombo(X, Y, Width, Height) ;} ElseIf CellFlags & #Image ;{ Image Image = GetCellImage(GID, Row, Col) If IsImage(Image) DrawingMode(#PB_2DDrawing_Default) If Style\Value("Align") = #Align_Fit DrawImage(ImageID(Image), X+2, Y+2, Width-4, Height-4) Else If ImageWidth(Image) <= Width And ImageHeight(Image) <= Height W1 = (Width - ImageWidth(Image)) / 2 H1 = (Height - ImageHeight(Image)) / 2 DrawImage(ImageID(Image), X + W1, Y + H1) Else newImage = GrabImage(Image, #PB_Any, 0,0, Width, Height) If newImage DrawImage(ImageID(newImage), X, Y) FreeImage(newImage) EndIf EndIf EndIf EndIf ;} Else ;{ Cell If Row = #Header And Grid()\Sort\Column = Col ;{ Mark sorted column (#Arrow) If CellFlags & #Sort And Grid()\Sort\Flag & #Arrow If Grid()\Sort\Direction = #PB_Sort_Ascending And Col > 0 DrawArrowUp(X, Y, Width, Height, _BlendColor(Style\Value("FrontColor"), Style\Value("BackColor"), 50)) ElseIf Grid()\Sort\Direction = #PB_Sort_Descending And Col > 0 DrawArrowDown(X, Y, Width, Height, _BlendColor(Style\Value("FrontColor"), Style\Value("BackColor"), 50)) EndIf EndIf EndIf ;} DrawingMode(#PB_2DDrawing_Transparent) ; --- Font --- If Row = #Header And Grid()\Sort\Column = Col ;{ Mark sorted column (#Font) If CellFlags & #Sort And Grid()\Sort\Flag & #Font And IsFont(Grid()\Font(Grid()\Sort\Font)) Style\Font = Grid()\Sort\Font EndIf EndIf ;} FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf ; --- Color --- If Row = #Header And Grid()\Sort\Column = Col ;{ Mark sorted column (#Color) If CellFlags & #Sort And Grid()\Sort\Flag & #Color Style\Value("FrontColor") = Grid()\Sort\Color EndIf EndIf ;} If CellFlags & #Mark And Row <> #Header ;{ Mark cell (Color) Marked = _IsMarked(GID, Row, Col, Cell$, Style\MarkTerm, Style\Value("MarkFlag")) Select Marked Case #Condition1 Style\Value("FrontColor") = Style\Value("MarkColor") Case #Condition2 Style\Value("FrontColor") = Style\Value("MarkColor2") EndSelect EndIf ;} FrontColor(Style\Value("FrontColor")) ; --- Formatting --- If CellFlags & #Format And Row <> #Header ;{ Format cell content Cell$ = _FormatCell(GID, Cell$, CellFlags, @Style, Style\FormatMask) EndIf ;} ; --- Drawing --- DrawCellText(Cell$, X, Y, Width, Height, Style\Value("Align"), Grid()\WrapText) ;} EndIf ;{ ----- Draw extra lines ----- If Col > 0 If FindMapElement(Grid()\Lines\Top(), Str(Row)) ; #Horizontal|#Top If Grid()\Lines\Top()\Last = #Any Or (Col >= Grid()\Lines\Top()\First And Col <= Grid()\Lines\Top()\Last) Box(X, Y, Width, Grid()\Lines\Top()\Thickness, Grid()\Lines\Top()\Color) EndIf ElseIf FindMapElement(Grid()\Lines\Bottom(), Str(Row)) ; #Horizontal|#Bottom If Grid()\Lines\Bottom()\Last = #Any Or (Col >= Grid()\Lines\Bottom()\First And Col <= Grid()\Lines\Bottom()\Last) bY = Y + Height - 1 Box(X, bY, Width, Grid()\Lines\Bottom()\Thickness, Grid()\Lines\Bottom()\Color) EndIf EndIf EndIf If Row > 0 If FindMapElement(Grid()\Lines\Left(), Str(Col)) ; #Vertical|#Left If Grid()\Lines\Left()\Last = #Any Or (Row >= Grid()\Lines\Left()\First And Row <= Grid()\Lines\Left()\Last) Box(X, Y, Grid()\Lines\Left()\Thickness, Height, Grid()\Lines\Left()\Color) EndIf ElseIf FindMapElement(Grid()\Lines\Right(), Str(Col)) ; #Vertical|#Right If Grid()\Lines\Right()\Last = #Any Or (Row >= Grid()\Lines\Right()\First And Row <= Grid()\Lines\Right()\Last) rX = X + Width - 1 Box(rX, Y, Grid()\Lines\Right()\Thickness, Height, Grid()\Lines\Right()\Color) EndIf EndIf EndIf ;} If Row = 1 : Line(X, Y, Width, 1, Grid()\Color\LabelBorder) : EndIf If Col = 1 : Line(X, Y, 1, Height, Grid()\Color\LabelBorder) : EndIf If FindMapElement(Grid()\Cell\Selected(),Str(Row)+"|"+Str(Col)) DrawingMode(#PB_2DDrawing_AlphaBlend) Box(X+1, Y+1, Width-2, Height-2, Grid()\Color\BlockBack) DrawingMode(#PB_2DDrawing_Outlined) Box(X+1, Y+1, Width-2, Height-2, Grid()\Color\FocusBorder) EndIf EndIf EndProcedure Procedure.i DrawMultiCell(GID.i, MultiIdx.i) ; basic routine called by higher ones: .......... assumes StartDrawing() Define.i Row, Col, X, Y, Width, Height, W1, H1, rX, bY Define.i Image, newImage, Marked, FontID Define CellFlags.i, Cell$ Define Style.Grid_Style_Structure, Block.Rectangle_Structure If FindMapElement(Grid(), Str(GID)) SelectElement(Grid()\MultiCellList(), MultiIdx) If Not _RectCoord(GID, Grid()\MultiCellList()\Row1, Grid()\MultiCellList()\Col1, Grid()\MultiCellList()\Row2, Grid()\MultiCellList()\Col2, @Block) ProcedureReturn #False EndIf X = Block\X Y = Block\Y Width = Block\Width Height = Block\Height Row = Grid()\MultiCellList()\Row1 Col = Grid()\MultiCellList()\Col1 GetCellStyle(GID, Row, Col, @Style) CellFlags = GetCellFlags(GID, Row, Col) Cell$ = _GetCellText(GID, Row, Col) If Style\Value("Gradient") > 0 DrawingMode(#PB_2DDrawing_Gradient) BackColor($F0F0F0) : FrontColor(Style\Value("BackColor")) LinearGradient(X, Y, X, Y+Height/2) Box(X, Y, Width, Height) Else DrawingMode(#PB_2DDrawing_Default) If CellFlags & #Check If IsContentValid(GID, Cell$, CellFlags, Style\Language) = #False Box(X, Y, Width, Height, _BlendColor(Grid()\Color\GridBack, Grid()\Color\Mistake, 90)) EndIf Else Box(X, Y, Width, Height, Style\Value("BackColor")) EndIf EndIf DrawingMode(#PB_2DDrawing_Outlined) If Row = #Label Or Col = #Label Box(X, Y, Width, Height, Grid()\Color\LabelBorder) Else Box(X, Y, Width, Height, Grid()\Color\GridLine) EndIf If CellFlags & #Frame Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Style\Value("BackColor"), Style\Value("FrameColor"), 40)) EndIf If CellFlags & #Check ;{ Check cell content If IsContentValid(GID, Cell$, CellFlags, Style\Language) = #False Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Grid()\Color\GridLine, Grid()\Color\Mistake, 70)) Box(X+2, Y+2, Width-4, Height-4, Grid()\Color\Mistake) EndIf EndIf ;} If CellFlags & #Checkbox ;{ Checkbox DrawingMode(#PB_2DDrawing_Default) DrawCheckBox(X, Y, Width, Height, #CheckBox_Width, Val(Cell$), #CheckBox_Color) ;} ElseIf CellFlags & #Button ;{ Button DrawButton(X+1, Y+1, Width-2, Height-2, Style\Value("BackColor")) DrawingMode(#PB_2DDrawing_Transparent) FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf FrontColor(Style\Value("FrontColor")) DrawCellText(Cell$, X, Y, Width, Height, Style\Value("Align"), Grid()\WrapText) ;} ElseIf CellFlags & #Combo ;{ Combobox DrawingMode(#PB_2DDrawing_Transparent) FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf FrontColor(Style\Value("FrontColor")) DrawCellText(Cell$, X, Y, Width - 16, Height, Style\Value("Align"), Grid()\WrapText) DrawingMode(#PB_2DDrawing_Default) DrawCombo(X, Y, Width, Height) ;} ElseIf CellFlags & #Image And Row > #Header And Col > #Header ;{ Image Image = GetCellImage(GID, Row, Col) If IsImage(Image) DrawingMode(#PB_2DDrawing_Default) If Style\Value("Align") = #Align_Fit DrawImage(ImageID(Image), X+2, Y+2, Width-4, Height-4) Else If ImageWidth(Image) <= Width And ImageHeight(Image) <= Height W1 = (Width - ImageWidth(Image)) / 2 H1 = (Height - ImageHeight(Image)) / 2 DrawImage(ImageID(Image), X + W1, Y + H1) Else newImage = GrabImage(Image, #PB_Any, 0,0, Width, Height) If newImage DrawImage(ImageID(newImage), X, Y) FreeImage(newImage) EndIf EndIf EndIf EndIf ;} Else ;{ Cell If Row = #Header And Grid()\Sort\Column = Col ;{ Mark sorted column (#Arrow/#Char) If CellFlags & #Sort And Grid()\Sort\Flag & #Arrow If Grid()\Sort\Direction = #PB_Sort_Ascending DrawArrowUp(X, Y, Width, Height, _BlendColor(Style\Value("FrontColor"), Style\Value("BackColor"), 50)) ElseIf Grid()\Sort\Direction = #PB_Sort_Descending DrawArrowDown(X, Y, Width, Height, _BlendColor(Style\Value("FrontColor"), Style\Value("BackColor"), 50)) EndIf EndIf EndIf ;} DrawingMode(#PB_2DDrawing_Transparent) ; --- Font --- If Row = #Header And Grid()\Sort\Column = Col ;{ Mark sorted column (#Font) If CellFlags & #Sort And Grid()\Sort\Flag & #Font And IsFont(Grid()\Font(Grid()\Sort\Font)) Style\Font = Grid()\Sort\Font EndIf EndIf ;} FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf ; --- Color --- If Row = #Header And Grid()\Sort\Column = Col ;{ Mark sorted column (#Color) If CellFlags & #Sort And Grid()\Sort\Flag & #Color Style\Value("FrontColor") = Grid()\Sort\Color EndIf EndIf ;} If CellFlags & #Mark And Row <> #Header ;{ Mark cell (Color) Marked = _IsMarked(GID, Row, Col, Cell$, Style\MarkTerm, Style\Value("MarkFlag")) Select Marked Case #Condition1 Style\Value("FrontColor") = Style\Value("MarkColor") Case #Condition2 Style\Value("FrontColor") = Style\Value("MarkColor2") EndSelect EndIf ;} FrontColor(Style\Value("FrontColor")) ; --- Formatting --- If CellFlags & #Format And Row <> #Header ;{ Format cell content Cell$ = _FormatCell(GID, Cell$, CellFlags, @Style, Style\FormatMask) EndIf ;} ; --- Drawing --- DrawCellText(Cell$, X, Y, Width, Height, Style\Value("Align"), Grid()\WrapText) ;} EndIf ;{ ----- Draw extra lines ----- If Col > 0 If FindMapElement(Grid()\Lines\Top(), Str(Row)) ; #Horizontal|#Top If Grid()\Lines\Top()\Last = #Any Or (Col >= Grid()\Lines\Top()\First And Col <= Grid()\Lines\Top()\Last) Box(X, Y, Width, Grid()\Lines\Top()\Thickness, Grid()\Lines\Top()\Color) EndIf ElseIf FindMapElement(Grid()\Lines\Bottom(), Str(Row)) ; #Horizontal|#Bottom If Grid()\Lines\Bottom()\Last = #Any Or (Col >= Grid()\Lines\Bottom()\First And Col <= Grid()\Lines\Bottom()\Last) bY = Y + Height - 1 Box(X, bY, Width, Grid()\Lines\Bottom()\Thickness, Grid()\Lines\Bottom()\Color) EndIf EndIf EndIf If Row > 0 If FindMapElement(Grid()\Lines\Left(), Str(Col)) ; #Vertical|#Left If Grid()\Lines\Left()\Last = #Any Or (Row >= Grid()\Lines\Left()\First And Row <= Grid()\Lines\Left()\Last) Box(X, Y, Grid()\Lines\Left()\Thickness, Height, Grid()\Lines\Left()\Color) EndIf ElseIf FindMapElement(Grid()\Lines\Right(), Str(Col)) ; #Vertical|#Right If Grid()\Lines\Right()\Last = #Any Or (Row >= Grid()\Lines\Right()\First And Row <= Grid()\Lines\Right()\Last) rX = X + Width - 1 Box(rX, Y, Grid()\Lines\Right()\Thickness, Height, Grid()\Lines\Right()\Color) EndIf EndIf EndIf ;} If Row = 1 : Line(X, Y, Width, 1, Grid()\Color\LabelBorder) : EndIf If Col = 1 : Line(X, Y, 1, Height, Grid()\Color\LabelBorder) : EndIf Debug "-> "+Str(Row)+" / "+Str(Col) If FindMapElement(Grid()\Cell\Selected(), Str(Row)+"|"+Str(Col)) DrawingMode(#PB_2DDrawing_AlphaBlend) Box(X+1, Y+1, Width-2, Height-2, Grid()\Color\BlockBack) DrawingMode(#PB_2DDrawing_Outlined) Box(X+1, Y+1, Width-2, Height-2, Grid()\Color\FocusBorder) EndIf EndIf EndProcedure ;- ------------------------------------------------------------------------------ Procedure.i DrawCell(GID.i, Row.i, Col.i) Define.i MultiIdx MultiIdx = _MultiOfCell(GID, Row, Col) If MultiIdx >= 0 DrawMultiCell(GID, MultiIdx) Else DrawSingleCell(GID, Row, Col) EndIf EndProcedure Procedure.i DrawFocus(GID.i) ; draws rectangle focus in current cell Define X, Y, Width, Height, RowArea, ColArea, MultiIdx Define Block.Rectangle_Structure If FindMapElement(Grid(), Str(GID)) If Grid()\Color\FocusBorder < 0 : ProcedureReturn #False : EndIf If _HasBlock(GID) DrawingMode(#PB_2DDrawing_Outlined) X = Grid()\Block\X Y = Grid()\Block\Y Width = Grid()\Block\Width Height = Grid()\Block\Height Box(X, Y, Width, Height, Grid()\Color\FocusBorder) Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Grid()\Color\FocusBorder, Grid()\Color\GridLine)) Else MultiIdx = _MultiOfCell(GID, Grid()\Row\Current, Grid()\Col\Current) If MultiIdx < 0 RowArea = _Area_Of_Row(GID, Grid()\Row\Current) ColArea = _Area_Of_Col(GID, Grid()\Col\Current) If RowArea >= 0 And ColArea >= 0 If SelectElement(Grid()\Col\AreaList(), ColArea) If SelectElement(Grid()\Row\AreaList(), RowArea) DrawingMode(#PB_2DDrawing_Outlined) X = Grid()\Col\AreaList()\X Y = Grid()\Row\AreaList()\Y Width = Grid()\Col\AreaList()\Width Height = Grid()\Row\AreaList()\Height Box(X, Y, Width, Height, Grid()\Color\FocusBorder) Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Grid()\Color\FocusBorder, Grid()\Color\GridLine)) EndIf EndIf EndIf Else SelectElement(Grid()\MultiCellList(), MultiIdx) If _RectCoord(GID, Grid()\MultiCellList()\Row1, Grid()\MultiCellList()\Col1, Grid()\MultiCellList()\Row2, Grid()\MultiCellList()\Col2, @Block) DrawingMode(#PB_2DDrawing_Outlined) X = Block\X Y = Block\Y Width = Block\Width Height = Block\Height Box(X, Y, Width, Height, Grid()\Color\FocusBorder) Box(X+1, Y+1, Width-2, Height-2, _BlendColor(Grid()\Color\FocusBorder, Grid()\Color\GridLine)) EndIf EndIf EndIf EndIf EndProcedure Procedure.i DrawCurrentCell(GID.i) If FindMapElement(Grid(), Str(GID)) If StartDrawing(CanvasOutput(Grid()\GId\Canvas)) DrawCell(GID, Grid()\Row\Current, Grid()\Col\Current) DrawFocus(GID) StopDrawing() EndIf EndIf EndProcedure Procedure Draw(GID.i) Define.i X, Y, Width, Height, WW, HH, labelW, labelH Define.i Row, Col, RowArea, ColArea, MultiIdx Define Selected.Rectangle_Structure Dim tMltDone.i(0) If FindMapElement(Grid(), Str(GID)) If Grid()\NoRedraw = #True : ProcedureReturn #False : EndIf WW = Grid()\Size\Width HH = Grid()\Size\Height ; buildign screen areas before drawing _BuildAreas(GID) If Not StartDrawing(CanvasOutput(Grid()\GId\Canvas)) : ProcedureReturn #False : EndIf ResetGradientColors() ;{ 1. --- Drawing Backgrounds and Texts X = 0 : Width = WW Y = 0 : Height = HH FirstElement(Grid()\Style()) Box(X, Y, Width, Height, Grid()\Style()\Value("BackColor")) If ListSize(Grid()\MultiCellList()) = #False ForEach Grid()\Row\AreaList() Row = Grid()\Row\AreaList()\AreaRow ForEach Grid()\Col\AreaList() Col = Grid()\Col\AreaList()\AreaCol DrawSingleCell(GID, Row, Col) Next Next Else Dim tMltDone(ListSize(Grid()\MultiCellList())) ForEach Grid()\Row\AreaList() Row = Grid()\Row\AreaList()\AreaRow ForEach Grid()\Col\AreaList() Col = Grid()\Col\AreaList()\AreaCol MultiIdx = _MultiOfCell(GID, Row, Col) If MultiIdx >= 0 If tMltDone(MultiIdx) = 0 DrawMultiCell(GID, MultiIdx) tMltDone(MultiIdx) = 1 EndIf Else DrawSingleCell(GID, Row, Col) EndIf Next Next EndIf ;} ;{ 2. --- Drawing block if any If _HasBlock(GID) _BlockSize(GID) DrawingMode(#PB_2DDrawing_AlphaBlend) Box(Grid()\Block\X, Grid()\Block\Y, Grid()\Block\Width, Grid()\Block\Height, Grid()\Color\BlockBack) Else ForEach Grid()\Row\Selected() Row = Val(MapKey(Grid()\Row\Selected())) _RectCoord(GID, Row, 1, Row, Grid()\Col\LastVisible, @Selected) DrawingMode(#PB_2DDrawing_AlphaBlend) Box(Selected\X, Selected\Y, Selected\Width, Selected\Height, Grid()\Color\BlockBack) DrawingMode(#PB_2DDrawing_Outlined) Box(Selected\X, Selected\Y, Selected\Width, Selected\Height, Grid()\Color\FocusBorder) Next EndIf ;} ;{ 3. --- Grey-area back color DrawingMode(#PB_2DDrawing_Default) LastElement(Grid()\Col\AreaList()) LastElement(Grid()\Row\AreaList()) X = Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width Box(X, 0, WW - X, HH, Grid()\Color\GridBack) Y = Grid()\Row\AreaList()\Y + Grid()\Row\AreaList()\Height Box(0, Y, WW, HH - Y, Grid()\Color\GridBack) ;} DrawFocus(GID) StopDrawing() _GridToScrolls(GID) EndIf EndProcedure ;----------------------------------------------------------------------------- ;- Internal - Scrolling ;----------------------------------------------------------------------------- Declare CloseEdit(GID.i, Flag.i=#Modify) Declare CloseListView(GID.i) ; Return true if we need to redraw Procedure.i _RefreshCounters(GID.i) ; getting first/last Top/Visible Rows/Cols Define.i i, avl, act If FindMapElement(Grid(), Str(GID)) Grid()\Row\FirstVisible = 0 For i = 1 To Grid()\Row\Number If Grid()\Rows(i)\Height > 0 : Grid()\Row\FirstVisible = i : Break : EndIf Next Grid()\Row\LastVisible = 0 For i = Grid()\Row\Number To 1 Step -1 If Grid()\Rows(i)\Height > 0 : Grid()\Row\LastVisible = i : Break : EndIf Next Grid()\Row\FirstTop = 0 For i = Grid()\Row\LastFrozen + 1 To Grid()\Row\Number If Grid()\Rows(i)\Height > 0 : Grid()\Row\FirstTop = i : Break : EndIf Next Grid()\Row\LastTop = Grid()\Row\FirstTop avl = Grid()\Size\Height For i = 0 To Grid()\Row\LastFrozen If Grid()\Rows(i)\Height > 0 : avl = avl - (Grid()\Rows(i)\Height - 1) : EndIf Next If avl > 0 act = 0 For i = Grid()\Row\Number To Grid()\Row\FirstTop Step -1 If Grid()\Rows(i)\Height > 0 If act + (Grid()\Rows(i)\Height - 1) > avl : Break : EndIf act = act + (Grid()\Rows(i)\Height - 1) Grid()\Row\LastTop = i EndIf Next EndIf If Grid()\Row\TopCell < Grid()\Row\FirstTop : Grid()\Row\TopCell = Grid()\Row\FirstTop : EndIf If Grid()\Row\TopCell > Grid()\Row\LastTop : Grid()\Row\TopCell = Grid()\Row\LastTop : EndIf Grid()\Col\FirstVisible = 0 For i = 1 To Grid()\Col\Number If Grid()\Cols(i)\Width > 0 : Grid()\Col\FirstVisible = i : Break : EndIf Next Grid()\Col\LastVisible = 0 For i = Grid()\Col\Number To 1 Step -1 If Grid()\Cols(i)\Width > 0 : Grid()\Col\LastVisible = i : Break : EndIf Next Grid()\Col\FirstTop = 0 For i = Grid()\Col\LastFrozen + 1 To Grid()\Col\Number If Grid()\Cols(i)\Width > 0 : Grid()\Col\FirstTop = i : Break : EndIf Next Grid()\Col\LastTop = Grid()\Col\FirstTop avl = Grid()\Size\Width For i = 0 To Grid()\Col\LastFrozen If Grid()\Cols(i)\Width > 0 : avl = avl - (Grid()\Cols(i)\Width - 1) : EndIf Next If avl > 0 act = 0 For i = Grid()\Col\Number To Grid()\Col\FirstTop Step -1 If Grid()\Cols(i)\Width > 0 If act + (Grid()\Cols(i)\Width -1) > avl : Break : EndIf act = act + (Grid()\Cols(i)\Width - 1) Grid()\Col\LastTop = i EndIf Next EndIf If Grid()\Col\TopCell < Grid()\Col\FirstTop : Grid()\Col\TopCell = Grid()\Col\FirstTop : EndIf If Grid()\Col\TopCell > Grid()\Col\LastTop : Grid()\Col\TopCell = Grid()\Col\LastTop : EndIf EndIf EndProcedure Procedure _AdjustScrolls(GID.i) ; Scrolls settings, ideally we have: [FirstTop = minState] And [LastTop = maxState] and [StateFactor = 1] ; if we cant then we use proprtional: FirstTop = minState and LastTop = maxState ; Needs be called after any change in the number of visible Cols/Rows Define.i i, scrPage If FindMapElement(Grid(), Str(GID)) _RefreshCounters(GID) If IsGadget(Grid()\GId\HScroll) If Grid()\Col\LastTop <= #Scroll_Max ; LastTop = scrMax - scrPage + 1 ==> scrMax = LastTop + scrPage - 1 ; we have full match: CurTop = 1 * CurState scrPage = #Scroll_PageSize SetGadgetAttribute(Grid()\GId\HScroll, #PB_ScrollBar_Minimum, Grid()\Col\FirstTop) SetGadgetAttribute(Grid()\GId\HScroll, #PB_ScrollBar_PageLength, scrPage) SetGadgetAttribute(Grid()\GId\HScroll, #PB_ScrollBar_Maximum, Grid()\Col\LastTop + scrPage - 1) Grid()\Col\StateFactor = 1 Grid()\Col\ScrollMin = Grid()\Col\FirstTop Grid()\Col\ScrollMax = Grid()\Col\LastTop Else ; we have packet match: CurTop = Factor * CurState scrPage = #Scroll_PageSize SetGadgetAttribute(Grid()\GId\HScroll, #PB_ScrollBar_Minimum, Grid()\Col\FirstTop) SetGadgetAttribute(Grid()\GId\HScroll, #PB_ScrollBar_PageLength, scrPage) SetGadgetAttribute(Grid()\GId\HScroll, #PB_ScrollBar_Maximum, #Scroll_Max + scrPage - 1) Grid()\Col\StateFactor = (Grid()\Col\LastTop - Grid()\Col\FirstTop) / (#Scroll_Max - Grid()\Col\FirstTop) Grid()\Col\ScrollMin = Grid()\Col\FirstTop Grid()\Col\ScrollMax = #Scroll_Max EndIf EndIf If IsGadget(Grid()\GId\VScroll) If Grid()\Row\LastTop <= #Scroll_Max ; LastTop = scrMax - scrPage + 1 ==> scrMax = LastTop + scrPage - 1 ; we have full match: CurTop = 1 * CurState scrPage = #Scroll_PageSize SetGadgetAttribute(Grid()\GId\VScroll, #PB_ScrollBar_Minimum, Grid()\Row\FirstTop) SetGadgetAttribute(Grid()\GId\VScroll, #PB_ScrollBar_PageLength, scrPage) SetGadgetAttribute(Grid()\GId\VScroll, #PB_ScrollBar_Maximum, Grid()\Row\LastTop + scrPage - 1) Grid()\Row\StateFactor = 1 Grid()\Row\ScrollMin = Grid()\Row\FirstTop Grid()\Row\ScrollMax = Grid()\Row\LastTop Else ; we have packet match: CurTop = Factor * CurState scrPage = #Scroll_PageSize SetGadgetAttribute(Grid()\GId\VScroll, #PB_ScrollBar_Minimum, Grid()\Row\FirstTop) SetGadgetAttribute(Grid()\GId\VScroll, #PB_ScrollBar_PageLength, scrPage) SetGadgetAttribute(Grid()\GId\VScroll, #PB_ScrollBar_Maximum, #Scroll_Max + scrPage - 1) Grid()\Row\StateFactor = (Grid()\Row\LastTop - Grid()\Row\FirstTop) / (#Scroll_Max - Grid()\Row\FirstTop) Grid()\Row\ScrollMin = Grid()\Row\FirstTop Grid()\Row\ScrollMax = #Scroll_Max EndIf EndIf EndIf EndProcedure Procedure _GridToScrolls(GID.i) ; updates Scrolls are per Grid fields: TopCol / TopRow Define.i curState, curTop If FindMapElement(Grid(), Str(GID)) If IsGadget(Grid()\GId\HScroll) curTop = Grid()\Col\TopCell If Grid()\Col\FirstTop = Grid()\Col\LastTop Or curTop = Grid()\Col\FirstTop curState = Grid()\Col\ScrollMin ElseIf curTop = Grid()\Col\LastTop curState = Grid()\Col\ScrollMax Else If Grid()\Col\StateFactor : curState = Int(curTop / Grid()\Col\StateFactor) : EndIf EndIf SetGadgetState(Grid()\GId\HScroll , curState) EndIf If IsGadget(Grid()\GId\VScroll) curTop = Grid()\Row\TopCell If Grid()\Row\FirstTop = Grid()\Row\LastTop Or curTop = Grid()\Row\FirstTop curState = Grid()\Row\ScrollMin ElseIf curTop = Grid()\Row\LastTop curState = Grid()\Row\ScrollMax Else If Grid()\Row\StateFactor : curState = Int(curTop / Grid()\Row\StateFactor) : EndIf EndIf SetGadgetState(Grid()\GId\VScroll, curState) EndIf EndIf EndProcedure Procedure.i _ScrollsToGrid(GID.i, Flag.i) ; read scrolls states and update grid fields: TopCol/TopRow Define.i curPosition, curTop, ReDraw = #False If FindMapElement(Grid(), Str(GID)) Select Flag Case #Column If IsGadget(Grid()\GId\HScroll) ;{ Horizontal Scrollbar curPosition = GetGadgetState(Grid()\GId\HScroll) If curPosition = Grid()\Col\ScrollMin Or Grid()\Col\ScrollMax = Grid()\Col\ScrollMin curTop = Grid()\Col\FirstTop ElseIf curPosition = Grid()\Col\ScrollMax curTop = Grid()\Col\LastTop Else curTop = Grid()\Col\StateFactor * curPosition EndIf If curTop < Grid()\Col\TopCell ; moving right Repeat If Grid()\Cols(curTop)\Width > 0 : Break : EndIf If curTop <= Grid()\Col\FirstTop : Break : EndIf curTop = curTop - 1 ForEver ElseIf curTop > Grid()\Col\TopCell ; moving left Repeat If Grid()\Cols(curTop)\Width > 0 : Break : EndIf If curTop >= Grid()\Col\LastTop : Break : EndIf curTop = curTop + 1 ForEver EndIf If Grid()\Col\TopCell <> curTop Grid()\Col\TopCell = curTop ReDraw = #True EndIf EndIf ;} Case #Row If IsGadget(Grid()\GId\VScroll) ;{ Vertical Scrollbar curPosition = GetGadgetState(Grid()\GId\VScroll) If curPosition = Grid()\Row\ScrollMin Or Grid()\Row\ScrollMax = Grid()\Row\ScrollMin curTop = Grid()\Row\FirstTop ElseIf curPosition = Grid()\Row\ScrollMax curTop = Grid()\Row\LastTop Else curTop = Grid()\Row\StateFactor * curPosition EndIf If curTop < Grid()\Row\TopCell ; moving up Repeat If Grid()\Rows(curTop)\Height > 0 : Break : EndIf If curTop <= Grid()\Row\FirstTop : Break : EndIf curTop = curTop - 1 ForEver ElseIf curTop > Grid()\Row\TopCell ; moving down Repeat If Grid()\Rows(curTop)\Height > 0 : Break : EndIf If curTop >= Grid()\Row\LastTop : Break : EndIf curTop = curTop + 1 ForEver EndIf If Grid()\Row\TopCell <> curTop Grid()\Row\TopCell = curTop ReDraw = #True EndIf EndIf ;} EndSelect EndIf ProcedureReturn ReDraw EndProcedure Procedure _SynchronizeGridCols() ; internal event handler: update cols as per ColScroll ... requested by end-user Define ScrollGID.i = EventGadget(), GID.i GID = GetGadgetData(ScrollGID) If _ScrollsToGrid(GID, #Column) If Grid(Str(GID))\EditVisible : CloseEdit(GID) : EndIf If Grid(Str(GID))\ListView : CloseListView(GID) : EndIf Draw(GID) EndIf EndProcedure Procedure.i _SynchronizeGridRows() ; internal event handler: update rows as per RowScroll ... requested by end-user Define ScrollGID.i = EventGadget(), GID.i GID = GetGadgetData(ScrollGID) If _ScrollsToGrid(GID, #Row) If Grid(Str(GID))\EditVisible : CloseEdit(GID) : EndIf If Grid(Str(GID))\ListView : CloseListView(GID) : EndIf Draw(GID) EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Reading and writing cells ;----------------------------------------------------------------------------- Procedure SetRowData(GID.i, Row.i, Value.i) Grid(Str(GID))\Entry(Row)\RowData = Value EndProcedure Procedure.i GetRowData(GID.i, Row.i) ProcedureReturn Grid(Str(GID))\Entry(Row)\RowData EndProcedure Procedure SetRowText(GID.i, Row.i, Value$, ColSep$=#LF$) If _IsValidRow(GID.i, Row.i) _SetRowText(GID, Row, Value$, ColSep$) EndIf EndProcedure Procedure.s GetRowText(GID.i, Row.i, ColSep$=#LF$) If _IsValidRow(GID.i, Row.i) _GetRowText(GID, Row, ColSep$) EndIf EndProcedure Procedure SetCellText(GID.i, Row.i, Col.i, Value$) If _IsValidCell(GID, Row, Col) _SetCellText(GID, Row, Col, Value$) EndIf EndProcedure Procedure.s GetCellText(GID.i, Row.i, Col.i) If _IsValidCell(GID, Row, Col) ProcedureReturn _GetCellText(GID, Row, Col) EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Sort ;----------------------------------------------------------------------------- Procedure DefineSortRows(GID.i, First.i=#False, Last.i=#False) Define.i Rows If First >= Rows : ProcedureReturn #False : EndIf If Last <= 1 : ProcedureReturn #False : EndIf If FindMapElement(Grid(), Str(GID)) Rows = Grid()\Row\Number If First Grid()\Row\StartSort = First Else Grid()\Row\StartSort = 1 EndIf If Last Grid()\Row\EndSort = Last Else Grid()\Row\EndSort = Rows EndIf ProcedureReturn #True EndIf EndProcedure Procedure SetCurrency(GID.i, Value$=#DefaultCurrency) Grid(Str(GID))\Format\Currency = Value$ EndProcedure Procedure.s GetCurrency(GID.i) If Grid(Str(GID))\Format\Currency ProcedureReturn Grid(Str(GID))\Format\Currency Else ProcedureReturn #DefaultCurrency EndIf EndProcedure Procedure.s SortDEU(Text.s, Flags.i=#Lexikon) ; german charakters (DIN 5007) If Flags & #Lexikon Text = ReplaceString(Text, "Ä", "A") Text = ReplaceString(Text, "Ö", "O") Text = ReplaceString(Text, "Ü", "U") Text = ReplaceString(Text, "ä", "a") Text = ReplaceString(Text, "ö", "o") Text = ReplaceString(Text, "ü", "u") Text = ReplaceString(Text, "ß", "ss") ElseIf Flags & #Namen Text = ReplaceString(Text, "Ä", "Ae") Text = ReplaceString(Text, "Ö", "Oe") Text = ReplaceString(Text, "Ü", "Ue") Text = ReplaceString(Text, "ä", "ae") Text = ReplaceString(Text, "ö", "oe") Text = ReplaceString(Text, "ü", "ue") Text = ReplaceString(Text, "ß", "ss") EndIf ProcedureReturn Text EndProcedure Procedure.s GetSortString(GID.i, Row.i, Col.i, SortLen.i, Flags.i) Define Sort$ If FindMapElement(Grid(), Str(GID)) If Flags & #String Sort$ = SortDEU(Grid()\Entry(Row)\Cell(Col)\Value, Flags) ProcedureReturn LSet(Sort$, SortLen) ElseIf Flags & #Integer Sort$ = Grid()\Entry(Row)\Cell(Col)\Value ProcedureReturn RSet(Sort$, SortLen, "0") ElseIf Flags & #Grades Sort$ = RSet(Grid()\Entry(Row)\Cell(Col)\Value, SortLen, "0") ProcedureReturn Sort$ ElseIf Flags & #Date Sort$ = _GetDateString(GID, Grid()\Entry(Row)\Cell(Col)\Value, #FullDate, "%yyyy%mm%0d") ProcedureReturn Sort$ ElseIf Flags & #Time Sort$ = _GetTimeString(GID, Grid()\Entry(Row)\Cell(Col)\Value, #FullTime, "%0h%ii%ss") ProcedureReturn Sort$ EndIf EndIf EndProcedure ; ----- Column Header Click ----- Procedure SetSortColumnMarker(GID.i, MarkType.i=#Arrow, Value.i=#PB_Default, Font$="Arial|8|256") If FindMapElement(Grid(), Str(GID)) If MarkType & #Arrow : Grid()\Sort\Flag | #Arrow : EndIf If MarkType & #Color If Value = #PB_Default : Value = $800000 : EndIf Grid()\Sort\Flag | #Color Grid()\Sort\Color = Value ElseIf MarkType & #Font Grid()\Sort\Flag | #Font If SelectFont(GID, Font$) : Grid()\Sort\Font = Font$ : EndIf EndIf EndIf EndProcedure Procedure SetHeaderSort(GID.i, Col.i, Value.i) If FindMapElement(Grid(), Str(GID)) If _IsValidCol(GID, Col) Grid()\Cols(Col)\Header\Flags | #Sort Grid()\Cols(Col)\SortFlags | Value EndIf EndIf EndProcedure ; ------ Multiple Sorting ----- Procedure DefineMultiSort(GID.i, Name$, Col.i, SortLen.i, Flags.i=#False) Define Pos$ If FindMapElement(Grid(), Str(GID)) Pos$ = Str(MapSize(Grid()\Sort\Multi()) + 1) Grid()\Sort\Multi(Name$)\Order(Pos$)\Col = Col Grid()\Sort\Multi(Name$)\Order(Pos$)\SortLen = SortLen If Flags = #False Grid()\Sort\Multi(Name$)\Order(Pos$)\Type = GetColumnFlags(GID, Col) Else Grid()\Sort\Multi(Name$)\Order(Pos$)\Type = Flags EndIf EndIf EndProcedure Procedure SetMultiSortColumn(GID.i, Col.i, Name$) SetHeaderSort(GID, Col, #MultiSort) Grid(Str(GID))\Cols(Col)\SortMulti = Name$ EndProcedure Procedure ClearMultiSort(GID.i, Name$) ClearMap(Grid(Str(GID))\Sort\Multi(Name$)\Order()) EndProcedure Procedure MultiSortGridRows(GID.i, Name$, Flags.i=#Ascending|#NoCase) Define.i p, r, Rows, Count, SortCol, SortLen, SortFlags, First, Last Define Sort$ If FindMapElement(Grid(), Str(GID)) Rows = Grid()\Row\Number Count = MapSize(Grid()\Sort\Multi(Name$)\Order()) If Count <= 0 : ProcedureReturn #False : EndIf First = Grid()\Row\StartSort If First = #False : First = 1 : EndIf Last = Grid()\Row\EndSort If Last = #False : Last = Grid()\Row\Number : EndIf For r = 1 To Rows Sort$ = "" For p=1 To Count SortCol = Grid()\Sort\Multi(Name$)\Order(Str(p))\Col SortLen = Grid()\Sort\Multi(Name$)\Order(Str(p))\SortLen SortFlags = Grid()\Sort\Multi(Name$)\Order(Str(p))\Type Sort$ + GetSortString(GID, r, SortCol, SortLen, SortFlags) Next Grid()\Entry(r)\SortStrg = Sort$ Next SortStructuredArray(Grid()\Entry(), Flags, OffsetOf(Grid_Entry_Structure\SortStrg), TypeOf(Grid_Entry_Structure\SortStrg), First, Last) ProcedureReturn #True EndIf EndProcedure ; ----- Sort Rows ----- Procedure SetSortOrder(GID.i, Col.i, Flags.i=#String) Define.i r, Rows If FindMapElement(Grid(), Str(GID)) Rows = Grid()\Row\Number If Flags & #String For r=1 To Rows Grid()\Entry(r)\SortStrg = SortDEU(Grid()\Entry(r)\Cell(Col)\Value, Flags) Next ElseIf Flags & #Integer For r=1 To Rows Grid()\Entry(r)\SortInt = Val(Grid()\Entry(r)\Cell(Col)\Value) Next ElseIf Flags & #Date For r=1 To Rows Grid()\Entry(r)\SortInt = Val(_GetDateString(GID, Grid()\Entry(r)\Cell(Col)\Value, #FullDate, "%yyyy%mm%0d")) Next ElseIf Flags & #Time For r=1 To Rows Grid()\Entry(r)\SortInt = Val(_GetTimeString(GID, Grid()\Entry(r)\Cell(Col)\Value, #FullTime, "%0h%ii%ss")) Next ElseIf Flags & #Float For r=1 To Rows Grid()\Entry(r)\SortFloat = ValF(ReplaceString(Grid()\Entry(r)\Cell(Col)\Value, ",", ".")) Next ElseIf Flags & #Cash For r=1 To Rows Grid()\Entry(r)\SortFloat = ValF(ReplaceString(Grid()\Entry(r)\Cell(Col)\Value, ",", ".")) Next ElseIf Flags & #Grades For r=1 To Rows Grid()\Entry(r)\SortStrg = Grid()\Entry(r)\Cell(Col)\Value Next EndIf EndIf EndProcedure Procedure SortGridRows(GID.i, Col.i, Flags.i=#Ascending|#NoCase) Define.i First, Last, Flag.i=#Ascending If FindMapElement(Grid(), Str(GID)) If Flags & #Descending : Flag = #Descending : EndIf If Flags & #NoCase : Flag | #NoCase : EndIf If Flags & #NoFlag : ProcedureReturn #False : EndIf First = Grid()\Row\StartSort If First = #False : First = 1 : EndIf Last = Grid()\Row\EndSort If Last = #False : Last = Grid()\Row\Number : EndIf If Flags & #MultiSort MultiSortGridRows(GID, Grid()\Cols(Col)\SortMulti, Flags) ProcedureReturn #True ElseIf Flags & #Default SortStructuredArray(Grid()\Entry(), Flag, OffsetOf(Grid_Entry_Structure\SortPos), TypeOf(Grid_Entry_Structure\SortPos), First, Last) ProcedureReturn #True ElseIf Flags & #String Or #Grades SetSortOrder(GID, Col, Flags) SortStructuredArray(Grid()\Entry(), Flag, OffsetOf(Grid_Entry_Structure\SortStrg), TypeOf(Grid_Entry_Structure\SortStrg), First, Last) ProcedureReturn #True ElseIf Flags & #Integer Or Flags & #Date Or Flags & #Time SetSortOrder(GID, Col, Flags) SortStructuredArray(Grid()\Entry(), Flag, OffsetOf(Grid_Entry_Structure\SortInt), TypeOf(Grid_Entry_Structure\SortInt), First, Last) ProcedureReturn #True ElseIf Flags & #Float Or Flags & #Cash SetSortOrder(GID, Col, Flags) SortStructuredArray(Grid()\Entry(), Flag, OffsetOf(Grid_Entry_Structure\SortFloat), TypeOf(Grid_Entry_Structure\SortFloat), First, Last) ProcedureReturn #True EndIf EndIf EndProcedure ;------------------------------------------------------------------------------- Procedure _ChangeColWidth(GID.i, Col.i, Width.i, AdjustScrolls=#True) Define c.i If FindMapElement(Grid(), Str(GID)) If Not _IsValidGenericCol(GID, Col) : ProcedureReturn #False : EndIf If Width < #Text_MarginX And Width <> -1 : Width = 0 : EndIf If Col >= 0 Grid()\Cols(Col)\Width = Width _AdjustScrolls(GID) ProcedureReturn #False EndIf If Col = #AnyCol For c=1 To Grid()\Col\Number Grid()\Cols(c)\Width = Width Next EndIf If AdjustScrolls : _AdjustScrolls(GID) : EndIf EndIf EndProcedure Procedure.i _ChangeRowHeight(GID.i, Row.i, Height.i, AdjustScrolls=#True) Define r.i If FindMapElement(Grid(), Str(GID)) If Not _IsValidGenericRow(GID, Row) : ProcedureReturn #False : EndIf If Height < #Text_MarginY And Height <> -1 : Height = 0 : EndIf If Row >= 0 Grid()\Rows(Row)\Height = Height _AdjustScrolls(GID) ProcedureReturn #False EndIf If Row = #AnyRow For r = 1 To Grid()\Row\Number Grid()\Rows(r)\Height = Height Next EndIf If AdjustScrolls : _AdjustScrolls(GID) : EndIf EndIf EndProcedure Procedure _ResizeAllowed(GID.i, Row.i, Col.i) Define Allowed.i, CellFlags.i If FindMapElement(Grid(), Str(GID)) Allowed = Grid()\MouseResize If Col > 0 If Grid()\Cols(Col)\Resize = #Resize Allowed = #True ElseIf Grid()\Cols(Col)\Resize = #NoResize Allowed = #False EndIf EndIf If Row > 0 If Grid()\Rows(Row)\Resize = #Resize Allowed = #True ElseIf Grid()\Rows(Row)\Resize = #NoResize Allowed = #False EndIf EndIf ProcedureReturn Allowed EndIf EndProcedure Procedure _MouseResize(GID.i, X.i, Y.i) Define.i i, px, py, c, r, nwVal, oAreaRow, oAreaCol, X1, X2, Y1, Y2, crs ; ; 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 Col/row ; if resizing from right/down -> un-hiding any next hidden Col/row ; DownX, DownY store coord. when resizing started If FindMapElement(Grid(), Str(GID)) px = Grid()\Mouse\DownX py = Grid()\Mouse\DownY If px = X And py = Y : ProcedureReturn #False: EndIf oAreaRow = _AreaResizeRow(GID, px, py) oAreaCol = _AreaResizeCol(GID, px, py) FirstElement(Grid()\Col\AreaList()) : X1 = Grid()\Col\AreaList()\X : X2 = X1 + Grid()\Col\AreaList()\Width FirstElement(Grid()\Row\AreaList()) : Y1 = Grid()\Row\AreaList()\Y : Y2 = Y1 + Grid()\Row\AreaList()\Height crs = GetGadgetAttribute(Grid()\GId\Canvas, #PB_Canvas_Cursor) ;{ Resizing Col or unhiding a Col that was shrunk to 0 by user If oAreaCol >= 0 And Y1 <= Y And Y < Y2 And crs = #PB_Cursor_LeftRight SelectElement(Grid()\Col\AreaList() , oAreaCol) If px <= Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width c = Grid()\Col\AreaList()\AreaCol nwVal = Grid()\Cols(c)\Width + (X - px) : If nwVal < 0 : nwVal = 0 : EndIf _ChangeColWidth(GID, c, nwVal) Else c = Grid()\Col\AreaList()\AreaCol For i = Grid()\Col\AreaList()\AreaCol+1 To Grid()\Col\Number If Grid()\Cols(i)\Width = 0 c = i: Break EndIf If Grid()\Cols(i)\Width > 0 : Break : EndIf Next nwVal = Grid()\Cols(c)\Width + (X - px) : If nwVal < 0 : nwVal = 0 : EndIf _ChangeColWidth(GID, c, nwVal) EndIf EndIf ;} ;{ Resizing row or unhiding a row that was shrunk to 0 by user If oAreaRow >= 0 And X1 <= X And X < X2 And crs = #PB_Cursor_UpDown SelectElement(Grid()\Row\AreaList() , oAreaRow) If py <= Grid()\Row\AreaList()\Y + Grid()\Row\AreaList()\Height r = Grid()\Row\AreaList()\AreaRow nwVal = Grid()\Rows(r)\Height + (Y - py) If nwVal < 0 : nwVal = 0 : EndIf _ChangeRowHeight(GID, r, nwVal) Else r = Grid()\Row\AreaList()\AreaRow For i = Grid()\Row\AreaList()\AreaRow+1 To Grid()\Row\Number If Grid()\Rows(i)\Height = 0 r = i: Break EndIf If Grid()\Rows(i)\Height > 0 : Break : EndIf Next nwVal = Grid()\Rows(r)\Height + (Y - py) If nwVal < 0 : nwVal = 0 : EndIf _ChangeRowHeight(GID, r, nwVal) EndIf EndIf ;} EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Internal - * Initialize & Default * ;----------------------------------------------------------------------------- Declare DefaultThemes(GID.i) Procedure DefaultGrades() ClearMap(Grades()) If AddMapElement(Grades(), "DE") Grades()\Flag = #Number Grades()\Best = 1 Grades()\Worst = 6 Grades()\Term = "Beyond{3|4}" EndIf If AddMapElement(Grades(), "AT") Grades()\Flag = #Number Grades()\Best = 1 Grades()\Worst = 5 Grades()\Term = "Beyond{3|3}" EndIf If AddMapElement(Grades(), "IT") Grades()\Flag = #Number Grades()\Best = 10 Grades()\Worst = 0 Grades()\Term = "Beyond{6|7}" EndIf If AddMapElement(Grades(), "ES") Grades()\Flag = #Number Grades()\Best = 10 Grades()\Worst = 0 Grades()\Term = "Beyond{5|6}" EndIf If AddMapElement(Grades(), "US") Grades()\Flag = #Character Grades()\Best = 1 Grades()\Worst = 5 Grades()\Term = "Beyond{3|4}" Grades()\Notation("1") = "A" Grades()\Notation("2") = "B" Grades()\Notation("3") = "C" Grades()\Notation("4") = "D" Grades()\Notation("5") = "F" EndIf If AddMapElement(Grades(), "GB") Grades()\Flag = #Character Grades()\Best = 1 Grades()\Worst = 6 Grades()\Term = "Beyond{3|5}" Grades()\Notation("1") = "A" Grades()\Notation("2") = "B" Grades()\Notation("3") = "C" Grades()\Notation("4") = "D" Grades()\Notation("5") = "E" Grades()\Notation("6") = "F" EndIf If AddMapElement(Grades(), "FR") Grades()\Flag = #Points Grades()\Best = 20 Grades()\Worst = 0 Grades()\Term = "Beyond{10|14}" EndIf EndProcedure Procedure DefaultMonth() ClearMap(Months()) If AddMapElement(Months(), "GB") Months()\Initials("01") = "Jan." Months()\Initials("02") = "Feb." Months()\Initials("03") = "Mar." Months()\Initials("04") = "Apr." Months()\Initials("05") = "May" Months()\Initials("06") = "Jun." Months()\Initials("07") = "Jul." Months()\Initials("08") = "Aug." Months()\Initials("09") = "Sep." Months()\Initials("10") = "Oct." Months()\Initials("11") = "Nov." Months()\Initials("12") = "Dec." EndIf If AddMapElement(Months(), "DE") Months()\Initials("01") = "Jan." Months()\Initials("02") = "Feb." Months()\Initials("03") = "Mär." Months()\Initials("04") = "Apr." Months()\Initials("05") = "Mai" Months()\Initials("06") = "Jun." Months()\Initials("07") = "Jul." Months()\Initials("08") = "Aug." Months()\Initials("09") = "Sep." Months()\Initials("10") = "Okt." Months()\Initials("11") = "Nov." Months()\Initials("12") = "Dez." EndIf If AddMapElement(Months(), "AT") Months()\Initials("01") = "Jän." Months()\Initials("02") = "Feb." Months()\Initials("03") = "Mär." Months()\Initials("04") = "Apr." Months()\Initials("05") = "Mai" Months()\Initials("06") = "Jun." Months()\Initials("07") = "Jul." Months()\Initials("08") = "Aug." Months()\Initials("09") = "Sep." Months()\Initials("10") = "Okt." Months()\Initials("11") = "Nov." Months()\Initials("12") = "Dez." EndIf If AddMapElement(Months(), "FR") Months()\Initials("01") = "Jan." Months()\Initials("02") = "Fév." Months()\Initials("03") = "Mar." Months()\Initials("04") = "Avr." Months()\Initials("05") = "Mai" Months()\Initials("06") = "Juin" Months()\Initials("07") = "Juil." Months()\Initials("08") = "Aoû." Months()\Initials("09") = "Sep." Months()\Initials("10") = "Oct." Months()\Initials("11") = "Nov." Months()\Initials("12") = "Déc." EndIf If AddMapElement(Months(), "IT") Months()\Initials("01") = "Gen." Months()\Initials("02") = "Feb." Months()\Initials("03") = "Mar." Months()\Initials("05") = "Mag." Months()\Initials("06") = "Giu." Months()\Initials("07") = "Lug." Months()\Initials("08") = "Ago." Months()\Initials("09") = "Set." Months()\Initials("10") = "Ott." Months()\Initials("11") = "Nov." Months()\Initials("12") = "Dic." EndIf If AddMapElement(Months(), "ES") Months()\Initials("01") = "Ene." Months()\Initials("02") = "Feb." Months()\Initials("03") = "Mar." Months()\Initials("04") = "Abr." Months()\Initials("05") = "May." Months()\Initials("06") = "Jun." Months()\Initials("07") = "Jul." Months()\Initials("08") = "Ago." Months()\Initials("09") = "Sep." Months()\Initials("10") = "Oct." Months()\Initials("11") = "Nov." Months()\Initials("12") = "Dic." EndIf EndProcedure Procedure Initialize(GID.i, Rows.i, Cols.i) ; Reset everything so Grid can receive/show new data Define.i c, r, CountRows If FindMapElement(Grid(), Str(GID)) If Rows < 0 : Rows = 0 : EndIf If Cols < 0 : Cols = 0 : EndIf Grid()\Row\Number = Rows Grid()\Col\Number = Cols Dim Grid()\Entry(Rows) Dim Grid()\Rows(Rows) Dim Grid()\Cols(Cols) ; Initializations Grid()\Row\TopCell = 1 Grid()\Row\Current = 1 Grid()\Row\StartSort = #False Grid()\Row\EndSort = #False ClearMap(Grid()\Lines\Top()) ClearMap(Grid()\Lines\Bottom()) Grid()\Col\TopCell = 1 Grid()\Col\Current = 1 Grid()\Sort\Flag = #Arrow Grid()\Sort\Column = -1 ClearMap(Grid()\Lines\Left()) ClearMap(Grid()\Lines\Right()) Grid()\Block\Row2 = 0 Grid()\Block\Col2 = 0 ; Init Rows For r=0 To Rows Dim Grid()\Entry(r)\Cell(Cols) Grid()\Rows(r)\Header\Value = Str(r) Grid()\Rows(r)\Area = -1 Grid()\Entry(r)\SortPos = r Grid()\Entry(r)\Cell(0)\Flags = #Cell Next Grid()\Rows(#Header)\Header\Value = "" ; Init Columns For c=0 To Cols Grid()\Cols(c)\Header\Value = Str(c) Grid()\Cols(c)\Area = -1 Grid()\Entry(0)\Cell(c)\Flags = #Cell Next Grid()\Cols(#Header)\Header\Value = "" _ChangeRowHeight(GID, #Null, #Default_RowHeight) ; Header row _ChangeRowHeight(GID, #AnyRow, #Default_RowHeight) _ChangeColWidth(GID, #Null, #Default_ColWidth) ; Label row _ChangeColWidth(GID, #AnyCol, #Default_ColWidth) Grid()\Col\LastFrozen = 0 Grid()\Row\LastFrozen = 0 Grid()\Header\Rows = 1 Grid()\Header\Cols = 1 Grid()\Mouse\MoveStatus = #MouseMove_Nothing Grid()\Mouse\DownX = 0 Grid()\Mouse\DownY = 0 ; --- Grid Colors - Grid()\Color\... Grid()\Color\GridFront = $000000 Grid()\Color\GridBack = $FFFFFF Grid()\Color\GridLine = $E6E6E6 Grid()\Color\BlockBack = RGBA(248, 248, 255, 140) Grid()\Color\FocusBack = $FFF8F8 Grid()\Color\FocusBorder = $B48246 Grid()\Color\LabelBorder = $D1AE93 Grid()\Color\Mistake = $0000FF Grid()\MouseResize = #True Grid()\NoRedraw = #False Grid()\WrapText = #True ; --- Default Format - Grid()\Format\... Grid()\Format\Font = "Arial|8|" ; LoadFont(#PB_Any, "Arial", 8) Grid()\Format\FontBold = "Arial|8|256" ; LoadFont(#PB_Any, "Arial", 8, #PB_Font_Bold) Grid()\Format\Currency = #DefaultCurrency Grid()\Format\Language = #DefaultLanguage Grid()\Format\ParseDate = #DefaultDateMask Grid()\Format\ParseTime = #DefaultTimeMask Grid()\Format\DefaultDate = #DefaultDateMask Grid()\Format\DefaultTime = #DefaultTimeMask Grid()\Format\DateSeperator = _GetSeperator(GID, #Date, #DefaultDateMask) Grid()\Format\TimeSeperator = _GetSeperator(GID, #Time, #DefaultTimeMask) Grid()\Format\DecimalPoint = #DecimalPoint Grid()\Format\ThousandSeparator = #ThousandSeparator Grid()\Format\Digits = 3 Grid()\Format\DefaultFloat = "%i"+#DecimalPoint+"%ddd" AddFont(GID, Grid()\Format\Font) AddFont(GID, Grid()\Format\FontBold) ClearList(Grid()\MultiCellList()) ClearMap(Grid()\Row\Selected()) ClearMap(Grid()\Cell\Selected()) DefaultMonth() DefaultGrades() ; --- Default Style for cells (List Element 0) - Grid()\Style()\... ClearList(Grid()\Style()) AddElement(Grid()\Style()) Grid()\Style()\Value("Align") = #Left Grid()\Style()\Value("FrontColor") = Grid()\Color\GridFront Grid()\Style()\Value("BackColor") = Grid()\Color\GridBack Grid()\Style()\Value("FrameColor") = #PB_Default Grid()\Style()\Value("Gradient") = #False Grid()\Style()\Value("EditMode") = #Append Grid()\Style()\Value("Digits") = 3 Grid()\Style()\Value("MarkFlag") = #False Grid()\Style()\Value("MarkColor") = $578B2E Grid()\Style()\Value("MarkColor2") = $2C2CEE Grid()\Style()\Value("MarkChange") = #False Grid()\Style()\Language = #DefaultLanguage Grid()\Style()\Font = "Arial|8|" Grid()\Style()\FormatMask = "" Grid()\Style()\MarkTerm = "" ClearList(Grid()\Calc()) AddElement(Grid()\Calc()) ; Element 0 => no calculation DefaultThemes(GID) SetHeaderStyle(GID) _AdjustScrolls(GID) ; set min/max/page of scrolls ProcedureReturn #True EndIf EndProcedure Procedure _ChangeRowNumber(GID.i, Rows.i) ; delete all Rows (clearing data) and keeps columns unchanged Define.i c, r, Cols, oRows Define Item$ If FindMapElement(Grid(), Str(GID)) oRows = Grid()\Row\Number Cols = Grid()\Col\Number If Rows < 0 : Rows = 0 : EndIf Grid()\Row\Number = Rows If Rows > oRows ReDim Grid()\Entry(Rows) ReDim Grid()\Rows(Rows) For r = oRows+1 To Rows Dim Grid()\Entry(r)\Cell(Cols) Grid()\Rows(r)\Header\Value = Str(r) Grid()\Entry(r)\Cell(0)\Value = Str(r) Grid()\Rows(r)\Height = #Default_RowHeight Next EndIf If Grid()\Row\TopCell > Grid()\Row\Number : Grid()\Row\TopCell = Grid()\Row\Number : EndIf If Grid()\Row\Current > Grid()\Row\Number : Grid()\Row\Current = Grid()\Row\Number : EndIf If Grid()\Block\Row2 > Grid()\Row\Number : Grid()\Block\Row2 = Grid()\Row\Number : EndIf If Grid()\Col\TopCell > Grid()\Col\Number : Grid()\Col\TopCell = Grid()\Col\Number : EndIf If Grid()\Col\Current > Grid()\Col\Number : Grid()\Col\Current = Grid()\Col\Number : EndIf If Grid()\Block\Col2 > Grid()\Col\Number : Grid()\Block\Col2 = Grid()\Col\Number : EndIf _AdjustScrolls(GID) ; set min/max/page of scrolls EndIf EndProcedure Procedure _ResetDownClick(GID.i) Define gid$ = Str(GID) Grid(gid$)\Mouse\DownX = 0 Grid(gid$)\Mouse\DownY = 0 Grid(gid$)\Mouse\DownAreaRow = -1 Grid(gid$)\Mouse\DownAreaCol = -1 EndProcedure ;----------------------------------------------------------------------------- ;--- Interface ;----------------------------------------------------------------------------- Procedure SetTopRow(GID.i, TopRow.i) If Grid(Str(GID))\Row\TopCell <> TopRow Grid(Str(GID))\Row\TopCell = TopRow Draw(GID) EndIf EndProcedure Procedure SetTopColumn(GID.i, TopCol.i) If Grid(Str(GID))\Col\TopCell <> TopCol Grid(Str(GID))\Col\TopCell = TopCol Draw(GID) EndIf EndProcedure Procedure MoveUp(GID.i, xStep.i, Flag.i) If _MoveUp(GID, xStep, Flag) : Draw(GID) : EndIf EndProcedure Procedure MoveDown(GID.i, xStep.i, Flag.i) If _MoveDown(GID, xStep, Flag) : Draw(GID) : EndIf EndProcedure Procedure MoveLeft(GID.i, xStep.i, Flag.i) If _MoveLeft(GID, xStep, Flag) : Draw(GID) : EndIf EndProcedure Procedure MoveRight(GID.i, xStep.i, Flag.i) If _MoveRight(GID, xStep, Flag) : Draw(GID) : EndIf EndProcedure Procedure.i ShowCell(GID.i, Row.i, Col.i, SetCellFocus = #False) ; makes sure cell defined by (Row,Col) is visible on screen - scrolls if need be Define topRow, topCol If FindMapElement(Grid(), Str(GID)) If _IsValidCell(GID, Row, Col) = #False : ProcedureReturn #False : EndIf If Grid()\Rows(Row)\Height <= 0 : ProcedureReturn #False : EndIf If Grid()\Cols(Col)\Width <= 0 : ProcedureReturn #False : EndIf topRow = _NearestTopRow(GID, Row) topCol = _NearestTopCol(GID, Col) If topRow <> Grid()\Row\TopCell Or topCol <> Grid()\Col\TopCell Grid()\Row\TopCell = topRow Grid()\Col\TopCell = topCol If SetCellFocus Grid()\Row\Current = Row Grid()\Col\Current = Col EndIf Draw(GID) Else _MoveFocus(GID, Row, Col) EndIf ProcedureReturn #True EndIf EndProcedure Procedure.i FocusCell(GID.i, Row, Col) ; moves the focus from current cell to the new one defind by param ShowCell(GID, Row, Col, #True) EndProcedure Procedure.s LastCellText(GID.i) ProcedureReturn Grid(Str(GID))\Cell\LastText EndProcedure Procedure ClearLastChange(GID.i) Grid(Str(GID))\Cell\LastRow = -1 Grid(Str(GID))\Cell\LastCol = -1 Grid(Str(GID))\Cell\LastText = "" EndProcedure Procedure ClearLastClick(GID.i) Grid(Str(GID))\Cell\ClickedRow = -1 Grid(Str(GID))\Cell\ClickedCol = -1 EndProcedure ;----------------------------------------------------------------------------- ;--- Calculation ;----------------------------------------------------------------------------- Procedure.s GetDate(Value$) ; "%dd.%mm.%yyyy" Define Result$ Result$ = ReplaceString(#DefaultDateMask, "%yyyy", Left(Value$, 4)) Result$ = ReplaceString(Result$, "%mm", Mid(Value$, 5, 2)) ProcedureReturn ReplaceString(Result$, "%dd", Right(Value$, 2)) EndProcedure Procedure.s GetTime(Value$) ; "%hh:%ii:%ss" Define Result$ Value$ = RSet(Value$, 6, "0") Result$ = ReplaceString(#DefaultTimeMask, "%hh", Left(Value$, 2)) Result$ = ReplaceString(Result$, "%ii", Mid(Value$, 3, 2)) ProcedureReturn ReplaceString(Result$, "%ss", Right(Value$, 2)) EndProcedure Procedure _AddValue(GID, Value$, Flag.i, *Var.Calc_Var_Structure) Select Flag Case #Date Value$ = _GetDateString(GID, Value$, #FullDate, "%yyyy%mm%0d") Flag = #Integer Case #Time Value$ = _GetTimeString(GID, Value$, #FullTime, "%0h%ii%ss") Flag = #Integer EndSelect Select Flag Case #Float, #Cash Value$ = ReplaceString(Value$, #DecimalPoint, ".") *Var\Float + ValF(Value$) Case #Integer, #Grades *Var\Integer + Val(Value$) Case #String *Var\String + Value$ EndSelect EndProcedure Procedure _CalcValue(GID, Value$, Operator$, Flag.i, *Var.Calc_Var_Structure, Assign=#False) Select Flag Case #Date Value$ = _GetDateString(GID, Value$, #FullDate, "%yyyy%mm%0d") Flag = #Integer Case #Time Value$ = _GetTimeString(GID, Value$, #FullTime, "%0h%ii%ss") Flag = #Integer Case #Float, #Cash Value$ = ReplaceString(Value$, #DecimalPoint, ".") EndSelect If Assign Select Flag Case #Float, #Cash *Var\Float = ValF(Value$) Case #Integer, #Grades *Var\Integer = Val(Value$) Case #String *Var\String = Value$ EndSelect Else Select Operator$ Case "+" ;{ Select Flag Case #Float, #Cash *Var\Float + ValF(Value$) Case #Integer, #Grades *Var\Integer + Val(Value$) Case #String *Var\String + Value$ EndSelect ;} Case "-" ;{ Select Flag Case #Float, #Cash *Var\Float - ValF(Value$) Case #Integer, #Grades *Var\Integer - Val(Value$) EndSelect ;} Case "*", "×" ;{ Select Flag Case #Float, #Cash *Var\Float * ValF(Value$) Case #Integer, #Grades *Var\Integer * Val(Value$) EndSelect ;} Case "/", ":", "÷" ;{ Select Flag Case #Float, #Cash, #Grades *Var\Float / ValF(Value$) Case #Integer *Var\Integer / Val(Value$) EndSelect ;} EndSelect EndIf EndProcedure Procedure _ParseTerm(Term$, *Term.Calc_Term_Structure) Define.i i=0, r, c, Row, Col, cOP, Count, First, Last Dim Item.s(0) *Term\Type = StringField(Term$, 1, "[") *Term\Expr = RTrim(StringField(*Term\Type, 2, "{"), "}") If *Term\Expr : *Term\Type = StringField(*Term\Type, 1, "{"): EndIf ;{ Arithmetic Operators cOP = _ExtractTags(Term$, "]", "[", Item()) If cOP >= 0 Dim *Term\Operator(cOP) For i = 0 To cOP *Term\Operator(i) = Item(i) Next EndIf ;} Count = _ExtractTags(Term$, "[", "]", Item()) If Count >= 0 For i = 0 To Count If i <= cOP And *Term\Operator(i) = ".." ;{ Cell Area Select Left(Item(i), 1) Case "R" ;{ Row First = Val(LTrim(Item(i), "R")) Last = Val(LTrim(Item(i+1), "R")) For r = First To Last AddMapElement(*Term\Cell(), "R"+Str(r)) Next ;} Case "C" ;{ Col First = Val(LTrim(Item(i), "C")) Last = Val(LTrim(Item(i+1), "C")) For c = First To Last AddMapElement(*Term\Cell(), "C"+Str(c)) Next ;} Default ;{ Row:Col If CountString(Item(i), ":") If StringField(Item(i), 1, ":") = StringField(Item(i+1), 1, ":") Row = Val(StringField(Item(i), 1, ":")) First = Val(StringField(Item(i), 2, ":")) Last = Val(StringField(Item(i+1), 2, ":")) For c = First To Last AddMapElement(*Term\Cell(), Str(Row)+":"+Str(c)) Next ElseIf StringField(Item(i), 2, ":") = StringField(Item(i+1), 2, ":") Col = Val(StringField(Item(i), 2, ":")) First = Val(StringField(Item(i), 1, ":")) Last = Val(StringField(Item(i+1), 1, ":")) For r = First To Last AddMapElement(*Term\Cell(), Str(r)+":"+Str(Col)) Next EndIf EndIf ;} EndSelect Continue ;} Else ;{ Single Cells AddMapElement(*Term\Cell(), Item(i)) ;} EndIf Next EndIf EndProcedure Procedure UpdateCalculations(GID.i) Define gid$ = Str(GID) Define Term$, Key$, Compare$, Value$ Define.i idx, Row, Col, tRow, tCol, Count Define Float.f, Sum.f, Integer.i, CalcFlag.i, CellFlags.i, Result.i Define Var.Calc_Var_Structure Define Term.Calc_Term_Structure If ListSize(Grid(gid$)\Calc()) > 0 ForEach Grid(gid$)\Calc() If ListIndex(Grid(gid$)\Calc()) = 0 : Continue : EndIf Float = #Null : Integer = #Null Row = Grid(gid$)\Calc()\Row Col = Grid(gid$)\Calc()\Col CalcFlag = Grid(gid$)\Calc()\Flag Term$ = Grid(gid$)\Calc()\Term CellFlags = GetCellFlags(GID, Row, Col) Term\Type = "" Dim Term\Operator(0) ClearMap(Term\Cell()) Var\Integer = #Null Var\Float = #Null Var\String = "" _ParseTerm(Term$, @Term) ;{ --- Get cell value --- ForEach Term\Cell() Key$ = MapKey(Term\Cell()) Select Left(Key$, 1) Case "R" tRow = Val(LTrim(Key$, "R")) Term\Cell() = Grid(gid$)\Entry(tRow)\Cell(Col)\Value Case "C" tCol = Val(LTrim(Key$, "C")) Term\Cell() = Grid(gid$)\Entry(Row)\Cell(tCol)\Value Default If CountString(Key$, ":") tRow = Val(StringField(Key$, 1, ":")) tCol = Val(StringField(Key$, 2, ":")) Term\Cell() = Grid(gid$)\Entry(tRow)\Cell(tCol)\Value EndIf EndSelect Next ;} Select UCase(Term\Type) Case "SUM", "SUMME" ;{ e.g. Sum[R3]..[R5] ForEach Term\Cell() _AddValue(GID, Term\Cell(), CalcFlag, @Var) Result = CalcFlag Next ;} Case "AVERAGE", "DURCHSCHNITT" ;{ e.g. Average[R1]..[R3] Count = 0 ForEach Term\Cell() _AddValue(GID, Term\Cell(), CalcFlag, @Var) Count + 1 Next If Count ;{ Select CalcFlag Case #Integer If Var\Integer > 0 Var\Integer = Round(Var\Integer / Count, #PB_Round_Nearest) Result = #Integer EndIf Case #Grades If Var\Integer > 0 Var\Float = Var\Integer / Count Result = #Grades EndIf Case #Float If Var\Float > 0 Var\Float = Var\Float / Count Result = #Float EndIf EndSelect ;} EndIf ;} Case "COUNT", "ANZAHL" ;{ e.g. Count{<|10}[R1]..[R5] If Term\Expr <> "" Count = 0 Compare$ = StringField(Term\Expr, 1, "|") Value$ = StringField(Term\Expr, 2, "|") ForEach Term\Cell() If _CompareValues(GID, Term\Cell(), Compare$, Value$, CalcFlag) Count + 1 EndIf Next Integer = Count Result = #Integer Else Integer = MapSize(Term\Cell()) Result = #Integer EndIf ;} Case "MIN" ;{ e.g. Min[R1]..[R5] Count = 0 ForEach Term\Cell() Select CalcFlag Case #Integer ;{ If Count = 0 ; First Element Var\Integer = Val(Term\Cell()) Else If Val(Term\Cell()) < Var\Integer : Var\Integer = Val(Term\Cell()) : EndIf EndIf ;} Case #Float, #Cash ;{ Term\Cell() = ReplaceString(Term\Cell(), #DecimalPoint, ".") If Count = 0 ; First Element Var\Float = ValF(Term\Cell()) Else If ValF(Term\Cell()) < Var\Float : Var\Float = ValF(Term\Cell()) : EndIf EndIf ;} Case #Date ;{ Value$ = _GetDateString(GID, Term\Cell(), #FullDate, "%yyyy%mm%0d") If Count = 0 ; First Element Var\Integer = Val(Value$) Else If Val(Value$) < Var\Integer : Var\Integer = Val(Value$) : EndIf EndIf ;} Case #Time ;{ Value$ = _GetTimeString(GID, Term\Cell(), #FullTime, "%0h%ii%ss") If Count = 0 ; First Element Var\Integer = Val(Value$) Else If Val(Value$) < Var\Integer : Var\Integer = Val(Value$) : EndIf EndIf ;} EndSelect Count + 1 Next Result = CalcFlag ;} Case "MAX" ;{ e.g. Max[R1]..[R5] Count = 0 ForEach Term\Cell() Select CalcFlag Case #Integer ;{ If Count = 0 ; First Element Var\Integer = Val(Term\Cell()) Else If Val(Term\Cell()) > Var\Integer : Var\Integer = Val(Term\Cell()) : EndIf EndIf ;} Case #Float, #Cash ;{ If Count = 0 ; First Element Var\Float = ValF(Term\Cell()) Else If ValF(Term\Cell()) > Var\Float : Var\Float = ValF(Term\Cell()) : EndIf EndIf ;} Case #Date ;{ Value$ = _GetDateString(GID, Term\Cell(), #FullDate, "%yyyy%mm%0d") If Count = 0 ; First Element Var\Integer = Val(Value$) Else If Val(Value$) > Var\Integer : Var\Integer = Val(Value$) : EndIf EndIf ;} Case #Time ;{ Value$ = _GetTimeString(GID, Term\Cell(), #FullTime, "%0h%ii%ss") If Count = 0 ; First Element Var\Integer = Val(Value$) Else If Val(Value$) > Var\Integer : Var\Integer = Val(Value$) : EndIf EndIf ;} EndSelect Count + 1 Next Result = CalcFlag ;} Case "" ;{ e.g. [3:2]+[5:2] idx = -1 ForEach Term\Cell() If Idx < 0 ; First Element _CalcValue(GID, Term\Cell(), Term\Operator(Idx), CalcFlag, @Var, #True) Else ; Calculations _CalcValue(GID, Term\Cell(), Term\Operator(Idx), CalcFlag, @Var) EndIf Idx + 1 Next Result = CalcFlag ;} EndSelect Select Result Case #Integer Grid(gid$)\Entry(Row)\Cell(Col)\Value = Str(Var\Integer) Case #Float Grid(gid$)\Entry(Row)\Cell(Col)\Value = StrF(Var\Float) Case #Cash Grid(gid$)\Entry(Row)\Cell(Col)\Value = StrF(Var\Float, 2) Case #Date Grid(gid$)\Entry(Row)\Cell(Col)\Value = GetDate(Str(Var\Integer)) Case #Time Grid(gid$)\Entry(Row)\Cell(Col)\Value = GetTime(Str(Var\Integer)) Case #String Grid(gid$)\Entry(Row)\Cell(Col)\Value = Var\String Case #Grades Grid(gid$)\Entry(Row)\Cell(Col)\Value = StrF(Var\Float, 2) EndSelect Next Draw(GID) EndIf EndProcedure Procedure AddCellTerm(GID.i, Row.i, Col.i, Term$, Flag.i=#Float) Define gid$ = Str(GID) If _IsValidCell(GID, Row, Col) AddElement(Grid(gid$)\Calc()) Grid(gid$)\Calc()\Row = Row Grid(gid$)\Calc()\Col = Col Grid(gid$)\Calc()\Term = Term$ Grid(gid$)\Calc()\Flag = Flag Grid(gid$)\Entry(Row)\Cell(Col)\Calc = ListIndex(Grid(gid$)\Calc()) UpdateCalculations(GID) ProcedureReturn ListIndex(Grid(gid$)\Calc()) EndIf ProcedureReturn #NoElement EndProcedure Procedure RemoveTerm(GID.i, Row.i, Col.i) Define Index.i, gid$ = Str(GID) Index = Grid(gid$)\Entry(Row)\Cell(Col)\Calc If Index <> #NoResult If SelectElement(Grid(gid$)\Calc(), Index) DeleteElement(Grid(gid$)\Calc()) EndIf EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Formatting / Marking Cells ;----------------------------------------------------------------------------- Procedure SetLanguage(GID.i, Language.s=#DefaultLanguage) If FindMapElement(Grid(), Str(GID)) Grid(Str(GID))\Format\Language = Language If FirstElement(Grid()\Style()) Grid()\Style()\Language = Language EndIf EndIf EndProcedure Procedure SetCellLanguage(GID.i, Row.i, Col.i, Language$="") If FindMapElement(Grid(), Str(GID)) If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf Grid()\Style()\Language = Language$ EndIf EndProcedure Procedure DateInputFormat(GID.i, Mask$=#DefaultDateMask) Grid(Str(GID))\Format\ParseDate = Mask$ Grid(Str(GID))\Format\DateSeperator = _GetSeperator(GID, #Date, Mask$) EndProcedure Procedure TimeInputFormat(GID.i, Mask$=#DefaultTimeMask) Grid(Str(GID))\Format\ParseTime = Mask$ Grid(Str(GID))\Format\TimeSeperator = _GetSeperator(GID, #Time, Mask$) EndProcedure Procedure SetDateFormat(GID.i, Mask$=#DefaultDateMask) Grid(Str(GID))\Format\DefaultDate = Mask$ EndProcedure Procedure SetTimeFormat(GID.i, Mask$=#DefaultTimeMask) Grid(Str(GID))\Format\DefaultTime = Mask$ EndProcedure Procedure SetNumberFormat(GID.i, ThousandSeparator.s, DecimalPoint.s, Digits.i=#False) If DecimalPoint = "" : DecimalPoint = #DecimalPoint : EndIf If ThousandSeparator = "" : ThousandSeparator = #ThousandSeparator : EndIf If Digits = #False : Digits = 3 : EndIf Grid(Str(GID))\Format\DecimalPoint = DecimalPoint Grid(Str(GID))\Format\ThousandSeparator = ThousandSeparator Grid(Str(GID))\Format\Digits = Digits EndProcedure Procedure FormatCells(GID.i, Row.i, Col.i, CellType.i, Mask$="", Language$="", Digits.i=2) ; CellType: #Integer/#Float/#Cash/#Date/#Time/#Grades If FindMapElement(Grid(), Str(GID)) If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf ;{ Mask for #Date or #Time If CellType & #Date If Mask$ = "" : Mask$ = Grid()\Format\DefaultDate : EndIf ElseIf CellType & #Time If Mask$ = "" : Mask$ = Grid()\Format\DefaultTime : EndIf EndIf ;} Grid()\Style()\Value("Digits") = Digits Grid()\Style()\FormatMask = Mask$ Grid()\Style()\Language = Language$ CellType | #Format If Row = #AnyRow ; Any row of Col AddCellFlag(GID, 0, Col, CellType) Grid()\Entry(0)\Cell(Col) ElseIf Col = #AnyCol ; Any Col of row AddCellFlag(GID, Row, 0, CellType) Else AddCellFlag(GID, Row, Col, CellType) EndIf EndIf EndProcedure Procedure MarkCells(GID.i, Row.i, Col.i, CellType.i, Term$, Color.i, Color2.i=#PB_Default) If FindMapElement(Grid(), Str(GID)) If Color2 = #PB_Default : Color2 = Color : EndIf If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf If Row = #AnyRow AddCellFlag(GID, 0, Col, #Mark) ElseIf Col = #AnyCol AddCellFlag(GID, Row, 0, #Mark) Else AddCellFlag(GID, Row, Col, #Mark) EndIf Grid()\Style()\Value("MarkColor") = Color Grid()\Style()\Value("MarkColor2") = Color2 Grid()\Style()\Value("MarkFlag") = CellType Grid()\Style()\MarkTerm = Term$ EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Design / Cell Style ;----------------------------------------------------------------------------- Procedure SetGridLine(GID.i, Row.i, Col.i=#False, Last.i=#False, Flags.i=#Horizontal|#Top, Color.i=$D1AE93, Thickness.i=1) Define Row2.i, Col2.i If FindMapElement(Grid(), Str(GID)) If Flags & #Vertical ;{ Vertical line If _IsValidCol(GID, Col) If Flags & #Right If Col < Grid()\Col\Number If Row > 0 And Last >= Row Grid()\Lines\Right(Str(Col))\First = Row Grid()\Lines\Right(Str(Col))\Last = Last EndIf Grid()\Lines\Right(Str(Col))\Color = Color Grid()\Lines\Right(Str(Col))\Thickness = Thickness EndIf Col2 = Col + 1 If Col2 < Grid()\Col\Number If Row > 0 And Last >= Row Grid()\Lines\Left(Str(Col2))\First = Row Grid()\Lines\Left(Str(Col2))\Last = Last EndIf Grid()\Lines\Left(Str(Col2))\Color = Color Grid()\Lines\Left(Str(Col2))\Thickness = Thickness EndIf Else ; #Left If Col > 0 If Row > 0 And Last >= Row Grid()\Lines\Left(Str(Col))\First = Row Grid()\Lines\Left(Str(Col))\Last = Last EndIf Grid()\Lines\Left(Str(Col))\Color = Color Grid()\Lines\Left(Str(Col))\Thickness = Thickness EndIf Col2 = Col - 1 If Col2 > 0 If Row > 0 And Last >= Row Grid()\Lines\Right(Str(Col2))\First = Row Grid()\Lines\Right(Str(Col2))\Last = Last EndIf Grid()\Lines\Right(Str(Col2))\Color = Color Grid()\Lines\Right(Str(Col2))\Thickness = Thickness EndIf EndIf EndIf ;} Else ;{ Horizontal line If _IsValidRow(GID, Row) If Flags & #Bottom If Row < Grid()\Row\Number If Col > 0 And Last >= Col Grid()\Lines\Bottom(Str(Row))\First = Col Grid()\Lines\Bottom(Str(Row))\Last = Last EndIf Grid()\Lines\Bottom(Str(Row))\Color = Color Grid()\Lines\Bottom(Str(Row))\Thickness = Thickness EndIf Row2 = Row + 1 If Row2 < Grid()\Row\Number If Col > 0 And Last >= Col Grid()\Lines\Top(Str(Row2))\First = Col Grid()\Lines\Top(Str(Row2))\Last = Last EndIf Grid()\Lines\Top(Str(Row2))\Color = Color Grid()\Lines\Top(Str(Row2))\Thickness = Thickness EndIf Else ; Top If Row > 0 If Col > 0 And Last >= Col Grid()\Lines\Top(Str(Row))\First = Col Grid()\Lines\Top(Str(Row))\Last = Last EndIf Grid()\Lines\Top(Str(Row))\Color = Color Grid()\Lines\Top(Str(Row))\Thickness = Thickness EndIf Row2 = Row - 1 If Row2 > 0 If Col > 0 And Last >= Col Grid()\Lines\Bottom(Str(Row2))\First = Col Grid()\Lines\Bottom(Str(Row2))\Last = Last EndIf Grid()\Lines\Bottom(Str(Row2))\Color = Color Grid()\Lines\Bottom(Str(Row2))\Thickness = Thickness EndIf EndIf EndIf ;} EndIf EndIf EndProcedure Procedure SetCellFrame(GID.i, Row.i, Col.i, Color.i=$A9A9A9) If FindMapElement(Grid(), Str(GID)) If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf If Row = #AnyRow ; Any row of Col AddCellFlag(GID, #Any, Col, #Frame) ElseIf Col = #AnyCol ; Any Col of row AddCellFlag(GID, Row, #Any, #Frame) Else AddCellFlag(GID, Row, Col, #Frame) EndIf Grid()\Style()\Value("FrameColor") = Color EndIf EndProcedure Procedure SetCellAlign(GID.i, Row.i, Col.i, Align.i) ; Align: #Left/#Center/#Right OR #PB_Text_Center/#PB_Text_Right) If FindMapElement(Grid(), Str(GID)) If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf Grid()\Style()\Value("Align") = Align EndIf EndProcedure Procedure SetCellColor(GID.i, Row.i, Col.i, ColorType.i, Color.i) ; ColorType: #FrontColor/#BackColor/#MarkColor/#Gradient OR #PB_Gadget_FrontColor/#PB_Gadget_BackColor Define gid$ = Str(GID) If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf Select ColorType Case #FrontColor, #PB_Gadget_FrontColor Grid(gid$)\Style()\Value("FrontColor") = Color Case #BackColor, #PB_Gadget_BackColor Grid(gid$)\Style()\Value("BackColor") = Color Case #MarkColor Grid(gid$)\Style()\Value("MarkColor") = Color Case #Gradient ; #True / #False Grid(gid$)\Style()\Value("Gradient") = Color EndSelect EndProcedure Procedure SetCellFont(GID.i, Row.i, Col.i, Name$, Size.i, Flags.i=#False) Define Font$ If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf If FindMapElement(Grid(), Str(GID)) Font$ = Name$+"|"+Str(Size)+"|"+Str(Flags) If SelectFont(GID, Font$) Grid()\Style()\Font = Font$ EndIf EndIf ProcedureReturn #False EndProcedure Procedure SetCellEditMode(GID.i, Row.i, Col.i, EditMode.i) ; EditMode: #Over/#Append Define gid$ = Str(GID) If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf Grid(gid$)\Style()\Value("EditMode") = EditMode EndProcedure Procedure SetCellImage(GID.i, Row.i, Col.i, File$) If FindMapElement(Grid(), Str(GID)) If Row = #Header If SelectImage(GID, File$) Grid()\Cols(Col)\Header\Flags | #Image Grid()\Cols(Col)\Header\Image = LCase(GetFilePart(File$)) ProcedureReturn #True EndIf ElseIf Col = #Header If SelectImage(GID, File$) Grid()\Rows(Row)\Header\Flags | #Image Grid()\Rows(Row)\Header\Image = LCase(GetFilePart(File$)) ProcedureReturn #True EndIf Else If Row = #AnyRow ; Any row of Col If SelectImage(GID, File$) AddCellFlag(GID, #Any, Col, #Image) Grid()\Entry(#Any)\Cell(Col)\Image = LCase(GetFilePart(File$)) ProcedureReturn #True EndIf ElseIf Col = #AnyCol ; Any Col of row If SelectImage(GID, File$) AddCellFlag(GID, Row, #Any, #Image) Grid()\Entry(Row)\Cell(#Any)\Image = LCase(GetFilePart(File$)) ProcedureReturn #True EndIf Else ; Selected Row & Col If SelectImage(GID, File$) AddCellFlag(GID, Row, Col, #Image) Grid()\Entry(Row)\Cell(Col)\Image = LCase(GetFilePart(File$)) ProcedureReturn #True EndIf EndIf EndIf EndIf ProcedureReturn #False EndProcedure Procedure SetCellType(GID.i, Row.i, Col.i, Flags.i) ; CellType 1: #Cell/#Edit/#Checkbox/#Combo/#Button/#Image ; CellType 2: #String/#Integer/#Float/#Cash/#Date/#Time/#Grades Define Term$ If Row = #AnyRow ;{ Any row of Col If Flags & #Grades AddCellFlag(GID, #Any, Col, Flags|#Valid) Else AddCellFlag(GID, #Any, Col, Flags) EndIf ;} ElseIf Col = #AnyCol ;{ Any Col of row If Flags & #Grades AddCellFlag(GID, Row, #Any, Flags|#Valid) Else AddCellFlag(GID, Row, #Any, Flags) EndIf ;} Else ;{ Selected Row & Col If Flags & #Grades AddCellFlag(GID, Row, Col, Flags|#Valid) Else AddCellFlag(GID, Row, Col, Flags) EndIf ;} EndIf If Flags & #Cash SetCellAlign(GID, Row, Col, #Right) FormatCells(GID, Row, Col, #Cash) ElseIf Flags & #Date SetCellAlign(GID, Row, Col, #Right) FormatCells(GID, Row, Col, #Date) ElseIf Flags & #Time SetCellAlign(GID, Row, Col, #Right) ElseIf Flags & #Float SetCellAlign(GID, Row, Col, #Right) FormatCells(GID, Row, Col, #Float, "%i.%ddd") ElseIf Flags & #Integer SetCellAlign(GID, Row, Col, #Right) ElseIf Flags & #Grades SetCellAlign(GID, Row, Col, #Center) ;FormatCells(GID, Row, Col, #Grades, "", #DefaultLanguage) Term$ = Grades(#DefaultLanguage)\Term If Grades(#DefaultLanguage)\Best < Grades(#DefaultLanguage)\Worst MarkCells(GID, Row, Col, #Grades, Term$, $578B2E, $2C2CEE) Else MarkCells(GID, Row, Col, #Grades, Term$, $2C2CEE, $578B2E) EndIf EndIf EndProcedure Procedure SetCellFlags(GID.i, Row.i, Col.i, Flags.i) ; #Cell/#Edit/#Checkbox/#Combo/#Button/#Image ; #String/#Integer/#Float/#Cash/#Date/#Time/#Grades ; #Check/#Valid/#AutoComplete/#Frame/#Update If Row = #AnyRow ; Any row of Col AddCellFlag(GID, #Any, Col, Flags) ElseIf Col = #AnyCol ; Any Col of row AddCellFlag(GID, Row, #Any, Flags) Else ; Selected Row & Col AddCellFlag(GID, Row, Col, Flags) EndIf EndProcedure Procedure RemoveCellFlags(GID.i, Row.i, Col.i, Flags.i) Define.i RFlags ; Flags: #Frame/#Edit/#Mark/#Check ; Remove: #NoFrame/#NoEdit/#NoMark/#NoCheck If Flags & #Edit : RFlags | #NoEdit : EndIf If Flags & #Frame : RFlags | #NoFrame : EndIf If Flags & #Check : RFlags | #NoCheck : EndIf If Flags & #Mark : RFlags | #NoMark : EndIf If Flags & #Update : RFlags | #NoUpdate : EndIf If Row = #AnyRow ; Any row of Col AddCellFlag(GID, #Any, Col, RFlags) ElseIf Col = #AnyCol ; Any Col of row AddCellFlag(GID, Row, #Any, RFlags) Else ; Selected Row & Col AddCellFlag(GID, Row, Col, RFlags) EndIf EndProcedure Procedure SetHeaderStyle(GID.i, FrontColor.i=$600000, BackColor.i=$F0D2BE, Border.i= $D1AE93 , Align.i=#Center) Define gid$ = Str(GID) If SelectCellsElement(GID, #AnyRow, #Header) <= 0 : InitStyle(GID, #AnyRow, #Header) : EndIf Grid(gid$)\Style()\Value("FrontColor") = FrontColor Grid(gid$)\Style()\Value("BackColor") = BackColor Grid(gid$)\Style()\Value("Align") = Align Grid(gid$)\Color\LabelBorder = Border If SelectCellsElement(GID, #Header, #AnyCol) <= 0 : InitStyle(GID, #Header, #AnyCol) : EndIf Grid(gid$)\Style()\Value("FrontColor") = FrontColor Grid(gid$)\Style()\Value("BackColor") = BackColor Grid(gid$)\Style()\Value("Align") = Align Grid(gid$)\Color\LabelBorder = Border EndProcedure ;----------------------------------------------------------------------------- ;--- Themes for grid ;----------------------------------------------------------------------------- Procedure DefaultThemes(GID.i) If FindMapElement(Grid(), Str(GID)) If AddMapElement(Theme(), "Blue") ;{ Theme()\GridFront = $412B1B Theme()\GridBack = $FEFDFD Theme()\GridLine = $EEE1D7 Theme()\GridFont = Grid()\Format\Font Theme()\BlockBack = $82F6F0EB Theme()\FocusBack = $FFFFFF;$FEFDFD Theme()\FocusBorder = $A87146 Theme()\Mistake = $0000FF Theme()\HeaderBorder = $D1AE93 Theme()\HeaderBack = $DEC4B0 Theme()\HeaderFront = $412B1B Theme()\HeaderAlign = #Center Theme()\HeaderFont = Grid()\Format\Font EndIf ;} If AddMapElement(Theme(), "Grey") ;{ Theme()\GridFront = $000000 Theme()\GridBack = $FCFCFC Theme()\GridLine = $E0E0E0 Theme()\GridFont = Grid()\Format\Font Theme()\BlockBack = $82FAFAFA Theme()\FocusBack = $FFFFFF Theme()\FocusBorder = $696969 Theme()\Mistake = $0000FF Theme()\HeaderBorder = $BDBDBD Theme()\HeaderBack = $E6E6E6 Theme()\HeaderFront = $3C3C3C Theme()\HeaderAlign = #Center Theme()\HeaderFont = Grid()\Format\Font EndIf ;} If AddMapElement(Theme(), "Green") ;{ Theme()\GridFront = $000000 Theme()\GridBack = $F6FAF6 Theme()\GridLine = $C6DDC6 Theme()\GridFont = Grid()\Format\Font Theme()\BlockBack = $82F0F6F0 Theme()\FocusBack = $FFFFFF Theme()\FocusBorder = $416D41 Theme()\Mistake = $0000FF Theme()\HeaderBorder = $6AA66A Theme()\HeaderBack = $8FBC8F Theme()\HeaderFront = $192B19 Theme()\HeaderAlign = #Center Theme()\HeaderFont = Grid()\Format\Font EndIf ;} EndIf EndProcedure Procedure SaveThemes(File$="") If File$ = "" : File$ = "GridEx_Themes.xml" : EndIf If CreateXML(#XML) InsertXMLMap(RootXMLNode(#XML), Theme()) FormatXML(#XML, #PB_XML_ReFormat) SaveXML(#XML, File$, #PB_XML_StringFormat) FreeXML(#XML) EndIf EndProcedure Procedure LoadThemes(File$="") If File$ = "" : File$ = "GridEx_Themes.xml" : EndIf If LoadXML(#XML, File$) ExtractXMLMap(MainXMLNode(#XML), Theme()) FreeXML(#XML) EndIf EndProcedure Procedure AddTheme(GID.i, Titel$) If FindMapElement(Grid(), Str(GID)) Theme(Titel$)\GridFront = Grid()\Color\GridFront Theme(Titel$)\GridBack = Grid()\Color\GridBack Theme(Titel$)\GridLine = Grid()\Color\GridLine Theme(Titel$)\GridBack = Grid()\Color\GridBack Theme(Titel$)\GridLine = Grid()\Color\GridLine Theme(Titel$)\BlockBack = Grid()\Color\BlockBack Theme(Titel$)\FocusBack = Grid()\Color\FocusBack Theme(Titel$)\FocusBorder = Grid()\Color\FocusBorder Theme(Titel$)\HeaderBorder = Grid()\Color\LabelBorder Theme(Titel$)\Mistake = Grid()\Color\Mistake Theme(Titel$)\GridFont = Grid()\Format\FontBold If SelectCellsElement(GID, #AnyRow, #Header) <= 0 : InitStyle(GID, #AnyRow, #Header) : EndIf Theme(Titel$)\HeaderFront = Grid()\Style()\Value("FrontColor") Theme(Titel$)\HeaderBack = Grid()\Style()\Value("BackColor") Theme(Titel$)\HeaderAlign = Grid()\Style()\Value("Align") Theme(Titel$)\HeaderFont = Grid()\Style()\Font If SelectCellsElement(GID, #Header, #AnyCol) <= 0 : InitStyle(GID, #Header, #AnyCol) : EndIf Theme(Titel$)\HeaderFront = Grid()\Style()\Value("FrontColor") Theme(Titel$)\HeaderBack = Grid()\Style()\Value("BackColor") Theme(Titel$)\HeaderAlign = Grid()\Style()\Value("Align") Theme(Titel$)\HeaderFont = Grid()\Style()\Font EndIf EndProcedure Procedure SetTheme(GID.i, Titel$) If FindMapElement(Grid(), Str(GID)) If FindMapElement(Theme(), Titel$) Grid()\Color\GridFront = Theme()\GridFront Grid()\Color\GridBack = Theme()\GridBack Grid()\Color\GridLine = Theme()\GridLine Grid()\Color\BlockBack = Theme()\BlockBack Grid()\Color\FocusBack = Theme()\FocusBack Grid()\Color\FocusBorder = Theme()\FocusBorder Grid()\Color\LabelBorder = Theme()\HeaderBorder Grid()\Color\Mistake = Theme()\Mistake Grid()\Format\Font = Theme()\GridFont FirstElement(Grid()\Style()) Grid()\Style()\Value("FrontColor") = Theme()\GridFront Grid()\Style()\Value("BackColor") = Theme()\GridBack If SelectCellsElement(GID, #AnyRow, #Header) <= 0 : InitStyle(GID, #AnyRow, #Header) : EndIf Grid()\Style()\Value("FrontColor") = Theme()\HeaderFront Grid()\Style()\Value("BackColor") = Theme()\HeaderBack Grid()\Style()\Value("Align") = Theme()\HeaderAlign Grid()\Style()\Font = Theme()\HeaderFont If SelectCellsElement(GID, #Header, #AnyCol) <= 0 : InitStyle(GID, #Header, #AnyCol) : EndIf Grid()\Style()\Value("FrontColor") = Theme()\HeaderFront Grid()\Style()\Value("BackColor") = Theme()\HeaderBack Grid()\Style()\Value("Align") = Theme()\HeaderAlign Grid()\Style()\Font = Theme()\HeaderFont EndIf EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Grid ;----------------------------------------------------------------------------- Procedure UseImageDecoder(Flag.i) Select Flag Case #PB_ImagePlugin_GIF UseGIFImageDecoder() Case #PB_ImagePlugin_JPEG UseJPEGImageDecoder() Case #PB_ImagePlugin_JPEG2000 UseJPEG2000ImageDecoder() Case #PB_ImagePlugin_PNG UsePNGImageDecoder() Case #PB_ImagePlugin_TGA UseTGAImageDecoder() Case #PB_ImagePlugin_TIFF UseTIFFImageDecoder() EndSelect EndProcedure Procedure AllowMouseResize(GID.i, State.i=#True) Grid(Str(GID))\MouseResize = State EndProcedure Procedure.i GetAttribute(GID.i, Attribute.i=#Attrib_Row, RowOrCol.i=0) Define.i i, n If FindMapElement(Grid(), Str(GID)) Select Attribute Case #Attrib_Row ProcedureReturn Grid()\Row\Current Case #Attrib_Col ProcedureReturn Grid()\Col\Current Case #Attrib_RowCount ProcedureReturn Grid()\Row\Number Case #Attrib_ColCount ProcedureReturn Grid()\Col\Number Case #Attrib_RowHeight If RowOrCol <= Grid()\Row\Number And RowOrCol >= 0 ProcedureReturn Grid()\Rows(RowOrCol)\Height EndIf Case #Attrib_ColWdith If RowOrCol <= Grid()\Col\Number And RowOrCol >= 0 ProcedureReturn Grid()\Cols(RowOrCol)\Width EndIf Case #Attrib_TopRow ProcedureReturn Grid()\Row\TopCell Case #Attrib_TopCol ProcedureReturn Grid()\Col\TopCell Case #Attrib_FrozenRow ProcedureReturn Grid()\Row\LastFrozen Case #Attrib_FrozenCol ProcedureReturn Grid()\Col\LastFrozen Case #Attrib_Block_Row2 ProcedureReturn Grid()\Block\Row2 Case #Attrib_Block_Col2 ProcedureReturn Grid()\Block\Col2 Case #Attrib_NonHiddenRow For i=1 To Grid()\Row\Number If Grid()\Rows(i)\Height <> -1 : n = n + 1: EndIf Next ProcedureReturn n Case #Attrib_NonHiddenCol For i=1 To Grid()\Col\Number If Grid()\Cols(i)\Width <> -1 : n = n + 1: EndIf Next ProcedureReturn n Case #Attrib_ChangedRow ProcedureReturn Grid()\Cell\LastRow Case #Attrib_ChangedCol ProcedureReturn Grid()\Cell\LastCol Case #Attrib_ClickedRow ProcedureReturn Grid()\Cell\ClickedRow Case #Attrib_ClickedCol ProcedureReturn Grid()\Cell\ClickedCol Case #Attrib_GadgetRowScroll ProcedureReturn Grid()\GId\VScroll Case #Attrib_GadgetColScroll ProcedureReturn Grid()\GId\HScroll EndSelect EndIf ProcedureReturn -1 EndProcedure Procedure AttachPopup(GID.i, Popup.i) Grid(Str(GID))\GId\PopupMenu = Popup EndProcedure Procedure SetFont(GID.i, Name$, Size.i, Flags.i=#False) Define Font$, FontID If FindMapElement(Grid(), Str(GID)) If FirstElement(Grid()\Style()) Font$ = Name$+"|"+Str(Size)+"|"+Str(Flags) FontID = SelectFont(GID, Font$) If FontID <> #NoElement Grid()\Format\Font = Font$ Grid()\Style()\Font = Font$ EndIf EndIf EndIf ProcedureReturn #False EndProcedure Procedure SetColor(GID.i, ColorType.i=#LineColor, Color.i=$CCCCCC) If FindMapElement(Grid(), Str(GID)) FirstElement(Grid()\Style()) Select ColorType Case #LineColor Grid()\Color\GridLine = Color Case #FrontColor Grid()\Color\GridFront = Color Grid()\Style()\Value("FrontColor") = Color Case #BackColor Grid()\Color\GridBack = Color Grid()\Style()\Value("BackColor") = Color Case #FocusBack Grid()\Color\FocusBack = Color Case #FocusBorder Grid()\Color\FocusBorder = Color Case #BlockBack Grid()\Color\BlockBack = Color Case #LabelBorder Grid()\Color\LabelBorder = Color Case #ErrorBack Grid()\Color\Mistake = Color EndSelect EndIf EndProcedure Procedure.i GetColor(GID.i, ColorType.i=#LineColor) If FindMapElement(Grid(), Str(GID)) Select ColorType Case #LineColor ProcedureReturn Grid()\Color\GridLine Case #FrontColor ProcedureReturn Grid()\Color\GridFront Case #BackColor ProcedureReturn Grid()\Color\GridBack Case #FocusBack ProcedureReturn Grid()\Color\FocusBack Case #FocusBorder ProcedureReturn Grid()\Color\FocusBorder Case #BlockBack ProcedureReturn Grid()\Color\BlockBack Case #LabelBorder ProcedureReturn Grid()\Color\LabelBorder Case #ErrorBack ProcedureReturn Grid()\Color\Mistake EndSelect EndIf ProcedureReturn #NoResult EndProcedure Procedure ReDefine(GID.i, Rows.i, Cols.i=#False) If Cols Initialize(GID, Rows, Cols) Else _ChangeRowNumber(GID, Rows) EndIf Draw(GID) EndProcedure Procedure ClearCells(GID.i) Define r, c If FindMapElement(Grid(), Str(GID)) DisableRedraw(GID, #True) For r=0 To Grid()\Row\Number If r > 0 : Grid()\Rows(r)\Header\Value = Str(r) : EndIf For c=1 To Grid()\Col\Number If r = #Label Grid()\Cols(c)\Header\Value = Str(c) Else Grid()\Entry(r)\Cell(c)\Value = "" EndIf Next Next Refresh(GID) EndIf EndProcedure Procedure ResetCells(GID.i) Define.i r, c If FindMapElement(Grid(), Str(GID)) For r=0 To Grid()\Row\Number For c=0 To Grid()\Col\Number Grid()\Entry(r)\Cell(c)\Flags = #False Grid()\Entry(r)\Cell(c)\Style = #False Grid()\Entry(r)\Cell(c)\Calc = #False Next Next ClearMap(Grid()\Lines\Top()) ClearMap(Grid()\Lines\Bottom()) ClearMap(Grid()\Lines\Left()) ClearMap(Grid()\Lines\Right()) ClearList(Grid()\Style()) AddElement(Grid()\Style()) Grid()\Style()\Value("Align") = #Left Grid()\Style()\Value("BackColor") = $FFFFFF Grid()\Style()\Value("FrontColor") = $000000 Grid()\Style()\Value("Gradient") = #False Grid()\Style()\Value("EditMode") = #Append Grid()\Style()\Value("Digits") = 3 Grid()\Style()\Value("MarkFlag") = #False Grid()\Style()\Value("MarkColor") = $000000 Grid()\Style()\Font = "Arial|8|" Grid()\Style()\FormatMask = "" Grid()\Style()\MarkTerm = "" ClearList(Grid()\Calc()) AddElement(Grid()\Calc()) SetHeaderStyle(GID) Refresh(GID) EndIf EndProcedure Procedure Resize(GID.i, X.i, Y.i, Width.i, Height.i) Define WinID.i If FindMapElement(Grid(), Str(GID)) If X = #PB_Ignore : X = Grid()\Size\X : EndIf If Y = #PB_Ignore : Y = Grid()\Size\Y : EndIf If Width = #PB_Ignore : Width = Grid()\Size\Width + #Scroll_Width : EndIf If Height = #PB_Ignore : Height = Grid()\Size\Height + #Scroll_Width : EndIf If Grid()\ScrollBars ResizeGadget(Grid()\GId\Container, X, Y, Width, Height) Width - #Scroll_Width Height - #Scroll_Width If IsGadget(Grid()\GId\HScroll) ResizeGadget(Grid()\GId\HScroll, 0, Height, Width, #Scroll_Width) EndIf If IsGadget(Grid()\GId\VScroll) ResizeGadget(Grid()\GId\VScroll, Width, 0, #Scroll_Width, Height) EndIf Else ResizeGadget(Grid()\GId\Container, X, Y, Width, Height-1) EndIf If IsGadget(Grid()\GId\Canvas) ResizeGadget(Grid()\GId\Canvas, 0, 0, Width, Height) EndIf Grid()\Size\X = X Grid()\Size\Y = Y Grid()\Size\Width = Width Grid()\Size\Height = Height WinID = Grid()\WinID If IsWindow(WinID) Grid()\Window\X = WindowX(WinID) Grid()\Window\Y = WindowY(WinID) Grid()\Window\Width = WindowWidth(WinID) Grid()\Window\Height = WindowHeight(WinID) EndIf Draw(GID) _AdjustScrolls(GID) EndIf EndProcedure Procedure Hide(GID.i, State=#False) HideGadget(Grid(Str(GID))\GId\Container, State) EndProcedure Procedure Free(GID.i) If IsGadget(GID) FreeGadget(GID) If FindMapElement(Grid(), Str(GID)) If IsGadget(Grid()\GId\HScroll) : FreeGadget(Grid()\GId\HScroll) : EndIf If IsGadget(Grid()\GId\VScroll) : FreeGadget(Grid()\GId\VScroll) : EndIf If IsGadget(Grid()\GId\String) : FreeGadget(Grid()\GId\String) : EndIf If IsGadget(Grid()\GId\ListView) : FreeGadget(Grid()\GId\ListView) : EndIf EndIf DeleteMapElement(Grid(), Str(GID)) EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Cells ;----------------------------------------------------------------------------- Procedure IsValidCell(GID.i, Row.i, Col.i) If _IsValidCell(GID, Row, Col) ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure GetCellAttribute(GID.i, Row.i, Col.i, Attribute.i) Define FontID.i If FindMapElement(Grid(), Str(GID)) If Row = #AnyRow ;{ Any row of Col Select Attribute Case #CellType ProcedureReturn Grid()\Entry(0)\Cell(Col)\Flags Case #EditMode ProcedureReturn Grid()\Style()\Value("EditMode") Case #CellAlign ProcedureReturn Grid()\Style()\Value("Align") Case #CellFont FontID = Grid()\Font(Grid()\Style()\Font) ProcedureReturn FontID EndSelect ;} ElseIf Col = #AnyCol ;{ Any Col of row Select Attribute Case #CellType ProcedureReturn Grid()\Entry(Row)\Cell(0)\Flags Case #EditMode ProcedureReturn Grid()\Style()\Value("EditMode") Case #CellAlign ProcedureReturn Grid()\Style()\Value("Align") Case #CellFont FontID = Grid()\Font(Grid()\Style()\Font) ProcedureReturn FontID EndSelect ;} Else ;{ Selected Row & Col If SelectCellsElement(GID, Row, Col) <> #NoElement Select Attribute Case #CellType ProcedureReturn Grid()\Entry(Row)\Cell(Col)\Flags Case #EditMode ProcedureReturn Grid()\Style()\Value("EditMode") Case #CellAlign ProcedureReturn Grid()\Style()\Value("Align") Case #CellFont FontID = Grid()\Font(Grid()\Style()\Font) ProcedureReturn FontID EndSelect Else ProcedureReturn #NoElement EndIf ;} EndIf EndIf ProcedureReturn #NoResult EndProcedure Procedure AddListItems(GID.i, Row.i, Col.i, Items$, ItemSep.s=#LF$) Define gid$ = Str(GID) NewList Item.s() If IsCellFlag(GID, Row, Col, #Edit) ClearList(Grid(gid$)\EditStrg\Words()) _ExtractFields(Items$, ItemSep, Item()) ForEach Item() AddElement(Grid(gid$)\EditStrg\Words()) Grid(gid$)\EditStrg\Words() = Item() Next Grid(gid$)\Entry(Row)\Cell(Col)\Flags | #AutoComplete ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure Procedure AddComboItems(GID.i, Row.i, Col.i, Items$, ItemSep.s=#LF$) Define gid$ = Str(GID) NewList Item.s() If SelectCellsElement(GID, Row, Col) <= 0 : InitStyle(GID, Row, Col) : EndIf If IsCellFlag(GID, Row, Col, #Combo) ClearList(Grid(gid$)\Style()\Items()) _ExtractFields(Items$, ItemSep, Item()) ForEach Item() AddElement(Grid(gid$)\Style()\Items()) Grid(gid$)\Style()\Items() = Item() Next ProcedureReturn #True EndIf ProcedureReturn #False EndProcedure ;----------------------------------------------------------------------------- ;--- Columns ;----------------------------------------------------------------------------- Procedure AllowColumnResize(GID.i, Col.i, State.i=#True) If FindMapElement(Grid(), Str(GID)) If State Grid()\Cols(Col)\Resize = #Resize Col + 1 If Col <= Grid()\Col\Number Grid()\Cols(Col)\Resize = #Resize EndIf Else Grid()\Cols(Col)\Resize = #NoResize Col + 1 If Col <= Grid()\Col\Number Grid()\Cols(Col)\Resize = #NoResize EndIf EndIf EndIf EndProcedure Procedure SetColumnWidth(GID.i, Col.i, Width.i=#Default_ColWidth) _ChangeColWidth(GID, Col, Width) Draw(GID) EndProcedure Procedure HideColumn(GID.i, Col.i, State) If State _ChangeColWidth(GID, Col, -1) ; hidden by application cannot be un-hidden by user Draw(GID) Else _ChangeColWidth(GID, Col, #Default_ColWidth) Draw(GID) EndIf EndProcedure Procedure.i AutoColumnWidth(GID.i, Col.i) Define.i r, maxWidth, Width, iC, C1, C2, Redraw, FontID Define Cell$ Define Style.Grid_Style_Structure If Not _IsValidGenericCol(GID, Col) : ProcedureReturn #False : EndIf If FindMapElement(Grid(), Str(GID)) If Col >= 0 C1 = Col C2 = Col EndIf If Col = #AnyCol C1 = 1 C2 = Grid()\Col\Number EndIf If Col = 0 C1 = 0 C2 = 0 EndIf ; dummy StartDrawing to measure text-width If StartDrawing(CanvasOutput(Grid()\GId\Canvas)) For iC = C1 To C2 If Grid()\Cols(iC)\Width = -1 : Continue : EndIf maxWidth = 0 For r = 0 To Grid()\Row\Number Cell$ = _GetCellText(GID, r, iC) If Cell$ <> "" GetCellStyle(GID, r, iC, @Style) FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf Width = TextWidth(Cell$) If Width > maxWidth : maxWidth = Width : EndIf EndIf Next r maxWidth = maxWidth + (2 * #Text_MarginX) If Grid()\Cols(iC)\Width <> maxWidth If maxWidth > 0.9 * Grid()\Size\Width : maxWidth = 0.9 * Grid()\Size\Width : EndIf _ChangeColWidth(GID, iC, maxWidth) Redraw = #True EndIf Next iC StopDrawing() EndIf If Redraw : Draw(GID) : EndIf EndIf EndProcedure Procedure FreezeColumn(GID.i, Col.i) If Col <= Grid(Str(GID))\Col\Number And Col >= 0 Grid(Str(GID))\Col\LastFrozen = Col _AdjustScrolls(GID) EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Rows ;----------------------------------------------------------------------------- Procedure AllowRowResize(GID.i, Row.i, State.i=#True) If FindMapElement(Grid(), Str(GID)) If State Grid()\Rows(Row)\Resize = #Resize Row + 1 If Row <= Grid()\Row\Number Grid()\Rows(Row)\Resize = #Resize EndIf Else Grid()\Rows(Row)\Resize = #NoResize Row + 1 If Row <= Grid()\Row\Number Grid()\Rows(Row)\Resize = #NoResize EndIf EndIf EndIf EndProcedure Procedure SetRowHeight(GID.i, Row.i, Height.i=#Default_RowHeight) _ChangeRowHeight(GID, Row, Height) Draw(GID) EndProcedure Procedure HideRow(GID.i, Row.i, State) If State _ChangeRowHeight(GID, Row, -1) ; hidden by application cannot be un-hidden by user Draw(GID) Else _ChangeRowHeight(GID, Row, #Default_RowHeight) Draw(GID) EndIf EndProcedure Procedure AutoRowHeight(GID.i, Row.i) Define.i c, maxHeight, Height, iR, R1, R2, Redraw, FontID Define Cell$ Define Style.Grid_Style_Structure If Not _IsValidGenericRow(GID, Row) : ProcedureReturn : EndIf If FindMapElement(Grid(), Str(GID)) If Row >= 0 R1 = Row R2 = Row EndIf If Row = #AnyRow R1 = 1 R2 = Grid()\Row\Number EndIf If Row = 0 R1 = 0 R2 = 0 EndIf ; dummy StartDrawing to measure text-width If StartDrawing(CanvasOutput(Grid()\GId\Canvas)) For iR = R1 To R2 If Grid()\Rows(iR)\Height = -1 : Continue : EndIf maxHeight = 0 For c = 0 To Grid()\Col\Number Cell$ = _GetCellText(GID, iR, c) If Cell$ <> "" GetCellStyle(GID, iR, c, @Style) FontID = Grid()\Font(Style\Font) If IsFont(FontID) : DrawingFont(FontID(FontID)) : EndIf Height = TextHeight(Cell$) If Height > maxHeight : maxHeight = Height : EndIf EndIf Next c maxHeight = maxHeight + (2 * #Text_MarginY) If Grid()\Rows(iR)\Height <> maxHeight If maxHeight > 0.9 * Grid()\Size\Height : maxHeight = 0.9 * Grid()\Size\Height : EndIf _ChangeRowHeight(GID, iR, maxHeight) Redraw = #True EndIf Next iR StopDrawing() EndIf If Redraw : Draw(GID) : EndIf EndIf EndProcedure Procedure FreezeRow(GID.i, Row.i) If Row <= Grid(Str(GID))\Row\Number And Row >= 0 Grid(Str(GID))\Row\LastFrozen = Row _AdjustScrolls(GID) EndIf EndProcedure Procedure.i MergeCells(GID.i, Row1.i, Col1.i, Row2.i, Col2.i) ; return the index of the Multi-cell in LstMulti() ; if Style = -1 ---> Multi-cell will receive the style of its upper-left cell Define.i iR, iC, MultiIdx If Row1 > Row2 : Swap Row1 , Row2 : EndIf If Col1 > Col2 : Swap Col1 , Col2 : EndIf If Row1 = Row2 And Col1 = Col2 : ProcedureReturn -1 : EndIf If _IsValidCell(GID, Row1, Col1) And _IsValidCell(GID, Row2, Col2) If FindMapElement(Grid(), Str(GID)) ForEach Grid()\MultiCellList() If _BlocksHaveIntersection(Grid()\MultiCellList()\Row1, Grid()\MultiCellList()\Row2, Grid()\MultiCellList()\Col1, Grid()\MultiCellList()\Col2, Row1, Row2, Col1, Col2) ProcedureReturn -1 ; we stop merging! 2 multis cant overlap EndIf Next AddElement( Grid()\MultiCellList() ) MultiIdx = ListIndex(Grid()\MultiCellList()) Grid()\MultiCellList()\Row1 = Row1 Grid()\MultiCellList()\Row2 = Row2 Grid()\MultiCellList()\Col1 = Col1 Grid()\MultiCellList()\Col2 = Col2 EndIf ProcedureReturn MultiIdx EndIf ProcedureReturn -1 EndProcedure Procedure UnMergeCells(GID.i, Row.i, Col.i) ; un-merge cells ... (Row, Col) is any cell member of the Multi-cell Define.i iR, iC, MultiIdx If _IsValidCell(GID, Row, Col) MultiIdx = _MultiOfCell(GID, Row, Col) If MultiIdx >= 0 SelectElement(Grid(Str(GID))\MultiCellList(), MultiIdx) DeleteElement(Grid(Str(GID))\MultiCellList()) EndIf EndIf EndProcedure Procedure.i AddRow(GID.i, Value$="", Position.i=-1, ColSep$=#LF$) Define gid$ = Str(GID) Define.i c, r, Count, Cols, Rows, oRows If FindMapElement(Grid(), Str(GID)) oRows = Grid()\Row\Number Cols = Grid()\Col\Number Rows = oRows + 1 Grid()\Row\Number = Rows ReDim Grid()\Entry(Rows) ReDim Grid()\Rows(Rows) Dim Grid()\Entry(Rows)\Cell(Cols) Grid()\Rows(Rows)\Header\Value = Str(Rows) Grid()\Entry(Rows)\Cell(0)\Value = Str(Rows) Grid()\Rows(Rows)\Height = #Default_RowHeight If Value$ Count = CountString(Value$, ColSep$) + 1 For c=1 To Count Grid()\Entry(Rows)\Cell(c)\Value = StringField(Value$, c, ColSep$) Next EndIf If Position = -1 Grid()\Entry(Rows)\SortPos = Rows Else Grid()\Entry(Rows)\SortPos = Position For r=1 To Rows If Grid()\Entry(r)\SortPos >= Position Grid()\Entry(r)\SortPos + 1 EndIf Next EndIf If Grid()\Row\TopCell > Grid()\Row\Number : Grid()\Row\TopCell = Grid()\Row\Number : EndIf If Grid()\Row\Current > Grid()\Row\Number : Grid()\Row\Current = Grid()\Row\Number : EndIf If Grid()\Block\Row2 > Grid()\Row\Number : Grid()\Block\Row2 = Grid()\Row\Number : EndIf If Grid()\Col\TopCell > Grid()\Col\Number : Grid()\Col\TopCell = Grid()\Col\Number : EndIf If Grid()\Col\Current > Grid()\Col\Number : Grid()\Col\Current = Grid()\Col\Number : EndIf If Grid()\Block\Col2 > Grid()\Col\Number : Grid()\Block\Col2 = Grid()\Col\Number : EndIf _AdjustScrolls(GID) ; set min/max/page of scrolls ProcedureReturn Grid()\Row\Number EndIf EndProcedure Procedure DeleteRow(GID.i, Row.i) Define gid$ = Str(GID) Define.i r, Rows = Grid(gid$)\Row\Number If _IsValidRow(GID, Row) Grid(gid$)\Entry(Row)\SortPos = -1 ; The line to be deleted must be the last element. SortStructuredArray(Grid(gid$)\Entry(), #PB_Sort_Descending, OffsetOf(Grid_Entry_Structure\SortPos), TypeOf(Grid_Entry_Structure\SortPos), 1, Rows) ReDim Grid(gid$)\Entry(Rows-1) ReDim Grid(gid$)\Rows(Rows-1) SortStructuredArray(Grid(gid$)\Entry(), #PB_Sort_Ascending, OffsetOf(Grid_Entry_Structure\SortPos), TypeOf(Grid_Entry_Structure\SortPos), 1, Rows-1) For r=1 To Rows - 1 ; Adjust the position number Grid(gid$)\Entry(Row)\SortPos = r Next Grid(gid$)\Row\Number = Rows - 1 If Grid(gid$)\Row\TopCell > Grid(gid$)\Row\Number : Grid(gid$)\Row\TopCell = Grid(gid$)\Row\Number : EndIf If Grid(gid$)\Row\Current > Grid(gid$)\Row\Number : Grid(gid$)\Row\Current = Grid(gid$)\Row\Number : EndIf If Grid(gid$)\Block\Row2 > Grid(gid$)\Row\Number : Grid(gid$)\Block\Row2 = Grid(gid$)\Row\Number : EndIf If Grid(gid$)\Col\TopCell > Grid(gid$)\Col\Number : Grid(gid$)\Col\TopCell = Grid(gid$)\Col\Number : EndIf If Grid(gid$)\Col\Current > Grid(gid$)\Col\Number : Grid(gid$)\Col\Current = Grid(gid$)\Col\Number : EndIf If Grid(gid$)\Block\Col2 > Grid(gid$)\Col\Number : Grid(gid$)\Block\Col2 = Grid(gid$)\Col\Number : EndIf _AdjustScrolls(GID) ; set min/max/page of scrolls EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Blocks ;----------------------------------------------------------------------------- Procedure.i ResetBlock(GID.i) If _HasBlock(GID) _ResetBlock(GID) Draw(GID) Else _ResetBlock(GID) EndIf EndProcedure Procedure IsSelected(GID.i) If _HasBlock(GID) ProcedureReturn #True EndIf EndProcedure Procedure IsCellSelected(GID.i, Row.i, Col.i) Define.i Row1, Row2, Col1, Col2 If FindMapElement(Grid(), Str(GID)) ;{ Get selected area Row1 = Grid()\Block\Row1 : Row2 = Grid()\Block\Row2 If Row1 > Row2 Row1 = Grid()\Block\Row2 : Row2 = Grid()\Block\Row1 EndIf Col1 = Grid()\Block\Col1 : Col2 = Grid()\Block\Col2 If Col1 > Col2 Col1 = Grid()\Block\Col2 : Col2 = Grid()\Block\Col1 EndIf ;} If Row < Row1 Or Row > Row2 ProcedureReturn #False EndIf If Col < Col1 Or Col > Col2 ProcedureReturn #False EndIf ProcedureReturn #True EndIf EndProcedure Procedure RemoveSelection(GID.i) If _HasBlock(GID) ResetBlock(GID) Draw(GID) Else ResetBlock(GID) EndIf EndProcedure Procedure SelectCells(GID.i, Row1.i, Col1.i, Row2.i, Col2.i) _StartBlock(GID, Row1,Col1, Row2, Col2) Draw(GID) EndProcedure Procedure SelectAll(GID.i) Define.i Col1 = 1, Col2 = Grid(Str(GID))\Col\Number Define.i Row1 = 1, Row2 = Grid(Str(GID))\Row\Number _StartBlock(GID, Row1, Col1, Row2, Col2) Draw(GID) EndProcedure ;----------------------------------------------------------------------------- ;--- Export / Save / ClipBoard ;----------------------------------------------------------------------------- Procedure GetSelection(GID.i) If FindMapElement(Grid(), Str(GID)) If IsSelected(GID) Area\Row\First = Grid()\Block\Row1 Area\Row\Last = Grid()\Block\Row2 If Grid()\Block\Row1 > Grid()\Block\Row2 Area\Row\First = Grid()\Block\Row2 Area\Row\Last = Grid()\Block\Row1 EndIf Area\Col\First = Grid()\Block\Col1 Area\Col\Last = Grid()\Block\Col2 If Grid()\Block\Col1 > Grid()\Block\Col2 Area\Col\First = Grid()\Block\Col2 Area\Col\Last = Grid()\Block\Col1 EndIf ProcedureReturn #Area ElseIf MapSize(Grid()\Row\Selected()) > 0 ClearList(Rows()) ForEach Grid()\Row\Selected() AddElement(Rows()) Rows() = Val(MapKey(Grid()\Row\Selected())) Next ProcedureReturn #Rows EndIf EndIf ProcedureReturn #False EndProcedure Procedure GetSelectedArea(GID.i, *Area.Select_Area_Structure) If FindMapElement(Grid(), Str(GID)) If IsSelected(GID) *Area\Row1 = Grid()\Block\Row1 *Area\Row2 = Grid()\Block\Row2 If *Area\Row1 > *Area\Row2 *Area\Row1 = Grid()\Block\Row2 *Area\Row2 = Grid()\Block\Row1 EndIf *Area\Col1 = Grid()\Block\Col1 *Area\Col2 = Grid()\Block\Col2 If *Area\Col1 > *Area\Col2 *Area\Col1 = Grid()\Block\Col2 *Area\Col2 = Grid()\Block\Col1 EndIf ProcedureReturn #True EndIf EndIf ProcedureReturn #False EndProcedure Procedure CopyToClipboard(GID.i, Flags.i=#Tabulator) Define Row$, ClipBoard$, Sep$ Define.i r, c, Cols Define SelectArea.Select_Area_Structure If FindMapElement(Grid(), Str(GID)) If Flags & #Semicolon Sep$ = ";" ElseIf Flags & #Comma Sep$ = "," Else Sep$ = #TAB$ EndIf If GetSelectedArea(GID.i, @SelectArea) ;{ Selected Area If Flags & #Labels For c = SelectArea\Col1 To SelectArea\Col2 If Sep$ = #TAB$ Row$ + Grid()\Cols(c)\Header\Value + Sep$ Else Row$ + Chr(34) + Grid()\Cols(c)\Header\Value + Chr(34) + Sep$ EndIf Next ClipBoard$ + RTrim(Row$, Sep$) + #LF$ EndIf For r = SelectArea\Row1 To SelectArea\Row2 Row$ = "" For c = SelectArea\Col1 To SelectArea\Col2 If Sep$ = #TAB$ Row$ + Grid()\Entry(r)\Cell(c)\Value + Sep$ Else Row$ + Chr(34) + Grid()\Entry(r)\Cell(c)\Value + Chr(34) + Sep$ EndIf Next ClipBoard$ + RTrim(Row$, Sep$) + #LF$ Next SetClipboardText(ClipBoard$) ;} ElseIf MapSize(Grid()\Row\Selected()) > 0 ;{ Selected Rows Cols = Grid()\Col\Number ForEach Grid()\Row\Selected() Row$ = "" r = Val(MapKey(Grid()\Row\Selected())) For c = 1 To Cols If Sep$ = #TAB$ Row$ + Grid()\Entry(r)\Cell(c)\Value + Sep$ Else Row$ + Chr(34) + Grid()\Entry(r)\Cell(c)\Value + Chr(34) + Sep$ EndIf Next ClipBoard$ + RTrim(Row$, Sep$) + #LF$ Next SetClipboardText(ClipBoard$) ClearMap(Grid()\Row\Selected()) Grid()\Row\FirstSelected = #False Draw(GID) ElseIf MapSize(Grid()\Cell\Selected()) > 0 ForEach Grid()\Cell\Selected() r = Val(StringField(MapKey(Grid()\Cell\Selected()), 1, "|")) c = Val(StringField(MapKey(Grid()\Cell\Selected()), 2, "|")) If Sep$ = #TAB$ Row$ + Grid()\Entry(r)\Cell(c)\Value + Sep$ Else Row$ + Chr(34) + Grid()\Entry(r)\Cell(c)\Value + Chr(34) + Sep$ EndIf Next ClipBoard$ + RTrim(Row$, Sep$) + #LF$ SetClipboardText(ClipBoard$) ClearMap(Grid()\Cell\Selected()) Draw(GID) ;} EndIf EndIf EndProcedure Procedure PasteFromClipboard(GID.i) Define Row$, Cell$, ClipBoard$, Sep$, LF$ Define.i Rows, Cols, idxR, idxC, r, c Define SelectArea.Select_Area_Structure If FindMapElement(Grid(), Str(GID)) ClipBoard$ = GetClipboardText() If CountString(ClipBoard$, #CRLF$) LF$ = #CRLF$ ElseIf CountString(ClipBoard$, #LF$) LF$ = #LF$ ElseIf CountString(ClipBoard$, #CR$) LF$ = #CR$ Else ProcedureReturn #False EndIf If CountString(ClipBoard$, ~"\";\"") ;{ ClipBoard$ = Trim(ReplaceString(ClipBoard$, ~"\";\"", "|"), Chr(34)) ElseIf CountString(ClipBoard$, ~"\",\"") ClipBoard$ = Trim(ReplaceString(ClipBoard$, ~"\",\"", "|"), Chr(34)) ElseIf CountString(ClipBoard$, ~"\":\"") ClipBoard$ = Trim(ReplaceString(ClipBoard$, ~"\":\"", "|"), Chr(34)) ElseIf CountString(ClipBoard$, ~"\" \"") ClipBoard$ = Trim(ReplaceString(ClipBoard$, ~"\" \"", "|"), Chr(34)) ElseIf CountString(ClipBoard$, Chr(34)) ClipBoard$ = RemoveString(ClipBoard$, Chr(34)) ElseIf CountString(ClipBoard$, #TAB$) ClipBoard$ = ReplaceString(ClipBoard$, #TAB$, "|") EndIf ;} If GetSelectedArea(GID.i, @Area) idxR = 1 For r = SelectArea\Row1 To SelectArea\Row2 idxC = 1 Row$ = RemoveString(StringField(ClipBoard$, idxR, LF$), LF$) For c = SelectArea\Col1 To SelectArea\Col2 Grid()\Entry(r)\Cell(c)\Value = StringField(Row$, idxC, "|") idxC + 1 Next idxR + 1 Next GridEx::RemoveSelection(GID) Draw(GID) ElseIf MapSize(Grid()\Row\Selected()) > 0 Rows = MapSize(Grid()\Row\Selected()) Cols = Grid()\Col\Number idxR = 1 ForEach Grid()\Row\Selected() r = Val(MapKey(Grid()\Row\Selected())) Row$ = RemoveString(StringField(ClipBoard$, idxR, LF$), LF$) For c = 1 To Cols Grid()\Entry(r)\Cell(c)\Value = StringField(Row$, c, "|") Next idxR + 1 Next ClearMap(Grid()\Row\Selected()) Draw(GID) ElseIf MapSize(Grid()\Cell\Selected()) > 0 Row$ = StringField(ClipBoard$, 1, LF$) idxC = 1 ForEach Grid()\Cell\Selected() r = Val(StringField(MapKey(Grid()\Cell\Selected()), 1, "|")) c = Val(StringField(MapKey(Grid()\Cell\Selected()), 2, "|")) Grid()\Entry(r)\Cell(c)\Value = StringField(Row$, idxC, "|") idxC + 1 Next ClearMap(Grid()\Cell\Selected()) Draw(GID) EndIf EndIf EndProcedure Procedure GetSelectedRows(GID.i) Define.i c, r, Rows, Cols If FindMapElement(Grid(), Str(GID)) Rows = MapSize(Grid()\Row\Selected()) Cols = Grid()\Col\Number Dim Cells.s(Rows, Cols) ForEach Grid()\Row\Selected() r = Val(MapKey(Grid()\Row\Selected())) For c = 0 To Cols Cells(r, c) = Grid()\Entry(r)\Cell(c)\Value Next Next EndIf EndProcedure Procedure GetSelectedCells(GID.i, Flags.i=#False) Define.i r, c, idxR=0, idxC=0 Define SelectArea.Select_Area_Structure If FindMapElement(Grid(), Str(GID)) If GetSelectedArea(GID, @Area) If Flags & #NoHeader = #False Dim Cells.s(SelectArea\Row2 - SelectArea\Row1 + 1, SelectArea\Col2 - SelectArea\Col1) idxC = 0 For c = SelectArea\Col1 To SelectArea\Col2 Cells(idxR, idxC) = Grid()\Cols(c)\Header\Value idxC + 1 Next idxR + 1 Else Dim Cells.s(SelectArea\Row2 - SelectArea\Row1, SelectArea\Col2 - SelectArea\Col1) EndIf For r = SelectArea\Row1 To SelectArea\Row2 idxC = 0 For c = SelectArea\Col1 To SelectArea\Col2 Cells(idxR, idxC) = Grid()\Entry(r)\Cell(c)\Value idxC + 1 Next c idxR + 1 Next r ProcedureReturn #True EndIf EndIf ProcedureReturn #False EndProcedure Procedure ClearSelectedCells(GID.i) Define.i r, c Define SelectArea.Select_Area_Structure If FindMapElement(Grid(), Str(GID)) If GetSelectedArea(GID.i, @Area) For r = SelectArea\Row1 To SelectArea\Row2 For c = SelectArea\Col1 To SelectArea\Col2 Grid()\Entry(r)\Cell(c)\Value = "" Next Next EndIf RemoveSelection(GID) EndIf EndProcedure Procedure ExportFileCSV(GID.i, File$, Flags.i) Define gid$ = Str(GID), Row$, Sep$ Define.i Rows, Cols, FileID, r, c, idxR, idxC Rows = Grid(gid$)\Row\Number Cols = Grid(gid$)\Col\Number If Flags & #Semicolon Sep$ = ";" Else Sep$ = "," EndIf FileID = CreateFile(#PB_Any, File$) If FileID For r = 0 To Rows idxC = 0 : Row$ = "" For c = 1 To Cols If r = #Header If Flags & #NoHeader = #False Row$ + Chr(34) + Grid(gid$)\Cols(c)\Header\Value + Chr(34) + Sep$ Else Continue EndIf Else Row$ + Chr(34) + Grid(gid$)\Entry(r)\Cell(c)\Value + Chr(34) + Sep$ EndIf Next WriteStringN(FileID, RTrim(Row$, Sep$)) Next CloseFile(FileID) EndIf EndProcedure Procedure ImportFileCSV(GID.i, File$, Flag.i=#False) Define.i r, Format, Rows, Cols, Header$ NewList Row.s() If ReadFile(#File, File$) Format = ReadStringFormat(#File) While Eof(#File) = #False AddElement(Row()) Row() = ReadString(#File, #PB_UTF8) Wend CloseFile(#File) EndIf ForEach Row() Row() = ReplaceString(Row(), Chr(34)+";"+Chr(34), "|") Row() = Trim(ReplaceString(Row(), Chr(34)+","+Chr(34), "|"), Chr(34)) Next FirstElement(Row()) If Flag & #NoHeader = #False Header$ = Row() DeleteElement(Row()) FirstElement(Row()) EndIf Rows = ListSize(Row()) Cols = CountString(Row(), "|") + 1 If Cols > Grid(Str(GID))\Col\Number Or Cols = 0 ProcedureReturn #False EndIf DisableRedraw(GID, #True) ClearCells(GID) If Rows <> Grid(Str(GID))\Row\Number _ChangeRowNumber(GID, Rows) EndIf If Flag = #Labels _SetRowText(GID, #Header, Header$, "|") EndIf FirstElement(Row()) For r=1 To Rows SetRowText(GID, r, Row(), "|") NextElement(Row()) Next Refresh(GID) ProcedureReturn #True EndProcedure Procedure SaveGridSize(Gid.i, File$="") Define gid$ = Str(GID) Define.i WinID = Grid(gid$)\WinID Define.i GridID = Grid(gid$)\GId\Container Define.i r, c, Rows, Cols, WinID = Grid(gid$)\WinID Define Size.Export_Size_Structure If File$ = "" : File$ = "GridEx.win" : EndIf Size\Win\X = WindowX(WinID) Size\Win\Y = WindowY(WinID) Size\Win\Width = WindowWidth(WinID) Size\Win\Height = WindowHeight(WinID) Size\Grid\X = GadgetX(GridID) Size\Grid\Y = GadgetY(GridID) Size\Grid\Width = GadgetWidth(GridID) Size\Grid\Height = GadgetHeight(GridID) Rows = ArraySize(Grid(gid$)\Rows()) Dim Size\Rows(Rows) For r = 0 To Rows Size\Rows(r) = Grid(gid$)\Rows(r)\Height Next Cols = ArraySize(Grid(gid$)\Cols()) Dim Size\Cols(Cols) For c = 0 To Cols Size\Cols(c) = Grid(gid$)\Cols(c)\Width Next If CreateJSON(#JSON) InsertJSONStructure(JSONValue(#JSON), @Size, Export_Size_Structure) SaveJSON(#JSON, File$) EndIf EndProcedure Procedure LoadGridSize(GID.i, File$="", Flags.i=#Grid) Define gid$ = Str(GID) Define.i r, c, Rows, Cols, lRows, lCols Define Size.Export_Size_Structure If File$ = "" : File$ = "GridEx.win" : EndIf If LoadJSON(#JSON, File$) Dim Size\Rows(0) Dim Size\Cols(0) ExtractJSONStructure(JSONValue(#JSON), @Size, Export_Size_Structure) Else ProcedureReturn #False EndIf If Flags & #Window ResizeWindow(Grid(gid$)\WinID, Size\Win\X, Size\Win\Y, Size\Win\Width, Size\Win\Height) Grid()\Window\X = Size\Win\X Grid()\Window\Y = Size\Win\Y Grid()\Window\Width = Size\Win\Width Grid()\Window\Height = Size\Win\Height EndIf If Flags & #Grid Resize(GID, Size\Grid\X, Size\Grid\Y, Size\Grid\Width, Size\Grid\Height) EndIf Rows = ArraySize(Grid(gid$)\Rows()) lRows = ArraySize(Size\Rows()) If Rows > lRows : Rows = lRows : EndIf For r = 0 To Rows Grid(gid$)\Rows(r)\Height = Size\Rows(r) Next Cols = ArraySize(Grid(gid$)\Cols()) lCols = ArraySize(Size\Cols()) If Cols > lCols : Cols = lCols : EndIf For c = 0 To Cols Grid(gid$)\Cols(c)\Width = Size\Cols(c) Next EndProcedure Procedure SaveTheme(GID.i, File$="") If File$ = "" : File$ = "GridEx_Theme.xml" : EndIf AddTheme(GID, "Save") If CreateXML(#XML) InsertXMLStructure(RootXMLNode(#XML), @Theme("Save"), GridEx_Theme_Structure) FormatXML(#XML, #PB_XML_ReFormat) SaveXML(#XML, File$, #PB_XML_StringFormat) FreeXML(#XML) EndIf DeleteMapElement(Theme(), "Save") EndProcedure Procedure SaveGridDesign() EndProcedure Procedure SaveGridData(GID.i, File$="") Define.i Rows, Cols, r, c Define Save.Save_GridData_Structure If FindMapElement(Grid(), Str(GID)) If File$ = "" : File$ = "GridEx_Data.xml" : EndIf Rows = Grid()\Row\Number Cols = Grid()\Col\Number Dim Save\Rows(Rows) For r = 0 To Rows Save\Rows(r)\Flags = Grid()\Rows(r)\Header\Flags Save\Rows(r)\Calc = Grid()\Rows(r)\Header\Calc Save\Rows(r)\Image = Grid()\Rows(r)\Header\Image Save\Rows(r)\Style = Grid()\Rows(r)\Header\Style Save\Rows(r)\Value = Grid()\Rows(r)\Header\Value Next Dim Save\Cols(Cols) For c = 0 To Cols Save\Cols(c)\Flags = Grid()\Cols(c)\Header\Flags Save\Cols(c)\Calc = Grid()\Cols(c)\Header\Calc Save\Cols(c)\Image = Grid()\Cols(c)\Header\Image Save\Cols(c)\Style = Grid()\Cols(c)\Header\Style Save\Cols(c)\Value = Grid()\Cols(c)\Header\Value Next Dim Save\Entry(Rows) For r = 0 To Rows Dim Save\Entry(r)\Cell(Cols) Save\Entry(r)\RowData = Grid()\Entry(r)\RowData For c = 0 To Cols Save\Entry(r)\Cell(c)\Flags = Grid()\Entry(r)\Cell(c)\Flags Save\Entry(r)\Cell(c)\Style = Grid()\Entry(r)\Cell(c)\Style Save\Entry(r)\Cell(c)\Calc = Grid()\Entry(r)\Cell(c)\Calc Save\Entry(r)\Cell(c)\Image = Grid()\Entry(r)\Cell(c)\Image Save\Entry(r)\Cell(c)\Value = Grid()\Entry(r)\Cell(c)\Value Next Next If CreateXML(#XML) InsertXMLStructure(RootXMLNode(#XML), @Save, Save_GridData_Structure) FormatXML(#XML, #PB_XML_ReFormat) SaveXML(#XML, File$, #PB_XML_StringFormat) FreeXML(#XML) EndIf EndIf EndProcedure Procedure Save(GID.i, File$="") SaveGridData(GID, File$) ;SaveConfig(GID, File$) SaveTheme(GID, File$) EndProcedure ;----------------------------------------------------------------------------- ;--- Events ;----------------------------------------------------------------------------- Declare BindShortcuts(GID.i, State.i=#True) Procedure _Resize() ; internal event handler: resize the grid ... requested by end-user/window resized Define.i EventGadget, GID, X, Y, Width, Height, ContainerID EventGadget = EventGadget() GID = GetGadgetData(EventGadget) If FindMapElement(Grid(), Str(GID)) X = GadgetX(Grid()\GId\Container) Y = GadgetY(Grid()\GId\Container) Width = GadgetWidth(Grid()\GId\Container) Height = GadgetHeight(Grid()\GId\Container) If Grid()\ScrollBars Width - #Scroll_Width Height - #Scroll_Width If IsGadget(Grid()\GId\HScroll) ResizeGadget(Grid()\GId\HScroll, 0, Height, Width, #Scroll_Width) EndIf If IsGadget(Grid()\GId\VScroll) ResizeGadget(Grid()\GId\VScroll, Width, 0, #Scroll_Width, Height) EndIf EndIf If IsGadget(Grid()\GId\Canvas) ResizeGadget(Grid()\GId\Canvas, 0, 0, Width, Height) EndIf Grid()\Size\Width = Width Grid()\Size\Height = Height Grid()\Size\X = X Grid()\Size\Y = Y Draw(GID) _AdjustScrolls(GID) EndIf EndProcedure Procedure ResizeHandler(GID.i) Define.i WinId, X, Y, Width, Height If IsGadget(GID) If FindMapElement(Grid(), Str(GID)) WinID = Grid()\WinID If IsWindow(WinID) X = Grid()\Size\X Y = Grid()\Size\Y Width = Grid()\Size\Width + (WindowWidth(WinID) - Grid()\Window\Width) Height = Grid()\Size\Height + (WindowHeight(WinID) - Grid()\Window\Height) If Grid()\ScrollBars ;{ Scrollbars ResizeGadget(Grid()\GId\Container, X, Y, Width + #Scroll_Width, Height + #Scroll_Width) If IsGadget(Grid()\GId\HScroll) : ResizeGadget(Grid()\GId\HScroll, 0, Height, Width, #Scroll_Width) : EndIf If IsGadget(Grid()\GId\VScroll) : ResizeGadget(Grid()\GId\VScroll, Width, 0, #Scroll_Width, Height) : EndIf ;} Else ResizeGadget(Grid()\GId\Container, X, Y, Width, Height-1) EndIf If IsGadget(Grid()\GId\Canvas) ResizeGadget(Grid()\GId\Canvas, 0, 0, Width, Height) EndIf Grid()\Size\Width = Width Grid()\Size\Height = Height Grid()\Window\X = WindowX(WinID) Grid()\Window\Y = WindowY(WinID) Grid()\Window\Width = WindowWidth(WinID) Grid()\Window\Height = WindowHeight(WinID) Draw(GID) _AdjustScrolls(GID) EndIf EndIf EndIf EndProcedure Procedure SetCellTextEvent(GID.i, Row.i, Col.i, Text$) If FindMapElement(Grid(), Str(GID)) ; used when cell content has changed via user input ... post event: #Event_Change Grid()\Cell\LastCol = Col Grid()\Cell\LastRow = Row Grid()\Cell\LastText = _GetCellText(GID, Row, Col) _SetCellText(GID, Row, Col, Text$) If IsCellFlag(GID, Row, Col, #Update) UpdateCalculations(GID) EndIf PostEvent(#Event_Change, Grid()\WinID, GID, #PB_EventType_FirstCustomValue) ; throw an event in the loop EndIf EndProcedure ; ----- ListViewGadget ---------------------------------------------------------------- Procedure CloseListView(GID.i) If FindMapElement(Grid(), Str(GID)) If Grid()\ListVisible Grid()\ListVisible = #False HideGadget(Grid()\GId\ListView, #True) EndIf EndIf EndProcedure Procedure LoadListEdit(GID.i) Define Text$, gid$ = Str(GID) Define.i Count=0, Result = #False Text$ = GetGadgetText(Grid(gid$)\GId\String) If Text$ ClearGadgetItems(Grid(gid$)\GId\ListView) ForEach Grid(gid$)\EditStrg\Words() If FindString(Grid(gid$)\EditStrg\Words(), Trim(Text$), 1, #PB_String_NoCase) AddGadgetItem(Grid(gid$)\GId\ListView, -1, Grid(gid$)\EditStrg\Words()) Count + 1 Result = #True EndIf Next If Result = #True SetGadgetState(Grid(gid$)\GId\ListView, 0) EndIf EndIf ProcedureReturn Count EndProcedure Procedure LoadListCombo(GID.i) If FindMapElement(Grid(), Str(GID)) SelectCellsElement(GID, Grid()\ListView\Row, Grid()\ListView\Col) ClearGadgetItems(Grid()\GId\ListView) ForEach Grid()\Style()\Items() AddGadgetItem(Grid()\GId\ListView, -1, Grid()\Style()\Items()) Next EndIf EndProcedure Procedure ListGadgetHandler() Define.i GID, Row, Col, X, Y, ExitList = #False Define.i EventGadget = EventGadget() Define Value$ If IsGadget(EventGadget) GID = GetGadgetData(EventGadget) If FindMapElement(Grid(), Str(GID)) Row = Grid()\ListView\Row Col = Grid()\ListView\Col If IsGadget(Grid()\GId\ListView) Value$ = GetGadgetText(Grid()\GId\ListView) If IsCellFlag(GID, Row, Col, #Combo) SetCellTextEvent(GID, Row, Col, Value$) ElseIf IsCellFlag(GID, Row, Col, #AutoComplete) If IsGadget(Grid()\GId\String) : SetGadgetText(Grid()\GId\String, Value$) : EndIf EndIf If StartDrawing(CanvasOutput(GID)) DrawCell(GID, Row, Col) DrawFocus(GID) StopDrawing() EndIf If EventType()= #PB_EventType_LeftDoubleClick CloseListView(GID) EndIf EndIf EndIf EndIf ProcedureReturn #False EndProcedure ; ----- StringGadget ------------------------------------------------------------------ Procedure CloseEdit(GID.i, Flag.i=#Modify) Define Value$, CellFlags.i, FontID.i If FindMapElement(Grid(), Str(GID)) If Grid()\EditVisible Value$ = GetGadgetText(Grid()\GId\String) If Flag <> #Cancel CellFlags = GetCellFlags(GID, Grid()\EditStrg\Row, Grid()\EditStrg\Col) If Flag = #Validate And CellFlags & #Valid If IsContentValid(GID, Value$, CellFlags, Grid()\EditStrg\Lng) SetCellTextEvent(GID, Grid()\EditStrg\Row, Grid()\EditStrg\Col, Value$) Else FontID = Grid()\Font(Grid()\Format\FontBold) SetGadgetFont(Grid()\GId\String, FontID(FontID)) SetGadgetColor(Grid()\GId\String, #PB_Gadget_FrontColor, #Red) SetGadgetColor(Grid()\GId\String, #PB_Gadget_BackColor, _BlendColor(Grid()\Color\FocusBack, #Red, 95)) Grid()\EditStrg\Wrong = #True ProcedureReturn #False EndIf ElseIf CellFlags & #Valid = #False SetCellTextEvent(GID, Grid()\EditStrg\Row, Grid()\EditStrg\Col, Value$) EndIf EndIf If StartDrawing(CanvasOutput(GID)) DrawCell(GID, Grid()\EditStrg\Row, Grid()\EditStrg\Col) DrawFocus(GID) StopDrawing() EndIf SetGadgetText(Grid()\GId\String, "") FontID = Grid()\Font(Grid()\Format\Font) SetGadgetFont(Grid()\GId\String, FontID(FontID)) SetGadgetColor(Grid()\GId\String, #PB_Gadget_FrontColor, Grid()\Color\GridFront) SetGadgetColor(Grid()\GId\String, #PB_Gadget_BackColor, Grid()\Color\FocusBack) HideGadget(Grid()\GId\String, #True) BindShortcuts(GID, #False) Grid()\EditStrg\Wrong = #False Grid()\EditVisible = #False If Grid()\ListVisible : CloseListView(GID) : EndIf ProcedureReturn #True EndIf EndIf EndProcedure Procedure Key_Up_Handler() Define.i GID, StrgGID = GetActiveGadget() If IsGadget(StrgGID) GID = GetGadgetData(StrgGID) If Grid(Str(GID))\EditStrg\Mode = #Over If CloseEdit(GID, #Validate) : MoveUp(GID, 1, #Move_Focus) : EndIf EndIf EndIf EndProcedure Procedure Key_Left_Handler() Define.i GID, StrgGID = GetActiveGadget() If IsGadget(StrgGID) GID = GetGadgetData(StrgGID) If Grid(Str(GID))\EditStrg\Mode = #Over If CloseEdit(GID, #Validate) : MoveLeft(GID, 1, #Move_Focus) : EndIf EndIf EndIf EndProcedure Procedure Key_Right_Handler() Define.i GID, StrgGID = GetActiveGadget() If IsGadget(StrgGID) GID = GetGadgetData(StrgGID) If Grid(Str(GID))\EditStrg\Mode = #Over If CloseEdit(GID, #Validate) : MoveRight(GID, 1, #Move_Focus) : EndIf EndIf EndIf EndProcedure Procedure Key_Down_Handler() Define.i GID, StrgGID = GetActiveGadget() If IsGadget(StrgGID) GID = GetGadgetData(StrgGID) If Grid(Str(GID))\EditStrg\Mode = #Over If CloseEdit(GID, #Validate) : MoveDown(GID, 1, #Move_Focus) : EndIf EndIf EndIf EndProcedure Procedure Key_Return_Handler() Define.i GID, StrgGID = GetActiveGadget() If IsGadget(StrgGID) GID = GetGadgetData(StrgGID) CloseEdit(GID, #Validate) EndIf EndProcedure Procedure Key_Escape_Handler() Define.i GID, StrgGID = GetActiveGadget() If IsGadget(StrgGID) GID = GetGadgetData(StrgGID) CloseEdit(GID, #Cancel) EndIf EndProcedure Procedure BindShortcuts(GID.i, State.i=#True) If State = #True AddKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Up, #Key_Up) AddKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Left, #Key_Left) AddKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Right, #Key_Right) AddKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Down, #Key_Down) AddKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Return, #Key_Return) AddKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Escape, #Key_Escape) BindMenuEvent(#Menu, #Key_Up, @Key_Up_Handler()) BindMenuEvent(#Menu, #Key_Left, @Key_Left_Handler()) BindMenuEvent(#Menu, #Key_Right, @Key_Right_Handler()) BindMenuEvent(#Menu, #Key_Down, @Key_Down_Handler()) BindMenuEvent(#Menu, #Key_Return, @Key_Return_Handler()) BindMenuEvent(#Menu, #Key_Escape, @Key_Escape_Handler()) Else RemoveKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Up) RemoveKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Left) RemoveKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Right) RemoveKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Down) RemoveKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Return) RemoveKeyboardShortcut(Grid()\WinID, #PB_Shortcut_Escape) UnbindMenuEvent(#Menu, #Key_Up, @Key_Up_Handler()) UnbindMenuEvent(#Menu, #Key_Left, @Key_Left_Handler()) UnbindMenuEvent(#Menu, #Key_Right, @Key_Right_Handler()) UnbindMenuEvent(#Menu, #Key_Down, @Key_Down_Handler()) UnbindMenuEvent(#Menu, #Key_Return, @Key_Return_Handler()) UnbindMenuEvent(#Menu, #Key_Escape, @Key_Escape_Handler()) EndIf EndProcedure Procedure StringGadgetHandler() Define StringGID.i = EventGadget() Define.i GID, Height, ListRows, Row, Col, Key, FontID GID = GetGadgetData(StringGID) If FindMapElement(Grid(), Str(GID)) Row = Grid()\EditStrg\Row Col = Grid()\EditStrg\Col If Grid()\EditStrg\Wrong FontID = Grid()\Font(Grid()\Format\Font) SetGadgetFont(Grid()\GId\String, FontID(FontID)) SetGadgetColor(Grid()\GId\String, #PB_Gadget_FrontColor, Grid()\Color\GridFront) SetGadgetColor(Grid()\GId\String, #PB_Gadget_BackColor, Grid()\Color\FocusBack) Grid()\EditStrg\Wrong = #False EndIf If IsCellFlag(GID, Row, Col, #AutoComplete) ListRows = LoadListEdit(GID) If ListRows Height = Grid()\EditStrg\Height ResizeGadget(Grid()\GId\ListView, Grid()\ListView\X, Grid()\ListView\Y, Grid()\ListView\Width, (Height*ListRows)+5) HideGadget(Grid()\GId\ListView, #False) Grid()\EditStrg\WordList =#True Else HideGadget(Grid()\GId\ListView, #True) EndIf EndIf EndIf EndProcedure ; ----- CellType (#Cell/#Combo/#Button/#Checkbox) ---------------------------- Procedure.i ManageCellTypes(GID.i, Key.s, Flag.i=#False) ; #Enter/#Click ; takes care of opening the editor/combo ... Define.s Cell, oldTxt, newTxT Define.i areaRow, areaCol, multiCell, CellFlags, RowArea, ColArea Define.i X, Y, Width, Height, Row, Col Define Style.Grid_Style_Structure Define Block.Rectangle_Structure If FindMapElement(Grid(), Str(GID)) CloseEdit(GID, #Cancel) CloseListView(GID) X = GetGadgetAttribute(GID, #PB_Canvas_MouseX) Y = GetGadgetAttribute(GID, #PB_Canvas_MouseY) AreaCol = _AreaCol_Of_X(GID, X) AreaRow = _AreaRow_Of_Y(GID, Y) If AreaRow < 0 Or AreaCol < 0 : ProcedureReturn #False : EndIf Row = Grid()\Row\AreaList()\AreaRow Col = Grid()\Col\AreaList()\AreaCol multiCell = _MultiOfCell(GID, Row, Col) If multiCell >= 0 SelectElement(Grid()\MultiCellList(), multiCell) Row = Grid()\MultiCellList()\Row1 Col = Grid()\MultiCellList()\Col1 EndIf CellFlags = GetCellFlags(GID, Row, Col) If multiCell >= 0 ;{ Merged cells SelectElement(Grid()\MultiCellList(), multiCell) If _RectCoord(GID, Grid()\MultiCellList()\Row1, Grid()\MultiCellList()\Col1, Grid()\MultiCellList()\Row2, Grid()\MultiCellList()\Col2, @Block) X = Block\X Y = Block\Y Width = Block\Width Height = Block\Height EndIf ;} Else ;{ Single cell X = Grid()\Col\AreaList()\X Y = Grid()\Row\AreaList()\Y Width = Grid()\Col\AreaList()\Width Height = Grid()\Row\AreaList()\Height ;} EndIf oldTxt = _GetCellText(GID, Row, Col) ; original cell text newTxT = oldTxt GetCellStyle(GID, Row, Col, @Style) If CellFlags & #Checkbox ;{ CheckBox ; an Enter or Space in a Checkbox are equivalent to Button-Click (check/uncheck) If Key = " " Or Flag & #Enter Or Flag & #Click If Val(oldTxt) = 0 SetCellTextEvent(GID, Row, Col, "1") Else SetCellTextEvent(GID, Row, Col, "0") EndIf DrawCurrentCell(GID) EndIf ProcedureReturn #False ;} ElseIf CellFlags & #Button ;{ Button If Key = " " Or Flag & #Enter Or Flag & #Click Grid()\Cell\ClickedRow = Row Grid()\Cell\ClickedCol = Col PostEvent(#Event_Click, Grid()\WinID, Grid()\GId\Container, #PB_EventType_FirstCustomValue) EndIf ProcedureReturn #False ;} ElseIf CellFlags & #Combo ;{ ComboBox If Flag & #Enter Or Flag & #Click Cell = oldTxt Else Cell = Key EndIf If Flag & #Enter And CellFlags & #Edit Grid()\EditVisible = #True Grid()\EditStrg\Row = Row Grid()\EditStrg\Col = Col Grid()\EditStrg\X = X Grid()\EditStrg\Y = Y Grid()\EditStrg\Width = Width Grid()\EditStrg\Height = Height Grid()\EditStrg\Flag = #Enter Grid()\EditStrg\Mode = Style\Value("EditMode") Grid()\EditStrg\Lng = Style\Language SetGadgetColor(Grid()\GId\String, #PB_Gadget_BackColor, Grid()\Color\FocusBack) SetGadgetColor(Grid()\GId\String, #PB_Gadget_FrontColor, Grid()\Color\GridFront) ResizeGadget(Grid()\GId\String, X + 2, Y + 2, Width - 19, Height - 4) BindShortcuts(GID) HideGadget(Grid()\GId\String, #False) SetActiveGadget(Grid()\GId\String) EndIf If Flag & #Click Grid()\ListVisible = #True Grid()\ListView\Row = Row Grid()\ListView\Col = Col Grid()\ListView\X = X Grid()\ListView\Y = Y + Height Grid()\ListView\Width = Width Grid()\ListView\Height = #Combo_Height LoadListCombo(GID) ResizeGadget(Grid()\GId\ListView, X, Y + Height, Width, #Combo_Height) HideGadget(Grid()\GId\ListView, #False) SetGadgetColor(Grid()\GId\ListView, #PB_Gadget_BackColor, Grid()\Color\FocusBack) SetGadgetColor(Grid()\GId\ListView, #PB_Gadget_FrontColor, Grid()\Color\GridFront) SetActiveGadget(Grid()\GId\ListView) EndIf If Cell <> "" : SetGadgetText(Grid()\GId\ListView, Cell) : EndIf ProcedureReturn #False ;} ElseIf CellFlags & #Cell ;{ Cell If Flag & #Click : ProcedureReturn #False : EndIf ; getting focus is not entring edit mode! Select Style\Value("EditMode") Case #Over Cell = Key Case #Append Cell = oldTxt + Key EndSelect If Flag & #Enter : Cell = oldTxt : EndIf If CellFlags & #AutoComplete Grid()\ListVisible = #True Grid()\ListView\Row = Row Grid()\ListView\Col = Col Grid()\ListView\X = X Grid()\ListView\Y = Y + Height Grid()\ListView\Width = Width Grid()\ListView\Height = #Combo_Height SetGadgetColor(Grid()\GId\ListView, #PB_Gadget_BackColor, Grid()\Color\FocusBack) SetGadgetColor(Grid()\GId\ListView, #PB_Gadget_FrontColor, Grid()\Color\GridFront) EndIf Grid()\EditVisible = #True Grid()\EditStrg\Row = Row Grid()\EditStrg\Col = Col Grid()\EditStrg\X = X Grid()\EditStrg\Y = Y Grid()\EditStrg\Width = Width Grid()\EditStrg\Height = Height Grid()\EditStrg\Flag = #Enter Grid()\EditStrg\Mode = Style\Value("EditMode") Grid()\EditStrg\Lng = Style\Language SetGadgetColor(Grid()\GId\String, #PB_Gadget_BackColor, Grid()\Color\FocusBack) SetGadgetColor(Grid()\GId\String, #PB_Gadget_FrontColor, Grid()\Color\GridFront) ResizeGadget(Grid()\GId\String, X + 2, Y + 2, Width - 4, Height - 4) If Cell <> "" : SetGadgetText(Grid()\GId\String, Cell) : EndIf BindShortcuts(GID) HideGadget(Grid()\GId\String, #False) SetActiveGadget(Grid()\GId\String) CompilerSelect #PB_Compiler_OS ; pushing carat to the end CompilerCase #PB_OS_Windows If IsGadget(Grid()\GId\String) SendMessage_(GadgetID(Grid()\GId\String), #EM_SETSEL, $fffffff, $fffffff) EndIf CompilerCase #PB_OS_Linux CompilerCase #PB_OS_MacOS CompilerEndSelect ProcedureReturn #False ;} Else ProcedureReturn #False EndIf EndIf EndProcedure ; ----- Grid Events ---------------------------------------------------------------------- Procedure ChangeMouse(GID.i, X.i, Y.i) Define.i Row, Col, CellFlags Row = _Row_Of_Y(GID, Y) Col = _Col_Of_X(GID, X) If _OverResizeCol(GID, X, Y) If _ResizeAllowed(GID, #False, Col) SetGadgetAttribute(GID, #PB_Canvas_Cursor, #PB_Cursor_LeftRight) ProcedureReturn #False EndIf EndIf If _OverResizeRow(GID, X, Y) If _ResizeAllowed(GID, Row, #False) SetGadgetAttribute(GID, #PB_Canvas_Cursor, #PB_Cursor_UpDown) ProcedureReturn #False EndIf EndIf If _OverDataArea(GID, X, Y) CellFlags = GetCellFlags(GID, Row, Col) If CellFlags & #Combo Or CellFlags & #Checkbox Or CellFlags & #Button SetGadgetAttribute(GID, #PB_Canvas_Cursor, #PB_Cursor_Default) ElseIf CellFlags & #Edit SetGadgetAttribute(GID, #PB_Canvas_Cursor, #PB_Cursor_Default) Else SetGadgetAttribute(GID, #PB_Canvas_Cursor, #PB_Cursor_Cross) EndIf ProcedureReturn #False EndIf SetGadgetAttribute(GID, #PB_Canvas_Cursor, #PB_Cursor_Default) EndProcedure Procedure _RightClickHandler() ; launches the attachd popup menu - that's all! selected menu-items will need be handled by caller (via EvenMenu())! Define.i GID = EventGadget() Define.i X, Y If FindMapElement(Grid(), Str(GID)) If IsMenu(Grid()\GId\PopupMenu) X = GetGadgetAttribute(GID, #PB_Canvas_MouseX) Y = GetGadgetAttribute(GID, #PB_Canvas_MouseY) If _OverDataArea(GID, X, Y) If _OverBlock(GID, X, Y) = #False : ResetBlock(GID) : EndIf DisplayPopupMenu(Grid()\GId\PopupMenu, WindowID(Grid()\WinID)) EndIf EndIf EndIf EndProcedure Procedure _LeftDoubleClickHandler() ; text input takes place in current cell regardless of mouse position Define.i GID = EventGadget() Define.i X, Y, AreaRow, AreaCol, Cursor.i If FindMapElement(Grid(), Str(GID)) X = GetGadgetAttribute(GID, #PB_Canvas_MouseX) Y = GetGadgetAttribute(GID, #PB_Canvas_MouseY) AreaCol = _AreaCol_Of_X(GID, X) AreaRow = _AreaRow_Of_Y(GID, Y) If _IsHeaderCol(GID, AreaCol) Or _IsHeaderRow(GID, AreaRow) Cursor = GetGadgetAttribute(Grid()\GId\Canvas, #PB_Canvas_Cursor) AreaCol = _AreaResizeCol(GID, X, Y) If AreaCol >= 0 And Cursor = #PB_Cursor_LeftRight If SelectElement(Grid()\Col\AreaList(), AreaCol) AutoColumnWidth(GID, Grid()\Col\AreaList()\AreaCol) EndIf Else AreaRow = _AreaResizeRow(GID, X, Y) If AreaRow >= 0 And Cursor = #PB_Cursor_UpDown If SelectElement(Grid()\Row\AreaList(), AreaRow) AutoRowHeight(GID, Grid()\Row\AreaList()\AreaRow) EndIf EndIf EndIf Else If IsCellFlag(GID, Grid()\Row\Current, Grid()\Col\Current, #Edit) ResetBlock(GID) If ShowCell(GID, Grid()\Row\Current, Grid()\Col\Current) If ManageCellTypes(GID , "", #Enter) : Draw(GID) : EndIf EndIf EndIf EndIf EndIf EndProcedure Procedure _LeftButtonDownHandler() Define.i GID = EventGadget() Define.i X, Y, Row, Col, AreaRow, AreaCol If FindMapElement(Grid(), Str(GID)) X = GetGadgetAttribute(GID, #PB_Canvas_MouseX) Y = GetGadgetAttribute(GID, #PB_Canvas_MouseY) AreaCol = _AreaCol_Of_X(GID, X) AreaRow = _AreaRow_Of_Y(GID, Y) If Grid()\EditVisible And Not _OverEditor(GID, X, Y) If CloseEdit(GID, #Validate) = #False ProcedureReturn #False EndIf EndIf Grid()\Mouse\DownX = X Grid()\Mouse\DownY = Y Grid()\Mouse\DownAreaRow = AreaRow Grid()\Mouse\DownAreaCol = AreaCol If AreaRow >= 0 And AreaCol >= 0 Row = Grid()\Row\AreaList()\AreaRow Col = Grid()\Col\AreaList()\AreaCol If _IsHeaderRow(GID, Row) = #False And _IsHeaderCol(GID, Col) = #False ResetBlock(GID) FocusCell(GID, Row, Col) EndIf EndIf EndIf EndProcedure Procedure _LeftButtonUpHandler() Define.i GID = EventGadget() Define.i X, Y, r, Row, Col, multiRow, multiCol, AreaRow, AreaCol Define.i ArrowX, CellFlags, Modifier, FirstSelected, Multi Define Cell$ If FindMapElement(Grid(), Str(GID)) X = GetGadgetAttribute(GID, #PB_Canvas_MouseX) Y = GetGadgetAttribute(GID, #PB_Canvas_MouseY) Select Grid()\Mouse\MoveStatus Case #MouseMove_Nothing ;{ AreaCol = _AreaCol_Of_X(GID, X) AreaRow = _AreaRow_Of_Y(GID, Y) If AreaRow >= 0 And AreaCol >= 0 Row = Grid()\Row\AreaList()\AreaRow Col = Grid()\Col\AreaList()\AreaCol Multi = _MultiOfCell(GID, Row, Col) If Multi >= 0 SelectElement(Grid()\MultiCellList(), Multi) multiRow = Grid()\MultiCellList()\Row1 multiCol = Grid()\MultiCellList()\Col1 CellFlags = GetCellFlags(GID, multiRow, multiCol) Else CellFlags = GetCellFlags(GID, Row, Col) EndIf If _IsHeaderRow(GID, Row) ;{ ColumnHeader Click If GetGadgetAttribute(Grid()\GId\Canvas, #PB_Canvas_Cursor) = #PB_Cursor_Default If Col = #Label SelectAll(GID) Else Grid()\Sort\Column = Col If Grid()\Cols(Col)\SortFlags & #PB_Sort_Descending ;{ Sort up/down arrow Grid()\Sort\Direction = #PB_Sort_Descending Else Grid()\Sort\Direction = #PB_Sort_Ascending EndIf ;} SortGridRows(GID, Col, GetColumnFlags(GID, Col)) : Draw(GID) If Grid()\Cols(Col)\SortFlags & #PB_Sort_Descending ; Change sort order Grid()\Cols(Col)\SortFlags & ~#PB_Sort_Descending Else If Col > 0 Grid()\Cols(Col)\SortFlags | #PB_Sort_Descending EndIf EndIf EndIf ProcedureReturn #False EndIf ;} ElseIf _IsHeaderCol(GID, Col) If Row > #Label ;{ --- Control & Shift - MouseClick Modifier = GetGadgetAttribute(GID, #PB_Canvas_Modifiers) If Modifier & #PB_Canvas_Control And Row > #Header If Grid()\Row\Selected(Str(Row)) = #False If Grid()\Row\FirstSelected = 0 : Grid()\Row\FirstSelected = Row : EndIf Grid()\Row\Selected(Str(Row)) = #True If Row < Grid()\Row\FirstSelected : Grid()\Row\FirstSelected = Row : EndIf Else DeleteMapElement(Grid()\Row\Selected(), Str(Row)) EndIf Draw(GID) ProcedureReturn #False ElseIf Modifier & #PB_Canvas_Shift And Row > #Header If Grid()\Row\Selected(Str(Row)) = #False If Grid()\Row\FirstSelected = 0 : Grid()\Row\FirstSelected = Row : EndIf If Row > Grid()\Row\FirstSelected For r = Grid()\Row\FirstSelected To Row Grid()\Row\Selected(Str(r)) = #True Next Else For r = Row To Grid()\Row\FirstSelected Grid()\Row\Selected(Str(r)) = #True Next EndIf If Row < Grid()\Row\FirstSelected : Grid()\Row\FirstSelected = Row : EndIf Else If MapSize(Grid()\Row\Selected()) > 1 ClearMap(Grid()\Row\Selected()) Grid()\Row\FirstSelected = Row Grid()\Row\Selected(Str(Row)) = #True Else DeleteMapElement(Grid()\Row\Selected(), Str(Row)) Grid()\Row\FirstSelected = #False EndIf EndIf Draw(GID) ProcedureReturn #False Else If MapSize(Grid()\Row\Selected()) > 0 ClearMap(Grid()\Row\Selected()) Grid()\Row\FirstSelected = #False Draw(GID) EndIf EndIf ;} EndIf Else ;{ Cell Area If Row = Grid()\Row\Current And Col = Grid()\Col\Current If Multi >= 0 Row = multiRow Col = multiCol EndIf Modifier = GetGadgetAttribute(GID, #PB_Canvas_Modifiers) If Modifier & #PB_Canvas_Control And Row > #Header Cell$ = Str(Row)+"|"+Str(Col) If Grid()\Cell\Selected(Cell$) = #False Grid()\Cell\Selected(Cell$) = #True Else DeleteMapElement(Grid()\Cell\Selected(), Cell$) EndIf DrawCurrentCell(GID) Else ClearMap(Grid()\Cell\Selected()) Draw(GID) EndIf If MapSize(Grid()\Row\Selected()) > 0 ClearMap(Grid()\Row\Selected()) Grid()\Row\FirstSelected = #False Draw(GID) EndIf If CellFlags & #Cell And CellFlags & #Edit ;{ editable Cell If Not _OverEditor(GID, X, Y) If ManageCellTypes(GID, "", #Click) : Draw(GID) : EndIf EndIf ;} ElseIf CellFlags & #Combo And CellFlags & #Edit ;{ editable ComboBox ArrowX = Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width - #ArrowWidth If X >= ArrowX ; ComboBox Arrow If Grid()\ListVisible CloseListView(GID) ProcedureReturn #False Else If Grid()\EditVisible : CloseEdit(GID, #Cancel) : EndIf If ManageCellTypes(GID, "", #Click) : Draw(GID) : EndIf EndIf Else ; Edit ComboBox ;If Not _OverEditor(GID, X, Y) If Grid()\ListVisible : CloseListView(GID) : EndIf If ManageCellTypes(GID, "", #Enter) : Draw(GID) : EndIf EndIf ;} ElseIf CellFlags & #Combo ;{ non editable ComboBox ArrowX = Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width - #ArrowWidth If X >= ArrowX ; Click ComboBox Arrow If Grid()\ListVisible CloseListView(GID) ProcedureReturn #False Else If ManageCellTypes(GID, "", #Click) : Draw(GID) : EndIf EndIf EndIf ;} Else If ManageCellTypes(GID, "", #Click) : Draw(GID) : EndIf EndIf EndIf ;} EndIf EndIf ;} Case #MouseMove_Resize ;{ _MouseResize(GID, X, Y) Draw(GID) Grid()\Mouse\MoveStatus = #MouseMove_Nothing ;} Case #MouseMove_Select If MapSize(Grid()\Row\Selected()) > 0 ClearMap(Grid()\Row\Selected()) Grid()\Row\FirstSelected = #False Draw(GID) EndIf EndSelect _ResetDownClick(GID) EndIf EndProcedure Procedure _MouseWheelHandler() Define.i GID = EventGadget() Define.i Delta Delta = GetGadgetAttribute(GID, #PB_Canvas_WheelDelta) If Delta < 0 MoveDown(GID, -Delta, #Move_TopRC) ElseIf Delta > 0 MoveUp(GID, Delta, #Move_TopRC) EndIf EndProcedure Procedure _MouseMoveHandler() Define.i GID = EventGadget() Define.i X, Y, Row, Col, AreaCol, AreaRow ; 1. Change cursor to allow resizing: Col/Row ; 2. Resizing Col/Row ; 3. Scrolling Up/Down ; 4. Selecting a block of cell If FindMapElement(Grid(), Str(GID)) X = GetGadgetAttribute(GID, #PB_Canvas_MouseX) Y = GetGadgetAttribute(GID, #PB_Canvas_MouseY) If GetGadgetAttribute(GID, #PB_Canvas_Buttons) = #PB_Canvas_LeftButton ; continuing the current move-action if any ... or starting new one Select Grid()\Mouse\MoveStatus Case #MouseMove_Nothing AreaRow = _AreaRow_Of_Y(GID, Y) AreaCol = _AreaCol_Of_X(GID, X) If AreaRow >= 0 And AreaCol >= 0 Row = Grid()\Row\AreaList()\AreaRow Col = Grid()\Col\AreaList()\AreaCol If _OverDataArea(GID, X, Y) ; data area If Grid()\Mouse\DownAreaRow >= 0 And Grid()\Mouse\DownAreaCol >= 0 And (Grid()\Mouse\DownAreaRow <> AreaRow Or Grid()\Mouse\DownAreaCol <> AreaCol) Grid()\Mouse\MoveStatus = #MouseMove_Select _StartBlock(GID) EndIf ElseIf _IsHeaderRow(GID, row) And _IsHeaderCol(GID, col) If Abs(Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width - x) <= #ColSep_Margin Or Abs(Grid()\Col\AreaList()\X - x) <= #ColSep_Margin Or Abs(Grid()\Row\AreaList()\Y + Grid()\Row\AreaList()\Height - y) <= #RowSep_Margin Or Abs(Grid()\Row\AreaList()\Y - y) <= #RowSep_Margin Grid()\Mouse\MoveStatus = #MouseMove_Resize Else Grid()\Mouse\MoveStatus = #MouseMove_Select _StartBlock(GID, Grid()\Row\FirstVisible, Grid()\Col\FirstVisible, Grid()\Row\LastVisible, Grid()\Col\LastVisible) Draw(GID) ; <<<< return true EndIf ElseIf _IsHeaderRow(GID, row) If Abs(Grid()\Col\AreaList()\X + Grid()\Col\AreaList()\Width - x) <= #ColSep_Margin Or Abs(Grid()\Col\AreaList()\X - x) <= #ColSep_Margin Grid()\Mouse\MoveStatus = #MouseMove_Resize Else Grid()\Mouse\MoveStatus = #MouseMove_Select _StartBlock(GID, Grid()\Row\FirstVisible, Col, Grid()\Row\LastVisible, Col) Draw(GID) ; <<<< return true EndIf ElseIf _IsHeaderCol(GID, col) If Abs(Grid()\Row\AreaList()\Y + Grid()\Row\AreaList()\Height - y) <= #RowSep_Margin Or Abs(Grid()\Row\AreaList()\Y - y) <= #RowSep_Margin Grid()\Mouse\MoveStatus = #MouseMove_Resize Else Grid()\Mouse\MoveStatus = #MouseMove_Select _StartBlock(GID, Row, Grid()\Col\FirstVisible, Row, Grid()\Col\LastVisible) Draw(GID) ; <<<< return true EndIf EndIf EndIf Case #MouseMove_Select If _ExtendBlock_XY(GID, x, y) : Draw(GID) : EndIf If Grid()\ListView : CloseListView(GID) : EndIf If Grid()\EditVisible : CloseEdit(GID) : EndIf Case #MouseMove_Resize If Grid()\ListView : CloseListView(GID) : EndIf If Grid()\EditVisible : CloseEdit(GID) : EndIf EndSelect Else Grid()\Mouse\MoveStatus = #MouseMove_Nothing ; no move-action ChangeMouse(GID, X, Y) EndIf EndIf EndProcedure Procedure _InputHandler() Define.i GID = EventGadget() Define.i Key If FindMapElement(Grid(), Str(GID)) ResetBlock(GID) If ShowCell(GID, Grid()\Row\Current, Grid()\Col\Current) Key = GetGadgetAttribute(GID, #PB_Canvas_Input) If ManageCellTypes(GID, Chr(Key)) Draw(GID) EndIf EndIf EndIf EndProcedure Procedure _KeyDownHandler() ; navigation key + shift => start a new block And/Or extend current block Define.i GID = EventGadget() Define.i Key, Modifier If FindMapElement(Grid(), Str(GID)) Key = GetGadgetAttribute(GID, #PB_Canvas_Key) Modifier = GetGadgetAttribute(GID, #PB_Canvas_Modifiers) Select Key Case #PB_Shortcut_Left ;{ Left Cursor Key If Modifier & #PB_Canvas_Shift And Modifier & #PB_Canvas_Control MoveLeft(GID, Grid()\Col\Number, #Move_Block) ElseIf Modifier & #PB_Canvas_Shift MoveLeft(GID, 1, #Move_Block) ElseIf Modifier & #PB_Canvas_Control FocusCell(GID, Grid()\Row\Current, Grid()\Col\FirstTop) Else MoveLeft(GID, 1, #Move_Focus) EndIf ;} Case #PB_Shortcut_Right ;{ Right Cursor Key If Modifier & #PB_Canvas_Shift And Modifier & #PB_Canvas_Control MoveRight(GID, Grid()\Col\Number, #Move_Block) ElseIf Modifier & #PB_Canvas_Shift MoveRight(GID, 1, #Move_Block) ElseIf Modifier & #PB_Canvas_Control FocusCell(GID, Grid()\Row\Current, Grid()\Col\LastVisible) Else MoveRight(GID, 1, #Move_Focus) EndIf ;} Case #PB_Shortcut_Up ;{ Up Cursor Key If Modifier & #PB_Canvas_Shift And Modifier & #PB_Canvas_Control MoveUp(GID, Grid()\Row\Number, #Move_Block) ElseIf Modifier & #PB_Canvas_Shift MoveUp(GID, 1, #Move_Block) ElseIf Modifier & #PB_Canvas_Control FocusCell(GID, Grid()\Row\FirstTop, Grid()\Col\Current) Else MoveUp(GID, 1, #Move_Focus) EndIf ;} Case #PB_Shortcut_Down ;{ Down Cursor Key If Modifier & #PB_Canvas_Shift And Modifier & #PB_Canvas_Control MoveDown(GID, Grid()\Row\Number, #Move_Block) ElseIf Modifier & #PB_Canvas_Shift MoveDown(GID, 1, #Move_Block) ElseIf Modifier & #PB_Canvas_Control FocusCell(GID, Grid()\Row\LastVisible, Grid()\Col\Current) Else MoveDown(GID, 1, #Move_Focus) EndIf ;} Case #PB_Shortcut_PageUp ;{ PageUp Key If Modifier & #PB_Canvas_Shift MoveUp(GID, #Scroll_PageSize, #Move_Block) Else MoveUp(GID, #Scroll_PageSize, #Move_Focus) EndIf ;} Case #PB_Shortcut_PageDown ;{ PageDown Key If Modifier & #PB_Canvas_Shift MoveDown(GID, #Scroll_PageSize, #Move_Block) Else MoveDown(GID, #Scroll_PageSize, #Move_Focus) EndIf ;} Case #PB_Shortcut_Home ;{ Home Key If Modifier & #PB_Canvas_Shift And Modifier & #PB_Canvas_Control MoveUp(GID, Grid()\Row\Number, #Move_Block) MoveLeft(GID, Grid()\Col\Number, #Move_Block) ElseIf Modifier & #PB_Canvas_Control FocusCell(GID, Grid()\Row\FirstTop, Grid()\Col\FirstTop) Else FocusCell(GID, Grid()\Row\Current, 1) EndIf ;} Case #PB_Shortcut_End ;{ End Key If Modifier & #PB_Canvas_Shift And Modifier & #PB_Canvas_Control MoveDown(GID, Grid()\Row\Number, #Move_Block) MoveRight(GID, Grid()\Col\Number, #Move_Block) ElseIf Modifier & #PB_Canvas_Control FocusCell(GID, Grid()\Row\LastVisible, Grid()\Col\LastVisible) Else FocusCell(GID, Grid()\Row\Current, Grid()\Col\Number) EndIf ;} Case #PB_Shortcut_C ;{ Copy & Paste Keys If Modifier & #PB_Canvas_Control ;SetClipboardText(GetBlockText(GID)) CopyToClipboard(GID) EndIf Case #PB_Shortcut_V If Modifier & #PB_Canvas_Control ;SetBlockText(GID, GetClipboardText()) PasteFromClipboard(GID) EndIf Case #PB_Shortcut_X If Modifier & #PB_Canvas_Control ;ClearBlockContent(GID) ClearSelectedCells(GID) EndIf ;} Case #PB_Shortcut_Tab ;{ Tab Key If Grid()\EditVisible And Grid()\EditStrg\Mode = #Over If CloseEdit(GID, #Validate) = #False ProcedureReturn #False EndIf EndIf MoveRight(GID, 1, #Move_Focus) ;} Case #PB_Shortcut_Delete, #PB_Shortcut_Back ;{ If IsCellFlag(GID, Grid()\Row\Current, Grid()\Col\Current, #Edit) SetCellTextEvent(GID, Grid()\Row\Current, Grid()\Col\Current, "") DrawCurrentCell(GID) EndIf ;} Case #PB_Shortcut_Return ;{ text input takes place in current cell regardless of mouse position If IsCellFlag(GID, Grid()\Row\Current, Grid()\Col\Current, #Edit) If ShowCell(GID, Grid()\Row\Current, Grid()\Col\Current) If ManageCellTypes(GID , "", #Enter) : Draw(GID) : EndIf EndIf EndIf ;} EndSelect If Modifier & #PB_Canvas_Shift = #False And Modifier & #PB_Canvas_Control = #False ; >>>>> no shift key and no control --> block de-selection ResetBlock(GID) EndIf EndIf EndProcedure ;----------------------------------------------------------------------------- ;--- Gadget ;----------------------------------------------------------------------------- Procedure SetGridData(GID.i, Value.i) Grid(Str(GID))\GridData = Value EndProcedure Procedure.i GetGridData(GID.i) ProcedureReturn Grid(Str(GID))\GridData EndProcedure Procedure DisableRedraw(GID.i, State=#True) ; 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 Grid(Str(GID))\NoRedraw = State EndProcedure Procedure Refresh(GID.i) Grid(Str(GID))\NoRedraw = #False Draw(GID) EndProcedure Procedure.i Gadget(WinID.i, GadgetID.i, X.i, Y.i, Width.i, Height.i, Rows.i=#PB_Ignore, Cols.i=#PB_Ignore, Flags.i=#DrawGrid|#Border_Single|#ScrollBars) Define.i ContainerID, Result, i, j, ttlW, ttlH, xx, yy, LastGIDList, Border If Not IsWindow(WinID) : ProcedureReturn #False : EndIf ;{ Flags - Border If Flags & #BorderLess Border = #PB_Container_BorderLess ElseIf Flags & #Border_Flat Border = #PB_Container_Flat ElseIf Flags & #Border_Raised Border = #PB_Container_Raised ElseIf Flags & #Border_Double Border = #PB_Container_Double Else Border = #PB_Container_Single EndIf ;} AddMapElement(Grid(), Str(GadgetID)) Grid()\WinID = WinID If IsWindow(WinID) ;{ Window size for resizing Grid()\Window\X = WindowX(WinID) Grid()\Window\Y = WindowY(WinID) Grid()\Window\Width = WindowWidth(WinID) Grid()\Window\Height = WindowHeight(WinID) CreateMenu(#Menu, WindowID(WinID)) EndIf ;} ContainerID = ContainerGadget(#PB_Any, X, Y, Width, Height-2, Border) If ContainerID Grid()\GId\Container = ContainerID If Flags & #ScrollBars ;{ Scrollbar Gadgets Width - #Scroll_Width Height - #Scroll_Width ; ScrollBar - Horizontal Grid()\GId\HScroll = ScrollBarGadget(#PB_Any, 0, Height, Width, #Scroll_Width, 0, 0, 0) BindGadgetEvent(Grid()\GId\HScroll, @_SynchronizeGridCols(), #PB_All) ; ScrollBar -Vertikal Grid()\GId\VScroll = ScrollBarGadget(#PB_Any, Width, 0, #Scroll_Width, Height, 0, 0, 0, #PB_ScrollBar_Vertical) BindGadgetEvent(Grid()\GId\VScroll, @_SynchronizeGridRows(), #PB_All) Grid()\ScrollBars = #True Else Grid()\GId\HScroll = -1 Grid()\GId\VScroll = -1 Grid()\ScrollBars = #False EndIf ;} Result = CanvasGadget(GadgetID, 0, 0, Width, Height, #PB_Canvas_Keyboard|#PB_Canvas_Container) If Result If GadgetID = #PB_Any : GadgetID = Result : EndIf Grid()\GId\Canvas = GadgetID Grid()\GId\String = StringGadget(#PB_Any, 0, 0, 0, 0, "", #PB_String_BorderLess) Grid()\GId\ListView = ListViewGadget(#PB_Any, 0, 0, 0, 0) CloseGadgetList() EndIf SetGadgetColor(GadgetID, #PB_Gadget_BackColor, $FFFFFF) SetGadgetData(Grid()\GId\String, GadgetID) BindGadgetEvent(Grid()\GId\String, @StringGadgetHandler(), #PB_EventType_Change) SetGadgetData(Grid()\GId\ListView, GadgetID) BindGadgetEvent(Grid()\GId\ListView, @ListGadgetHandler(), #PB_All) SetGadgetData(Grid()\GId\Canvas, GadgetID) SetGadgetData(Grid()\GId\Container, GadgetID) If Flags & #ScrollBars SetGadgetData(Grid()\GId\HScroll, GadgetID) SetGadgetData(Grid()\GId\VScroll, GadgetID) EndIf CloseGadgetList() EndIf Grid()\Size\X = X Grid()\Size\Y = Y Grid()\Size\Width = Width Grid()\Size\Height = Height Initialize(GadgetID, Rows, Cols) If Flags & #ScrollBars : _AdjustScrolls(GadgetID) : EndIf ; no drawing - useful if we need to customize the grid first If Flags & #DoNotDraw = #False : Draw(GadgetID) : EndIf BindGadgetEvent(GadgetID, @_RightClickHandler(), #PB_EventType_RightClick) BindGadgetEvent(GadgetID, @_LeftButtonDownHandler(), #PB_EventType_LeftButtonDown) BindGadgetEvent(GadgetID, @_LeftButtonUpHandler(), #PB_EventType_LeftButtonUp) BindGadgetEvent(GadgetID, @_LeftDoubleClickHandler(), #PB_EventType_LeftDoubleClick) BindGadgetEvent(GadgetID, @_MouseMoveHandler(), #PB_EventType_MouseMove) BindGadgetEvent(GadgetID, @_InputHandler(), #PB_EventType_Input) BindGadgetEvent(GadgetID, @_KeyDownHandler(), #PB_EventType_KeyDown) BindGadgetEvent(ContainerID, @_Resize(), #PB_EventType_Resize) ProcedureReturn GadgetID EndProcedure ;---------------------------------------------------------------------------- EndModule CompilerIf #PB_Compiler_IsMainFile Enumeration ;{ Constants #Win #Grid #Import #Export #PopupMenu #MenuItem_1 #MenuItem_2 #MenuItem_3 #MenuItem_4 #MenuItem_5 #MenuItem_6 #MenuItem_7 EndEnumeration ;} Global ii, jj, rr, cc, Style, EventGadget, Event, EventType, EventMenu, wrd.s, Image.i Global Font_A16 = LoadFont(#PB_Any, "Arial", 16) GridEx::UseImageDecoder(#PB_ImagePlugin_PNG) Procedure ShowSelectedCells(GID.i) Define r.i=0, c.i=0, Row$ If GridEx::GetSelectedCells(GID, GridEx::#NoHeader) For r=0 To ArraySize(GridEx::Cells(), 1) Row$ ="" For c=0 To ArraySize(GridEx::Cells(), 2) Row$ + Chr(34) + GridEx::Cells(r, c) + Chr(34) + ";" Next Debug RTrim(Row$, ";") Next EndIf EndProcedure If OpenWindow(#Win, 0, 0, 800, 470, "GridEX - Gadget", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_SizeGadget) If CreatePopupMenu(#PopupMenu) ;{ Creation of the pop-up menu begins. MenuItem(#MenuItem_1, "Copy to Clipboard") MenuItem(#MenuItem_2, "Paste from Clipboard") MenuBar() MenuItem(#MenuItem_3, "Clear selected cells") MenuItem(#MenuItem_4, "Merge selected cells") MenuBar() MenuItem(#MenuItem_5, "Reset all cells") MenuItem(#MenuItem_6, "Clear all cells") EndIf ;} CompilerIf #Example = 1 ;{ Sort ButtonGadget(#Import, 10, 160, 70, 20, "Import") ButtonGadget(#Export, 100, 160, 70, 20, "Export") GridEx::Gadget(#Win, #Grid, 10, 10, 470, 138, 6, 7, GridEx::#NoScrollBars) GridEx::AttachPopup(#Grid, #PopupMenu) GridEx::DisableRedraw(#Grid, #True) GridEx::SetTheme(#Grid, "Blue") ;GridEx::SetFont(#Grid, "Comic Sans MS", 8) GridEx::SetColumnWidth(#Grid, 0, 30) GridEx::SetColumnWidth(#Grid, 3, 75) GridEx::SetColumnWidth(#Grid, 4, 55) GridEx::SetColumnWidth(#Grid, 5, 60) GridEx::SetColumnWidth(#Grid, 6, 70) GridEx::SetColumnWidth(#Grid, 7, 65) ;GridEx::SetDateFormat(#Grid, "%dd. %MM %yyyy") ; Format date for output ; Column 1 - Compare column 4 instead of current column GridEx::MarkCells(#Grid, GridEx::#AnyRow, 1, GridEx::#Float, "EQUAL{2.33}[C4]", $00A2FF) ; Column 2 GridEx::MarkCells(#Grid, GridEx::#AnyRow, 2, GridEx::#String, "Like{Ga*}", $BB0000) ; Column 3: Date GridEx::SetCellText(#Grid, GridEx::#Header, 3, "Date") GridEx::SetCellType(#Grid, GridEx::#AnyRow, 3, GridEx::#Date) GridEx::MarkCells(#Grid, GridEx::#AnyRow, 3, GridEx::#Date, "Compare{>|1.1.2017}", $A500A5) GridEx::SetCellFlags(#Grid, 2, 3, GridEx::#Edit|GridEx::#Update|GridEx::#Valid) ; Cell(2:3) Edit & Validate ;GridEx::SetCellColor(#Grid, 2, 3, GridEx::#BackColor, $FBF7EC) GridEx::SetCellFrame(#Grid, 2, 3, $ED9564) ; Column 4: Float GridEx::SetCellText(#Grid, GridEx::#Header, 4, "Float") GridEx::SetCellType(#Grid, GridEx::#AnyRow, 4, GridEx::#Float) GridEx::MarkCells(#Grid, GridEx::#AnyRow, 4, GridEx::#Float, "Compare{>|5}", $009D00) ;GridEx::MarkCells(#Grid, GridEx::#AnyRow, 4, GridEx::#Float, "Beyond{3|5}", $578B2E, $3C14DC) ; Column 5: Cash GridEx::SetCellText(#Grid, GridEx::#Header, 5, "Cash") GridEx::SetCellType(#Grid, GridEx::#AnyRow, 5, GridEx::#Cash) GridEx::MarkCells(#Grid, GridEx::#AnyRow, 5, GridEx::#Cash, "Negative", #Red) GridEx::SetCellFlags(#Grid, 2, 5, GridEx::#Edit|GridEx::#Update|GridEx::#Check) ; Cell(2:5) Edit & Check ;GridEx::SetCellColor(#Grid, 2, 5, GridEx::#BackColor, $FBF7EC) GridEx::SetCellFrame(#Grid, 2, 5, $ED9564) ; Column 6: Time GridEx::SetCellText(#Grid, GridEx::#Header, 6, "Time") GridEx::SetCellType(#Grid, GridEx::#AnyRow, 6, GridEx::#Time) GridEx::FormatCells(#Grid, GridEx::#AnyRow, 6, GridEx::#Time, "%hh.%ii Uhr") GridEx::SetCellFlags(#Grid, 2, 6, GridEx::#Edit|GridEx::#Update|GridEx::#Check) ; Cell(2:6) Edit & Check ;GridEx::SetCellColor(#Grid, 2, 6, GridEx::#BackColor, $FBF7EC) GridEx::SetCellFrame(#Grid, 2, 6, $ED9564) ; Column 7: Grades GridEx::SetCellText(#Grid, GridEx::#Header, 7, "Grades") GridEx::SetCellType(#Grid, GridEx::#AnyRow, 7, GridEx::#Grades|GridEx::#Edit|GridEx::#Update) GridEx::SetCellFrame(#Grid, GridEx::#AnyRow, 7, $ED9564) ;GridEx::FormatCells(#Grid, GridEx::#AnyRow, 7, GridEx::#Grades, "", "GB") ; Great Britan -> A - F GridEx::RemoveCellFlags(#Grid, 6, 7, GridEx::#Edit|GridEx::#Frame|GridEx::#Update) ; Row 1-5: Set Text GridEx::SetRowText(#Grid, 1, "Left"+#LF$+ "Öfen"+#LF$+"12.4.2017"+#LF$+"5.67"+#LF$+"12,99"+#LF$+"12:45"+#LF$+"5") GridEx::SetRowText(#Grid, 2, "Alpha|Gamma|18.07.1967|1.33|-3,99|8:15 p.m.|2", "|") GridEx::SetRowText(#Grid, 3, "Ärmel|Esel|7.11.12|2.33|49,95|23:45|1", "|") GridEx::SetRowText(#Grid, 4, "Faden|Gans|3.4.2017|10.33|1,95|6:55|4", "|") GridEx::SetRowText(#Grid, 5, "Faden|Ähre|24.12.18|3.945|0,49|9:30 a.m.|6", "|") ; Sort by header click GridEx::DefineSortRows(#Grid, 1, 5) ; Sort only rows 1 to 5 GridEx::SetHeaderSort(#Grid, 1, GridEx::#String|GridEx::#Namen) ; Ä -> Ae GridEx::SetHeaderSort(#Grid, 2, GridEx::#String|GridEx::#Lexikon) ; Ä -> A GridEx::SetHeaderSort(#Grid, 3, GridEx::#Date) GridEx::SetHeaderSort(#Grid, 4, GridEx::#Float) GridEx::SetHeaderSort(#Grid, 5, GridEx::#Cash) GridEx::SetHeaderSort(#Grid, 6, GridEx::#Time) GridEx::SetHeaderSort(#Grid, 7, GridEx::#Grades) GridEx::SetSortColumnMarker(#Grid, GridEx::#Arrow|GridEx::#Font) ; Multiple Sorting ;GridEx::DefineMultiSort(#Grid, "Test", 1, 2) ;GridEx::DefineMultiSort(#Grid, "Test", 2, 2) ;GridEx::DefineMultiSort(#Grid, "Test", 3, #False) ; date length is always 8 (7.11.12 -> "20121107") ;GridEx::SetMultiSortColumn(#Grid, 1, "Test") ;GridEx::MultiSortGridRows(#Grid, "Test", #PB_Sort_Ascending|#PB_Sort_NoCase) ; Calculations GridEx::SetGridLine(#Grid, 1, 1, 5, GridEx::#Vertical|GridEx::#Right, $D1AE93) GridEx::SetGridLine(#Grid, GridEx::#AnyRow, 2, #False, GridEx::#Vertical|GridEx::#Right, $D1AE93) GridEx::SetGridLine(#Grid, 6, GridEx::#AnyCol, #False, GridEx::#Horizontal|GridEx::#Top, $D1AE93, GridEx::#Thick) GridEx::MergeCells(#Grid, 6, 1, 6, 2) GridEx::SetCellText(#Grid, 6, 1, "Berechnungen: ") GridEx::SetCellAlign(#Grid, 6, 1, GridEx::#Right) GridEx::SetCellColor(#Grid, 6, 1, GridEx::#BackColor, $FAF6F6) GridEx::AddCellTerm(#Grid, 6, 5, "Sum[R1]..[R5]", GridEx::#Cash) ;GridEx::AddCellTerm(#Grid, 6, 5, "[1:5]-[4:5]", GridEx::#Cash) GridEx::AddCellTerm(#Grid, 6, 4, "Average[1:4]..[5:4]", GridEx::#Float) GridEx::FormatCells(#Grid, 6, 4, GridEx::#Float, "Ø %i.%dd") ;GridEx::AddCellTerm(#Grid, 6, 4, "Count{<=|2.33}[1:4]..[5:4]", GridEx::#Integer) GridEx::AddCellTerm(#Grid, 6, 3, "Min[1:3]..[5:3]", GridEx::#Date) GridEx::FormatCells(#Grid, 6, 3, GridEx::#Date, "> %dd.%mm.%yyyy") GridEx::AddCellTerm(#Grid, 6, 6, "Max[R1]..[R5]", GridEx::#Time) GridEx::FormatCells(#Grid, 6, 6, GridEx::#Time, "< %hh.%ii Uhr") GridEx::AddCellTerm(#Grid, 6, 7, "Average[1:7]..[5:7]", GridEx::#Grades) GridEx::FormatCells(#Grid, 6, 7, GridEx::#Float, "Ø %i.%dd") CompilerEndIf ;} CompilerIf #Example = 2 ;{ Functions rr = 50 : cc = 25 GridEx::Gadget(#Win, #Grid, 10, 10, 780, 450, rr, cc) ; No resize for column 2 and row 3 ;GridEx::AllowMouseResize(#Grid, #False) GridEx::AllowColumnResize(#Grid, 2, #False) GridEx::AllowRowResize(#Grid, 3, #False) ; customize the grid ... GridEx::AttachPopup(#Grid, #PopupMenu) GridEx::DisableRedraw(#Grid) GridEx::SetTheme(#Grid, "Grey") ; freezing at cell (3,2) GridEx::FreezeRow(#Grid, 3) GridEx::FreezeColumn(#Grid, 2) GridEx::SetGridLine(#Grid, #False, 2, GridEx::#Vertical|GridEx::#Right, $D1AE93, 2) ; Image File$ = #PB_Compiler_Home + "examples\sources\Data\world.png" GridEx::SetCellImage(#Grid, GridEx::#AnyRow, 3, File$) GridEx::SetCellImage(#Grid, GridEx::#Header, 3, File$) ; style for frozen Rows/Cols For ii=1 To GridEx::GetAttribute(#Grid, GridEx::#Attrib_FrozenRow) GridEx::SetCellColor(#Grid, ii, GridEx::#AnyCol, #PB_Gadget_BackColor, $FFFBF8) Next For ii=1 To GridEx::GetAttribute(#Grid, GridEx::#Attrib_FrozenCol) GridEx::SetCellColor(#Grid, GridEx::#AnyCol, ii, #PB_Gadget_BackColor, $FFFBF8) Next ; example of buttons at column 5 GridEx::SetColumnWidth(#Grid, 5, 90) For ii=15 To 25 GridEx::SetCellColor(#Grid, ii, 5, #PB_Gadget_BackColor, RGB(207, 207, 207)) GridEx::SetCellType(#Grid, ii, 5, GridEx::#Button) GridEx::SetCellAlign(#Grid, ii, 5, GridEx::#Center) GridEx::SetCellText(#Grid, ii, 5, "Click me"+Str(ii)) Next ; example of editable at col 6 with 2 different edit modes) ; Append-mode needs return/esc to exit; arrow-keys navigate thru text - default For ii=7 To 10 GridEx::SetCellColor(#Grid, ii, 6, #PB_Gadget_BackColor, RGB(255, 246, 143)) GridEx::SetCellAlign(#Grid, ii, 6, GridEx::#Right) GridEx::SetCellType(#Grid, ii, 6, GridEx::#Edit) GridEx::SetCellText(#Grid, ii, 6, "type ...") GridEx::AddListItems(#Grid, ii, 6, "Text|Test|Tesa|Texte", "|") Next ; edit Over-mode, arrow-keys --> exit cell For ii=12 To 18 GridEx::SetCellColor(#Grid, ii, 6, GridEx::#BackColor, RGB(0, 238, 238)) GridEX::SetCellAlign(#Grid, ii, 6, GridEx::#Left) GridEx::SetCellType(#Grid, ii, 6, GridEx::#Edit) GridEx::SetCellEditMode(#Grid, ii, 6, GridEx::#Over) GridEx::SetCellText(#Grid, ii, 6, "type ...") GridEx::AddListItems(#Grid, ii, 6, "Text|Test|Tesa|Texte", "|") Next ; example of checkboxes at col 9 ;GridEx::SetCellColor(#Grid, GridEx::#AnyRow, 9, #PB_Gadget_BackColor, $F5F5F5) GridEx::SetCellType(#Grid, GridEx::#AnyRow, 9, GridEx::#Checkbox|GridEx::#Edit) GridEX::SetCellAlign(#Grid, GridEx::#AnyRow, 9, GridEx::#Center) ; setting row 30 to checkboxes as well: row-style prevails on Col-style! ; Cells (30,1) (30,2) (30,3) are now checkboxes! not like other frozen cells ;GridEx::SetCellColor(#Grid, 30, GridEx::#AnyCol, #PB_Gadget_BackColor, $F5F5F5) GridEx::SetCellType(#Grid, 30, GridEx::#AnyCol, GridEx::#Checkbox|GridEx::#Edit) GridEX::SetCellAlign(#Grid, 30, GridEx::#AnyCol, GridEx::#Center) ; example of extra style ( comboboxes at col# 11, some Rows) GridEx::SetCellAlign(#Grid, 11, 10, GridEx::#Center) GridEx::SetCellColor(#Grid, 11, 10, #PB_Gadget_BackColor, $FFEFEF) GridEx::SetCellColor(#Grid, 11, 10, #PB_Gadget_FrontColor, $000000) GridEx::SetCellType(#Grid, 11, 10, GridEx::#Combo|GridEx::#Edit) GridEx::AddComboItems(#Grid, 11, 10, "A|B|C|D|D2|E|F", "|") For rr= 12 To 15 GridEx::SetCellAlign(#Grid, rr, 10, GridEx::#Center) GridEx::SetCellColor(#Grid, rr, 10, #PB_Gadget_BackColor, $F5F5F5) GridEx::SetCellColor(#Grid, rr, 10, #PB_Gadget_FrontColor, $600000) GridEx::SetCellType(#Grid, rr, 10, GridEx::#Combo) GridEx::AddComboItems(#Grid, rr, 10, "A|B|C|D|D2|E|F", "|") Next GridEx::MergeCells(#Grid, 23, 11, 24, 11) ; merging two combos together !! ; span cells, herites style and text of its first cell GridEx::MergeCells(#Grid, 7, 12, 8, 14) GridEx::MergeCells(#Grid, 10, 12, 16, 14) For cc= 12 To 14 For rr =6 To 18 GridEX::SetCellAlign(#Grid, rr, cc, GridEx::#Center) GridEx::SetCellColor(#Grid, rr, cc, #PB_Gadget_FrontColor, $3333CD) GridEx::SetCellType(#Grid, rr, cc, GridEx::#Edit) GridEx::SetCellFont(#Grid, rr, cc, "Arial", 16) GridEx::SetCellText(#Grid, rr, cc, "("+rr+","+cc+")") Next Next GridEx::AutoRowHeight(#Grid, 6) ; big font GridEx::AutoRowHeight(#Grid, 18) ; big font ; hiding Col 7 and row 17 GridEx::HideColumn(#Grid, 7, #True) GridEx::HideRow(#Grid, 17, #True) ; <<<--------------- Hiding Focus Rectangle ------------------------>>> ; Example: to hide focus-rectangle,. change its color to -1 / ozzie / uncomment below line ;GridEx::SetColor(#Grid, #FocusBorder, -1) CompilerEndIf ;} GridEx::Refresh(#Grid) ;GridEx::LoadGridSize(#Grid, "GridEx.win", GridEx::#Window|GridEx::#Grid) If FileSize("GridEx_Themes.xml") > 0 GridEx::LoadThemes("GridEx_Themes.xml") EndIf ;{ ----- Event Loop ----- EventGadget = -1 EventType = -1 EventMenu = -1 Repeat Event = WaitWindowEvent() Select Event Case GridEx::#Event_Change If EventGadget() = #Grid rr = GridEx::GetAttribute(#Grid, GridEx::#Attrib_ChangedRow) cc = GridEx::GetAttribute(#Grid, GridEx::#Attrib_ChangedCol) wrd = GridEx::LastCellText(#Grid) Debug " ... Change occured in Cell (" + Str(rr) +","+ Str(cc) + ") .. old text:" + wrd EndIf Case GridEx::#Event_Click If EventGadget() = #Grid rr = GridEx::GetAttribute(#Grid, GridEx::#Attrib_ClickedRow) cc = GridEx::GetAttribute(#Grid, GridEx::#Attrib_ClickedCol) Debug " ... Button clicked in Cell (" + Str(rr) +","+ Str(cc) + ")" EndIf Case #PB_Event_SizeWindow GridEx::ResizeHandler(#Grid) Case #PB_Event_Gadget EventGadget = EventGadget() EventType = EventType() Select EventGadget Case #Export GridEx::ExportFileCSV(#Grid, "GridEx.csv", GridEx::#Semicolon) Case #Import GridEx::ImportFileCSV(#Grid, "GridEx.csv") EndSelect Case #PB_Event_Menu EventMenu = EventMenu() Select EventMenu Case #MenuItem_1 GridEx::CopyToClipboard(#Grid) Case #MenuItem_2 GridEx::PasteFromClipboard(#Grid) Case #MenuItem_3 GridEx::ClearSelectedCells(#Grid) Case #MenuItem_4 If GridEx::GetSelection(#Grid) Row1 = GridEx::Area\Row\First Col1 = GridEx::Area\Col\First Row2 = GridEx::Area\Row\Last Col2 = GridEx::Area\Col\Last GridEx::MergeCells(#Grid, Row1, Col1, Row2, Col2) GridEx::RemoveSelection(#Grid) EndIf Case #MenuItem_5 GridEx::ResetCells(#Grid) Case #MenuItem_6 GridEx::ClearCells(#Grid) EndSelect EndSelect Until Event = #PB_Event_CloseWindow ;} ;GridEx::SaveGridSize(#Grid, "GridEx.win") GridEx::SaveThemes("GridEx_Themes.xml") GridEx::Save(#Grid) EndIf CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x86) ; CursorPosition = 17 ; Folding = GEGQAQCCAA59VBAMIAACAA5uHAEwIAgn-HAEAz5HAAYAA9g+fwAzz4PK2C7BQv-jzhRQZAgs7 ; Markers = 954,2291,2682 ; EnableXP