B4A=true Group=Default Group ModulesStructureVersion=1 Type=Class Version=7.3 @EndOfDesignText@ 'Table CustomView 'Version 2.26 'added the LoadSQLiteDB3 method using SQL.ExecQuery2 instead of SQL.ExecQuery 'Version 2.25 'added the UpdateCell method 'Version 2.24 'amended a minor error 'Version 2.22 'improved JumpToRowAndSelect scrolls horizontally to the selected column 'Version 2.21 'improved setHeaderHeight 'Version 2.20 'added padding for status bar Label 'Version 2.19 'replaced DoEvents by Sleep(0) ' 'Version 2.18 'amended error in setHeaderAlignment, missing Private cHeaderAlignments(mNumberOfColumns) As Int ' 'Version 2.17 'Amended an error ' 'Version 2.16 'Amended an error ' 'Version 2.15 '#Event: CellClick(row As Int, col As Int) to #Event: CellClick(col As Int, row As Int) '#Event: CellLongClick(row As Int, col As Int) to #Event: CellLongClick(col As Int, row As Int) ' 'Version 2.14 Added NumberOfColumns and NumberOfRow as readable properties 'Amended Header_Click error 'Version 2.13 'Amended initialization problem 'Version 2.12 'Added an array with column data types, this is useful for sorting columns with numbers. 'Added two methods: 'SetColumnDataType(Col As Int, DataType As String) 'SetColumnDataTypes(DataType() As String) 'Changed Private Sub refreshTable to Public Sub RefreshTable 'Version 2.11 'Added a Scale routine allowing to scale the Table 'Added Panel property 'Changed the Designer default values the same as the original default values 'TextAlignment and HeaderTextAlignment LEFT becomes CENTER 'TextSize 18 becomes 14 'LineWidth 2 becomes 1 'Version 2.10 'Amended problem with TextAlignmet and HeaderTextAlignment properties 'Version 2.00 'Added CustomView support 'Changes between the previous versions and version 2.00 'For a Table added in the Designer, this is new 'No need to initialize nor add it onto a parent view 'For a Table added in the code 'The Initialize routine has been splittend into two routines 'New: ' Initialize (CallBack As Object, EventName As String) ' InitializeTable (vNumberOfColumns As Int, cellAlignement As Int, showStatusL As Boolean) 'Example: ' Table1.Initialize(Me, "Table1") ' Table1.InitializeTable(5, Gravity.CENTER_HORIZONTAL, True) 'Old: 'Initialize(CallBack As Object, EventName As String, vNumberOfColumns As Int, cellAlignement As Int, showStatusL As Boolean) 'Example: ' Table1.InitializeTable(Me, "Table1", 5, Gravity.CENTER_HORIZONTAL, True) 'Version history 'Version 1.43 'The modifications in LoadSQLiteDB were not OK for all cases 'Reset LoadSQLiteDB like in version 1.40 'Added LoadSQLiteDB2 routine for real numbers with more than 6 digits 'This routine needs a string array with the data types 'Version 1.42 'Amended problem with big numbers in LoadSQLiteDB 'The code in version didn't work correctly 'Final solution suggested in the forum by cimperia 'Version 1.41 'Amended problem with big numbers in LoadSQLiteDB 'replaced GetString by GetDouble for REAL numbers 'replaced GetString by GetLong for INTEGER numbers 'Version 1.40 'Amended error cHeaderHeight 'Amended last row selection 'Version 1.39 'Added SetAutomaticWidths 'Changed AddRowAutomaticWidths 'Version 1.38 'Amended rows not visible problem 'Version 1.37 'Modified singleline as property 'Added AllowSelection property, True by default 'avoided unnecessary innerClearAll calls 'added HeaderAlignment 'Version 1.36 'Added UseColumnColors ColumnColors and HeaderColors properties. 'Version 1.35 'Added SortColumn property. 'Version 1.34 'Amended setRowColor1, setRowColor2 etc not working properly 'Added HeaderHeight property, allows to set it to 0 to hide the header, the default value is the row height. 'Some minor changes 'Version 1.33 'Added RowHeight as property 'Version 1.32 'Added sortTableNum to sort numbers instead of strings 'Version 1.31 'Amended error in line color when hiding a column 'Version 1.30 'Added Public Sub JumpToRowAndSelect(Row As Int, Col As Int) routine 'Added Left, Top, Widht, Height and Visible properties. 'Added HeaderNames List, you can get any header name with Table1.HeaderNames.Get(col) 'Amended line width problem for devices with 0.75 density 'Version 1.29 'Amended SetColumnWidths with 0 values 'Version 1.28 'Amended the click of the internalPanel 'Version 1.27 'Improved Header change with automatic widths 'Version 1.26 'Added GetColumnWidths method 'Version 1.25 'Added LoadTableFromCSV2(Dir As String, Filename As String, HeadersExist As Boolean, SeparatorChar As String, AutomaticWidths As Boolean) 'I kept LoadTableFromCSV for backward compatibility. 'The new routines alows to define the separator character and automatic column width calculation. 'Version 1.24 'Added Gravity for each column 'Version 1.23 'Added the RemoveView method 'fixed StatusLine property setting 'Version 1.22 'Added code in setTextColor, setTableColor, setTextSize that changes the properties also after having filled the table 'Version 1.21 'method LoadSQLiteDB to fill a table from a SQLite database 'changed colors, alignment etc as properties (see the routines beginning with lowercase 'set' or 'get' 'Version 1.20 ' fix bug not calling updateIPLocation on clean table, which will cause panel to be of the wrong size if you create a table, fill it up than clear all and not add rows 'Version 1.19 ' fix last column (if no empty space, its very hard to choose it) ' fix size of sorting icons on columns ' whats new 1.18 ' bug fix, table can now start on left <> 0 without weird horizontal scroll issues - thanks klaus ' add method addToView - which is the same as add2Activity - but a better naming - you can still use addToActivity - depricated like method. ' whats new 1.17 ' bug fix, table that start not at top=0 will not fire events corretly internalPanel.top will start at top 0 and will consume events from tables rows ' whats new 1.16 ' bug fix, table with no status line throw exception ' method to disable the status line auto fill with number of rows ' whats new 1.15 ' Tables internal panel can now fire events - so when user click an empty space developer can trigger a UI component for example use this to trigger adding line to an empty table for example ' added statusline label, can be used to show messages (option to turn on/off in initialize sub) - default is to show number of rows ' will show (as default) the number of rows in the statusLine ' added size() sub to return the number of lines in the table ' added ability to sort by column - click on the column header (I had to remove the header click event) added small UI component to show sorting (will lose selection for now) ' need to copy png files sort_asc, sort_desc to the files folder of your project ' near future: need to add ability to keep selection ' Whats new 1.14 ' alignement now is set in the Initialize sub ' added removeRow() sub to remove a specifc row from the table - this is EREL's removeRow adopted to 1.13 and to the rest of the changes in 1.14 ' added getValues() sub to get the entire row in an array, thought this is usefull ' added updateRow() sub to set an entire row at once, Vs cell by cell, in tables many times, developer work by rows , update an entire row ' added ability to set (and get) the lables to be singleLine or multiLine lables (deafult is singleLine) this feature depend on reflection lib - setting this attribute will clear the table!!! ' added getHeaderPanel sub to return he header panel so developer can get access to the header components , for example to show tooltip, or quickAction on the header location ' added ability to turn on and off multi selection of rows, User can now select one row or any number of rows, developer can use that functunality to , for example change status of many rows at once, or remove many rows with one user action ' added getSelectedRows to return list of selected rows ' added ability to hide/unhide a specific column, so it will be part of the table but hidden from the user, this is usefull to if developer wants to maintain additional data in the table (this is not a complete data model / view model implementation) ' with ScrollView2 instead of ScrollView ' with highlighting of the selected cell ' these Event lines are useful for a library compilation for the IDE autocompletion #Event: CellClick(col As Int, row As Int) #Event: CellLongClick(col As Int, row As Int) #Event: HeaderClick(col As Int) #Event: HeaderLongClick(col As Int) #Event: ScrollChanged(PosX As Int, PosY As Int) ' these RaisesSynchronousEvents lines are useful for a library compilation #RaisesSynchronousEvents: CellClick #RaisesSynchronousEvents: CellLongClick #RaisesSynchronousEvents: HeaderClick #RaisesSynchronousEvents: HeaderLongClick #RaisesSynchronousEvents: ScrollChanged 'custom properties #DesignerProperty: Key: NumberOfColumns, DisplayName: NumberOfColumns, FieldType: Int, DefaultValue: 3, Description: Number of columns. #DesignerProperty: Key: NumberOfFixedColumns, DisplayName: NumberOfFixedColumns, FieldType: String, DefaultValue: 0, List: 0|1|2|3, Description: Sets the number of first fixed columns max value = 3. #DesignerProperty: Key: FirstColumnFixed, DisplayName: FirstColumnFixed, FieldType: Boolean, DefaultValue: False, Description: Sets the first column fixed. This property is obsolete. It is replaced by NumberOfFixedColumns. #DesignerProperty: Key: MultiSelect, DisplayName: MultiSelect, FieldType: Boolean, DefaultValue: False, Description: Allows more than one selected row. #DesignerProperty: Key: ZeroSelection, DisplayName: ZeroSelection, FieldType: Boolean, DefaultValue: False, Description: True > when a selected row is pressed it will be unselected False > it remains selected. #DesignerProperty: Key: RowHeight, DisplayName: Row height, FieldType: Int, DefaultValue: 40, Description: Row height. #DesignerProperty: Key: HeaderHeight, DisplayName: Header height, FieldType: Int, DefaultValue: 40, Description: Header height. #DesignerProperty: Key: LineWidth, DisplayName: LineWidth, FieldType: Int, DefaultValue: 1, MinRange: 1, MaxRange: 10, Description: Line width in dips. #DesignerProperty: Key: TextSize, DisplayName: Text size, FieldType: Int, DefaultValue: 14, Description: Text size. #DesignerProperty: Key: TextAlignment, DisplayName: Text Alignment, FieldType: String, DefaultValue: CENTER, List: LEFT|CENTER|RIGHT, Description: Set the text alignment. #DesignerProperty: Key: HeaderTextAlignment, DisplayName: Header text Alignment, FieldType: String, DefaultValue: CENTER, List: LEFT|CENTER|RIGHT, Description: Set the header text alignment. #DesignerProperty: Key: HeaderColor, DisplayName: Header color, FieldType: Color, DefaultValue: 0xFF808080, Description: Header background color. #DesignerProperty: Key: TableColor, DisplayName: Table color, FieldType: Color, DefaultValue: 0xFFD3D3D3, Description: Table background color. #DesignerProperty: Key: HeaderTextColor, DisplayName: Header text color, FieldType: Color, DefaultValue: 0xFFFFFFFF, Description: Table background color. #DesignerProperty: Key: CellTextColor, DisplayName: Cell text color, FieldType: Color, DefaultValue: 0xFF000000, Description: Table background color. #DesignerProperty: Key: Row1Color, DisplayName: Row 1 color, FieldType: Color, DefaultValue: 0xFFFFFFFF, Description: Row1 background color. #DesignerProperty: Key: Row2Color, DisplayName: Row 2 color, FieldType: Color, DefaultValue: 0xFF98F5FF, Description: Row2 background color. #DesignerProperty: Key: SelectedRowColor, DisplayName: SelectedRowColor, FieldType: Color, DefaultValue: 0xFF007FFF, Description: Selected row background color. #DesignerProperty: Key: SelectedRowTextColor, DisplayName: SelectedRowTextColor, FieldType: Color, DefaultValue: 0xFF007FFF, Description: Selected row text color. #DesignerProperty: Key: SelectedCellColor, DisplayName: SelectedCellColor, FieldType: Color, DefaultValue: 0xFFFC8EAC, Description: Selected cett background color. #DesignerProperty: Key: SelectedCellTextColor, DisplayName: SelectedCellTextColor, FieldType: Color, DefaultValue: 0xFFFC8EAC, Description: Selected cell text color. #DesignerProperty: Key: ShowStatusLine, DisplayName: ShowStatusLine, FieldType: Boolean, DefaultValue: True, Description: Shows or hides the status line. #DesignerProperty: Key: SortColumn, DisplayName: SortColumn, FieldType: Boolean, DefaultValue: False, Description: True = Sorts columns, False = doesn't sort columns. #DesignerProperty: Key: SortRemoveAccents, DisplayName: SortRemoveAccents, FieldType: Boolean, DefaultValue: False, Description: Sorts without accented characters. Removes the accents for a correct sorting. This can slow down the sorting. Valid only with SortColumn = True. #DesignerProperty: Key: SortBitmapWidth, DisplayName: SortBitmapWidth, FieldType: Int, DefaultValue: 10, Description: Width of the sorting bitmap. Valid only with SortColumn = True. #DesignerProperty: Key: SortBitmapColor, DisplayName: SortBitmapColor, FieldType: Color, DefaultValue: 0xFFFFFF00, Description: Color of the sorting bitmap. Valid only with SortColumn = True. Sub Class_Globals Public iTableTopFromDialog As Int Private tfItalic As Typeface Public arrDataTypesX() As String Private bMap As Boolean Private cSorting As clsSorting Public Data As List '<<<<<<< \list holding string arrays Private arrColLong() As Long Private arrColDouble() As Double Private arrColString() As String Private arrSortIndex() As Int Private iPreviousSortColumn As Int = -1 'ignore warning Private bPreviousSortAscending As Boolean 'ignore warning Private mapSortingIndexes As Map Private iAlteredRowColour As Int 'added Private iAlteredTextColour As Int 'added Private bItalicRows As Boolean Private arrAlteredRowColour() As Boolean 'added Private arrAlteredRowColour2() As Boolean 'added Private arrAlteredRowTextColour() As Boolean 'added Private arrAlteredRowTextColour2() As Boolean 'added Private arrAlterRowsItalic() As Boolean 'added Private arrAlterRowsItalic2() As Boolean'added Private arrDataSorted() As Boolean 'added Private bDataTempDone As Boolean 'added Public arrCSV(,) As String 'added Private SV2 As ScrollView2D Private SVF As ScrollView Private HeaderFirst As Panel Private lstRowColors As List Public strColumnDataTypes() As String 'added Private DataTemp As List 'added 'added Type SortString(IDX As Long, _ strString As String, _ bColouredRow As Boolean, _ bColouredRowText As Boolean) 'added Type SortLong(IDX As Long, _ lLong As Long, _ bColouredRow As Boolean, _ bColouredRowText As Boolean) 'added Type SortDouble(IDX As Long, _ dDouble As Double, _ bColouredRow As Boolean, _ bColouredRowText As Boolean) Private iLastSelectedRow As Int Private iLastSelectedColumn As Int Private arrStringTypeCheck(256) As Byte 'added Private BC As ByteConverter Public arrDateColumns() As Boolean 'added Public mapLongDates As Map 'holding long date arrays either for XL dates or ticks 'Private sf As StringFunctions Private StringUtils1 As StringUtils Private SV2 As ScrollView2D Private pnlTable As Panel Private Header As Panel Private lblStatusLine As Label Private cCallBack As Object Private cEventName As String Private cLeft, cTop , cWidth, cHeight As Int Public HeaderNames As List Public SelectedRows As List ' selected rows ' convert to map!!! Private SelectedCol As Int Private LabelsCache As List Public minVisibleRow As Int 'altered from private Public maxVisibleRow As Int Private IsVisible As Boolean Public visibleRows As Map Private mNumberOfColumns, ColumnWidths(), cColumnColors(), cTextColors(), cHeaderColors(), cHeaderTextColors(), DataWidths(), HeaderWidths() As Int Private cColumnDataType() As String Private cRowHeight, cHeaderColor, cTableColor, cTextColor, cHeaderHeight, cHeaderTextColor As Int Private cAutomaticWidths = False As Boolean Private cTextSize As Float Type RowCol (Row As Int, Col As Int) Private cAlignment As Int Private cAlignments() As Int Private cAlignments0() As Int Private MultiAlignments = False As Boolean Private cHeaderAlignment = Gravity.CENTER As Int Private cHeaderAlignments() As Int Private cHeaderAlignments0() As Int Private HeaderMultiAlignments = False As Boolean Private MultiTypeFace = False As Boolean Private cTypeFace = Typeface.DEFAULT As Typeface Private cTypeFaces() As Typeface Private cTypeFaces0() As Typeface Private HeaderMultiTypeFace = False As Boolean Private cHeaderTypeFace = Typeface.DEFAULT As Typeface Private cHeaderTypeFaces() As Typeface Private cHeaderTypeFaces0() As Typeface Private MultiTypeFace = False As Boolean Private cTypeFace = Typeface.DEFAULT As Typeface Private cTypeFaces() As Typeface Private HeaderMultiTypeFace = False As Boolean Private cHeaderTypeFace = Typeface.DEFAULT As Typeface Private cHeaderTypeFaces() As Typeface Private cLineWidth = Max(1, 1dip) As Int Private ExtraWidth = 12dip + cLineWidth As Int Private SelectedDrawable(), Drawable1(), Drawable2() As Object Private SelectedCellDrawable As Object Private cRowColor1, cRowColor2, cSelectedRowColor, cSelectedCellColor, cSelectedRowTextColor, cSelectedCellTextColor As Int Private cSortColumn = True As Boolean Private cUseColumnColors = False As Boolean Private cSortRemoveAccents = False As Boolean Private bmp As Bitmap ' used for the canvas below Private mFirstColumnsWidth = 0 As Int Private mFirstColumnFixed = False As Boolean Private mNumberOfFixedColumns As Int = 0 Private cvs As Canvas ' used to measure string widths in the LoadSQLiteDB routine Private lstRowColorIndexes As List Private lstRowColors As List Private lstRowDrawables As List 'Table settings cHeaderColor = Colors.Gray cTableColor = Colors.LightGray cTextColor = Colors.Black cHeaderTextColor = Colors.White cTextSize = 14 cAlignment = Gravity.CENTER 'change to Gravity.LEFT or Gravity.RIGHT for other alignments. cRowColor1 = Colors.White cRowColor2 = 0xFF98F5FF cSelectedRowColor = 0xFF007FFF cSelectedCellColor = 0xFFFC8EAC 'cRowHeight = 40dip 'was 40 cHeaderHeight = cRowHeight cSelectedRowTextColor = Colors.Black cSelectedCellTextColor = Colors.Black Private cSingleLine = True As Boolean ' does a lable hold a single line text or multiline , need to be set rigth after call to initialize Private mMultiSelect As Boolean = False 'Private IsMultiSelect As Boolean = False Private cAllowSelection = True As Boolean Private SavedWidths() As Int' to keep the user set widths for columns Private internalPanel As Panel Private cShowStatusLine As Boolean Public sortingDir As Int = 0 ' -1,0,1 as acc, unsorted, dec Public sortedCol As Int = -1' hold the sorted column -1 for none Private pnlSortingView As Panel 'Dim debug_counter As Long Private enableStatusLineAutoFill As Boolean = True Private pnlAsc As Panel 'added in version 3.03 Private bmpAsc, bmpDes, bmpEqual As Bitmap 'added in version 3.03 Private cvsAsc, cvsDes, cvsEqual As Canvas 'added in version 3.03 Private cSortBitmapWidth As Int 'added in version 3.03 Private cSortBitmapHeight As Int 'added in version 3.03 Private cSortBitmapColor As Int 'added in version 3.03 Private mCustomSortingBitmaps As Boolean 'added in version 3.03 Private mZeroSelection = False As Boolean Private SV2Scrolls, SVFScrolls As Boolean Private SV2PosX As Int Public TableObject As Table End Sub Public Sub Initialize (CallBack As Object, EventName As String) cEventName = EventName cCallBack = CallBack cSortBitmapWidth = 10dip cSortBitmapColor = Colors.Yellow cSorting.Initialize 'still need to initialize, although Initialize has no code in it! tfItalic = Typeface.CreateNew(Typeface.DEFAULT, Typeface.STYLE_ITALIC) InitStringTypeCheck End Sub Sub InitStringTypeCheck Dim i As Int 'dot is char(46) arrStringTypeCheck(46) = 2 '- is char(45) need this as - can be part of number! arrStringTypeCheck(45) = 1 '0 to 9 For i = 48 To 57 arrStringTypeCheck(i) = 1 Next End Sub Public Sub DesignerCreateView (Base As Panel, Lbl As Label, Props As Map) pnlTable = Base cLeft = Base.Left cTop = Base.Top cWidth = Base.Width cHeight = Base.Height pnlTable.Color = Colors.Transparent 'sets the text alignment property Select Props.Get("TextAlignment") Case "LEFT" cAlignment = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.LEFT) Case "CENTER" cAlignment = Gravity.CENTER Case "RIGHT" cAlignment = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.RIGHT) End Select 'sets the header text alignment property Select Props.Get("HeaderTextAlignment") Case "LEFT" cHeaderAlignment = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.LEFT) Case "CENTER" cHeaderAlignment = Gravity.CENTER Case "RIGHT" cHeaderAlignment = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.RIGHT) End Select cLineWidth = DipToCurrent(Props.Get("LineWidth")) mNumberOfColumns = Props.Get("NumberOfColumns") 'by default tbldialog not visible as otherwise there will be an error here 'will be set visible if a table is needed in Dialog.Show2, Show3 or Show4 '------------------------------------------------------------------------- If TableObject.IsVisible Then mNumberOfFixedColumns = Props.Get("NumberOfFixedColumns") mFirstColumnFixed = Props.Get("FirstColumnFixed") mZeroSelection = Props.Get("ZeroSelection") End If If mFirstColumnFixed = True And mNumberOfFixedColumns = 0 Then mNumberOfFixedColumns = 1 End If cHeaderColor = Props.Get("HeaderColor") cTableColor = Props.Get("TableColor") cHeaderTextColor = Props.Get("HeaderTextColor") cTextColor = Props.Get("CellTextColor") cRowColor1 = Props.Get("Row1Color") cRowColor2 = Props.Get("Row2Color") cSelectedRowColor = Props.Get("SelectedRowColor") cSelectedCellColor = Props.Get("SelectedCellColor") cTextSize = Props.Get("TextSize") cRowHeight = DipToCurrent(Props.Get("RowHeight")) cHeaderHeight = DipToCurrent(Props.Get("HeaderHeight")) ' cShowStatusLine = Props.Get("ShowStatusLine") ' cSortRemoveAccents = Props.Get("SortRemoveAccents") InitTable End Sub ' add the table to a view of your choice (panel, activity, etc) ' v as the view ' Left, Top as the start point of the table in that view ' width and height as the width and height of the table in the view, note this include empty space in case not enough lines exists - ' but the table will take the whole area. Public Sub AddToView(v As View, Left As Int, Top As Int, Width As Int, Height As Int) AddToActivity(v,Left,Top,Width,Height) End Sub ' add the table to an Activity ' Act is the Activity ' Left, Top as the start point of the table in that view ' width and height as the width and height of the table in the view, note this include empty space in case not enough lines exists - ' but the table will take the whole area. Public Sub AddToActivity(Act As Activity, Left As Int, Top As Int, Width As Int, Height As Int) cLeft = Left cTop = Top cWidth = Width cHeight = Height pnlTable.Initialize("") pnlTable.Color = Colors.Transparent Act.AddView(pnlTable, cLeft, cTop , cWidth, cHeight) InitTable End Sub Private Sub InitTable Data.Initialize lstRowColors.Initialize 'list of the different row colors lstRowColorIndexes.Initialize 'list of the color indexes for each row, always 0 for the the first two colors lstRowDrawables.Initialize 'list of the drawables for the different row colors visibleRows.Initialize TableObject = Me SV2.Initialize(0, 0, "SV2") SVF.Initialize2(0, "SVF") internalPanel.Initialize("IP") innerClearAll(mNumberOfColumns, True) SV2.Panel.Color = cTableColor SV2.FadingEdges(False) SVF.Panel.Color = cTableColor IsVisible = True HeaderFirst.Initialize("") HeaderFirst.Color = cTableColor Header.Initialize("") Header.Color = cTableColor If mNumberOfFixedColumns = 0 Then mFirstColumnsWidth = 0 Else mFirstColumnsWidth = 100dip End If pnlTable.AddView(Header, mFirstColumnsWidth, 0 , cWidth - mFirstColumnsWidth, cHeaderHeight) pnlTable.AddView(HeaderFirst, 0, 0, mFirstColumnsWidth, cHeaderHeight) ' add status line lblStatusLine.Initialize("") lblStatusLine.Color = Colors.Transparent ' is it really ? internalPanel.Color = Colors.Transparent 'TODO uncomment this If (cShowStatusLine = True) Then pnlTable.AddView(SVF, 0, Header.Height, cWidth, cHeight - Header.Height - cRowHeight) pnlTable.AddView(SV2, mFirstColumnsWidth, Header.Height, cWidth - mFirstColumnsWidth, cHeight - Header.Height - cRowHeight) pnlTable.AddView(lblStatusLine,0, SV2.Top + SV2.Height, cWidth, cRowHeight) Else pnlTable.AddView(SV2, mFirstColumnsWidth, Header.Height, cWidth - mFirstColumnsWidth, cHeight - Header.Height) pnlTable.AddView(SVF, 0, Header.Height, cWidth, cHeight - Header.Height) pnlTable.AddView(lblStatusLine,0, SV2.Top + SV2.Height, 0, 0) End If SetPadding(lblStatusLine, 4dip, 2dip, 4dip, 2dip) pnlTable.AddView(internalPanel, 0, 0, cWidth, 0) updateIPLocation Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim SavedWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String For i = 0 To mNumberOfColumns - 1 ColumnWidths(i) = SV2.Width / mNumberOfColumns HeaderWidths(i) = ColumnWidths(i) DataWidths(i) = ColumnWidths(i) SavedWidths(i) = ColumnWidths(i) cColumnDataType(i) = "TEXT" Next SVF.Panel.Width = SVF.Width SVF_ScrollChanged(0) SV2.Panel.Width = SV2.Width SV2_ScrollChanged(0, 0) If (lblStatusLine.IsInitialized And enableStatusLineAutoFill=True) Then setStatusLine(Data.Size & " rows") ' should this be automatic ? pnlSortingView.Initialize("") If mCustomSortingBitmaps = False Then 'custom is bitmaps from file InitializeSortingBitmaps End If ' used for string width measuements in the LoadSQLiteDB routine bmp.InitializeMutable(2dip, 2dip) cvs.Initialize2(bmp) End Sub Public Sub InitializeTable (NumberOfColumns As Int, cellAlignement As Int, ShowStatusLine As Boolean) ' Initialize(CallbackModule, EventName) cShowStatusLine = ShowStatusLine SelectedRows.Initialize cAlignment = cellAlignement mNumberOfColumns = NumberOfColumns Data.Initialize 'needed Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim SavedWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String For i = 0 To mNumberOfColumns - 1 ColumnWidths(i) = SV2.Width / mNumberOfColumns HeaderWidths(i) = ColumnWidths(i) DataWidths(i) = ColumnWidths(i) SavedWidths(i) = ColumnWidths(i) Next innerClearAll(mNumberOfColumns, True) End Sub 'initializes the sorting Bitmaps Private Sub InitializeSortingBitmaps Private pthAsc, pthDes, pthEqual As Path cSortBitmapHeight = cSortBitmapWidth / 2 pnlAsc.Initialize("") pnlTable.AddView(pnlAsc, 0, 0, cSortBitmapWidth, cSortBitmapHeight) cvsDes.Initialize(pnlAsc) pthDes.Initialize(0, 0) pthDes.LineTo(cSortBitmapWidth, 0) pthDes.LineTo(cSortBitmapHeight, cSortBitmapHeight) cvsDes.DrawColor(Colors.Transparent) cvsDes.DrawPath(pthDes, cSortBitmapColor, True, 1dip) bmpDes = cvsDes.Bitmap cvsAsc.Initialize(pnlAsc) pthAsc.Initialize(0, cSortBitmapHeight) pthAsc.LineTo(cSortBitmapHeight, 0) pthAsc.LineTo(cSortBitmapWidth, cSortBitmapHeight) cvsAsc.DrawColor(Colors.Transparent) cvsAsc.DrawPath(pthAsc, cSortBitmapColor, True, 1dip) bmpAsc = cvsAsc.Bitmap 'icon for when all values in the column are the same, so no sort was done 'will be diamond shape '------------------------------------------------------------------------ cvsEqual.Initialize(pnlAsc) pthEqual.Initialize(0, cSortBitmapHeight / 2) pthEqual.LineTo(cSortBitmapWidth / 2, cSortBitmapHeight) pthEqual.LineTo(cSortBitmapWidth, cSortBitmapHeight / 2) pthEqual.LineTo(cSortBitmapWidth / 2, 0) cvsEqual.DrawColor(Colors.Transparent) cvsEqual.DrawPath(pthEqual, cSortBitmapColor, True, 1dip) bmpEqual = cvsEqual.Bitmap pnlAsc.RemoveView End Sub 'Clears the table Public Sub ClearAll innerClearAll(mNumberOfColumns, True) updateIPLocation End Sub 'Sets the columns widths. 'Example: Table1.SetColumnsWidths(Array As Int(100dip, 30dip, 30dip, 100%x - 160dip)) Public Sub SetColumnsWidths(Widths() As Int) ' clone (keep) Widths Dim col, row As Int Dim SavedWidths(Widths.Length) As Int Dim ColumnWidths(Widths.Length) As Int Dim HeaderWidths(Widths.Length) As Int If cAutomaticWidths = False Then For col = 0 To Widths.Length - 1 SavedWidths(col) = Widths(col) ColumnWidths(col) = Widths(col) HeaderWidths(col) = Widths(col) DataWidths(col) = Widths(col) Next Else For col = 0 To Widths.Length - 1 SavedWidths(col) = Widths(col) ColumnWidths(col) = Widths(col) Next End If Dim v As View Dim w As Int If mNumberOfFixedColumns = 0 Then For col = 0 To Widths.Length - 1 v = Header.GetView(col) w = Max(2dip, Widths(col) - cLineWidth) v.Width = w If col > 0 Then v.Left = Header.GetView(col - 1).Left + Widths(col - 1) End If Next mFirstColumnsWidth = 0 HeaderFirst.Width = 0 SVF.Width = 0 Header.Width = Header.GetView(Widths.Length - 1).Left + Widths(Widths.Length - 1) SV2.Panel.Width = Header.Width SV2.Left = 0 SV2.Width = cWidth Header.Left = 0 SV2.HorizontalScrollPosition = 0 Dim lbls() As Label For row = 0 To visibleRows.Size - 1 lbls = visibleRows.GetValueAt(row) For col = 0 To lbls.Length - 1 lbls(col).SetLayout(Header.GetView(col).Left, lbls(col).Top, Header.GetView(col).Width, cRowHeight - cLineWidth) Next Next Else 'mNumberOfFixedColumns > 0 New Private v As View Private w, wt As Int Private Left As Int Left = 0 For col = 0 To mNumberOfFixedColumns - 1 Private v As View v = HeaderFirst.GetView(col) w = Max(2dip, Widths(col) - cLineWidth) v.Width = w wt = wt + w v.Left = Left Left = HeaderFirst.GetView(col).Left + HeaderFirst.GetView(col).Width + cLineWidth Next mFirstColumnsWidth = Left HeaderFirst.Width = wt + 3 * cLineWidth SVF.Width = HeaderFirst.Width SV2.Left = HeaderFirst.Width SV2.Width = cWidth - HeaderFirst.Width Private Left, col_x As Int Left = 0 For col = mNumberOfFixedColumns To Widths.Length - 1 Private v As View col_x = col - mNumberOfFixedColumns v = Header.GetView(col_x) w = Max(2dip, Widths(col) - cLineWidth) v.Width = w v.Left = Left Left = Left + Header.GetView(col_x).Width + cLineWidth Next Header.Width = Left Header.Left = -SV2.HorizontalScrollPosition + mFirstColumnsWidth SV2.Panel.Width = Header.Width Header.Left = mFirstColumnsWidth SV2.HorizontalScrollPosition = 0 Dim lbls() As Label For row = 0 To visibleRows.Size - 1 lbls = visibleRows.GetValueAt(row) Left = 0 For col = 0 To mNumberOfFixedColumns - 1 lbls(col).SetLayout(Left, lbls(col).Top, Widths(col), cRowHeight - cLineWidth) Left = HeaderFirst.GetView(col).Left + HeaderFirst.GetView(col).Width + cLineWidth Next Left = 0 For col = mNumberOfFixedColumns To lbls.Length - 1 col_x = col - mNumberOfFixedColumns lbls(col).SetLayout(Left, lbls(col).Top, Header.GetView(col_x).Width, cRowHeight - cLineWidth) Left = Left + Header.GetView(col_x).Width + cLineWidth Next Next End If lblStatusLine.Width = Header.Width internalPanel.Width = Header.Width End Sub '>>> added 13/08/2019 '-------------------- Public Sub GetColumnName(iCol As Int) As String Dim lstHeaders As List Dim strColumnName As String lstHeaders = TableObject.HeaderNames If iCol = -1 Then strColumnName = lstHeaders.Get(iLastSelectedColumn) Else strColumnName = lstHeaders.Get(iCol) End If Return strColumnName End Sub Public Sub GetColumnWidths As Int() Return SavedWidths End Sub Public Sub GetColumnWidth(iCol As Int) As Int If iCol = -1 Then Return SavedWidths(iLastSelectedColumn) Else Return SavedWidths(iCol) End If End Sub Private Sub innerClearAll(vNumberOfColumns As Int, ClearData As Boolean) SelectedRows.Initialize SV2.Panel.RemoveAllViews SVF.Panel.RemoveAllViews mNumberOfColumns = vNumberOfColumns Dim Drawable1(mNumberOfColumns) As Object Dim Drawable2(mNumberOfColumns) As Object Dim SelectedDrawable(mNumberOfColumns) As Object Dim cAlignments(mNumberOfColumns) As Int Dim cHeaderAlignments(mNumberOfColumns) As Int Dim cTypeFaces(mNumberOfColumns) As Typeface Dim cHeaderTypeFaces(mNumberOfColumns) As Typeface If cUseColumnColors = False Then If lstRowColors.Size > 0 Then For i = 0 To lstRowColors.Size - 1 Private cds(mNumberOfColumns) As Object Private color = lstRowColors.Get(i) As Int For col = 0 To mNumberOfColumns - 1 Private cdi As ColorDrawable cdi.Initialize(color, 0) cds(col) = cdi Next lstRowDrawables.Add(cds) Next End If For i = 0 To mNumberOfColumns - 1 Dim cd1, cd2, cd3 As ColorDrawable cd1.Initialize(cRowColor1, 0) cd2.Initialize(cRowColor2, 0) cd3.Initialize(cSelectedRowColor, 0) Drawable1(i) = cd1 Drawable2(i) = cd2 SelectedDrawable(i) = cd3 If MultiAlignments = False Or cAlignments0.Length < mNumberOfColumns Then cAlignments(i) = cAlignment Else cAlignments(i) = cAlignments0(i) End If If MultiTypeFace = False Or cTypeFaces0.Length < mNumberOfColumns Then cTypeFaces(i) = cTypeFace Else cTypeFaces(i) = cTypeFaces0(i) End If If HeaderMultiAlignments = False Or cHeaderAlignments0.Length < mNumberOfColumns Then cHeaderAlignments(i) = cHeaderAlignment Else cHeaderAlignments(i) = cHeaderAlignments0(i) End If If HeaderMultiTypeFace = False Or cHeaderTypeFaces0.Length < mNumberOfColumns Then cHeaderTypeFaces(i) = cHeaderTypeFace Else cHeaderTypeFaces(i) = cHeaderTypeFaces0(i) End If Next Else For i = 0 To mNumberOfColumns - 1 Private cd1, cd2, cd3 As ColorDrawable cd1.Initialize(cColumnColors(i), 0) cd2.Initialize(cColumnColors(i), 0) cd3.Initialize(cSelectedRowColor, 0) Drawable1(i) = cd1 Drawable2(i) = cd2 SelectedDrawable(i) = cd3 If MultiAlignments = False Or cAlignments0.Length < mNumberOfColumns Then cAlignments(i) = cAlignment Else cAlignments(i) = cAlignments0(i) End If If MultiTypeFace = False Or cTypeFaces0.Length < mNumberOfColumns Then cTypeFaces(i) = cTypeFace Else cTypeFaces(i) = cTypeFaces0(i) End If If HeaderMultiAlignments = False Or cHeaderAlignments0.Length < mNumberOfColumns Then cHeaderAlignments(i) = cHeaderAlignment Else cHeaderAlignments(i) = cHeaderAlignments0(i) End If If HeaderMultiTypeFace = False Or cHeaderTypeFaces0.Length < mNumberOfColumns Then cHeaderTypeFaces(i) = cHeaderTypeFace Else cHeaderTypeFaces(i) = cHeaderTypeFaces0(i) End If Next End If Dim cd4 As ColorDrawable cd4.Initialize(cSelectedCellColor, 0) SelectedCellDrawable = cd4 SV2.Panel.Height = 0 SVF.Panel.Height = 0 SelectedCol = -1 minVisibleRow = -1 maxVisibleRow = 0 If ClearData = True Then Data.Initialize End If LabelsCache.Initialize visibleRows.Initialize SV2.VerticalScrollPosition = 0 SVF.ScrollPosition = 0 For i = 1 To 80 'fill the cache to avoid delay on the first touch LabelsCache.Add(CreateNewLabels) Next If IsVisible Then SV2_ScrollChanged(0, 0) SVF_ScrollChanged(0) End If If (lblStatusLine.IsInitialized And enableStatusLineAutoFill = True) Then setStatusLine(Data.Size & " rows") ' should this be automatic ? End Sub Private Sub SVF_ScrollChanged(Position As Int) SVFScrolls = True If SV2Scrolls = False Then Scroll(SV2PosX, Position) SV2.VerticalScrollPosition = Position End If SVFScrolls = False End Sub Private Sub SV2_ScrollChanged(PosX As Int, PosY As Int) SV2Scrolls = True If SVFScrolls = False Then Scroll(PosX, PosY) SV2PosX = PosX SVF.ScrollToNow(PosY) End If SV2Scrolls = False End Sub Private Sub Scroll(PosX As Int, PosY As Int) Dim i As Int Dim currentMin As Int Dim currentMax As Int currentMin = Max(0, PosY / cRowHeight - 30) currentMax = Min(Data.Size - 1, (PosY + SV2.Height) / cRowHeight + 30) If minVisibleRow > -1 Then If minVisibleRow < currentMin Then 'need to hide the upper rows For i = minVisibleRow To Min(currentMin - 1, maxVisibleRow) HideRow(i) Next Else If minVisibleRow > currentMin Then 'need to show the upper rows For i = currentMin To Min(minVisibleRow - 1, currentMax) ShowRow(i) Next End If If maxVisibleRow > currentMax Then 'need to hide the lower rows For i = maxVisibleRow To Max(currentMax + 1, minVisibleRow) Step -1 HideRow(i) Next Else If maxVisibleRow < currentMax Then 'need to show the lower rows For i = currentMax To Max(maxVisibleRow + 1, currentMin) Step -1 ShowRow(i) Next End If End If minVisibleRow = currentMin maxVisibleRow = currentMax Header.Left = -PosX + mFirstColumnsWidth lblStatusLine.Left = - PosX End Sub 'Adds a row to the table 'Example:Table1.AddRow(Array As String("aaa", "ccc", "ddd", "eee")) Public Sub AddRow(Values() As String) If Values.Length <> mNumberOfColumns Then Log("Wrong number of values =" & Values.Length & " col=" & mNumberOfColumns) Return End If Data.Add(Values) lstRowColorIndexes.Add(0) Dim lastRow As Int lastRow = Data.Size - 1 If lastRow < (SV2.VerticalScrollPosition + SV2.Height) / cRowHeight + 1 Then ShowRow(lastRow) End If 'RBS: 01/12/2022 moved these 3 lines to the end of ShowRow ' SV2.Panel.Height = Data.Size * cRowHeight ' SVF.Panel.Height = SV2.Panel.Height ' updateIPLocation If cShowStatusLine Then 'RBS added 01/12/2022, leaving this off seriously can slow down the loading of the table! If (lblStatusLine.IsInitialized And enableStatusLineAutoFill) Then setStatusLine(Data.Size & " rows") ' should this be automatic ? End If End Sub 'Adds a row to the table with automatic widths 'Example:Table1.AddRow(Array As String("aaa", "ccc", "ddd", "eee")) Public Sub AddRowAutomaticWidth(Values() As String) If Values.Length <> mNumberOfColumns Then Log("Wrong number of values =" & Values.Length & " col=" & mNumberOfColumns) Return End If Dim i As Int Data.Add(Values) Dim lastRow As Int lastRow = Data.Size - 1 Dim changed = False As Boolean Dim width As Int For i = 0 To mNumberOfColumns - 1 If MultiTypeFace = False Then width = cvs.MeasureStringWidth(Values(i), cTypeFace, cTextSize) + ExtraWidth Else width = cvs.MeasureStringWidth(Values(i), cTypeFaces(i), cTextSize) + ExtraWidth End If If ColumnWidths(i) < width Then ColumnWidths(i) = width SavedWidths(i) = width HeaderWidths(i) = width DataWidths(i) = width changed = True End If Next If changed = True Then SetColumnsWidths(ColumnWidths) End If If lastRow < (SV2.VerticalScrollPosition + SV2.Height) / cRowHeight + 1 Then ShowRow(lastRow) End If SV2.Panel.Height = Data.Size * cRowHeight SVF.Panel.Height = SV2.Panel.Height updateIPLocation If (lblStatusLine.IsInitialized And enableStatusLineAutoFill=True) Then setStatusLine(Data.Size & " rows") ' should this be automatic ? End Sub ' draw a Row, now col is hidden (width <2) Private Sub ShowRow(Row As Int) Private i As Int If visibleRows.ContainsKey(Row) Then Return Dim lbls() As Label Dim values() As String lbls = GetLabels(Row) values = Data.get(Row) visibleRows.Put(Row, lbls) Dim rowColor() As Object Private txtColor As Int If (SelectedRows.indexof(Row) <> -1 )Then rowColor = SelectedDrawable txtColor = cSelectedRowTextColor Else If lstRowColorIndexes.Get(Row) > 1 Then rowColor = lstRowDrawables.Get(lstRowColorIndexes.Get(Row) - 2) txtColor = GetContrastColor(lstRowColors.Get(lstRowColorIndexes.Get(Row) - 2)) Else If Row Mod 2 = 0 Then rowColor = Drawable1 txtColor = cTextColor Else rowColor = Drawable2 txtColor = cTextColor End If End If If iAlteredTextColour = -1 And iAlteredRowColour = -1 And bItalicRows = False Then 'normal situation with no altered colours and no rows with italic font '--------------------------------------------------------------------- If mNumberOfFixedColumns = 0 Then For i = 0 To lbls.Length - 1 If (Header.GetView(I).Width > 1 ) Then SV2.Panel.AddView(lbls(i), Header.GetView(I).Left, Row * cRowHeight, Header.GetView(I).Width, cRowHeight - cLineWidth) lbls(i).Text = values(i) lbls(i).TextColor = txtColor If i = SelectedCol And (SelectedRows.indexof(Row) <> -1) Then lbls(i).TextColor = cSelectedCellTextColor lbls(i).Background = SelectedCellDrawable Else lbls(i).TextColor = txtColor lbls(i).Background = rowColor(i) End If If MultiAlignments = False Then lbls(i).Gravity = cAlignment Else lbls(i).Gravity = cAlignments(i) End If End If Next Else 'mNumberOfFixedColumns > 0 For i = 0 To lbls.Length - 1 If i < mNumberOfFixedColumns Then SVF.Panel.AddView(lbls(i), HeaderFirst.GetView(i).Left, Row * cRowHeight, HeaderFirst.GetView(i).Width, cRowHeight - cLineWidth) lbls(i).Text = values(i) lbls(i).TextColor = txtColor If i = SelectedCol And (SelectedRows.indexof(Row) <> -1) Then lbls(i).TextColor = cSelectedCellTextColor lbls(i).Background = SelectedCellDrawable Else lbls(i).TextColor = txtColor lbls(i).Background = rowColor(i) End If If MultiAlignments = False Then lbls(i).Gravity = cAlignment Else lbls(i).Gravity = cAlignments(i) End If Else Private i_1 As Int i_1 = i - mNumberOfFixedColumns If (Header.GetView(i_1).Width > 1 ) Then SV2.Panel.AddView(lbls(i), Header.GetView(i_1).Left, Row * cRowHeight, Header.GetView(i_1).Width, cRowHeight - cLineWidth) lbls(i).Text = values(i) lbls(i).TextColor = txtColor If i = SelectedCol And (SelectedRows.indexof(Row) <> -1) Then lbls(i).TextColor = cSelectedCellTextColor lbls(i).Background = SelectedCellDrawable Else lbls(i).TextColor = txtColor lbls(i).Background = rowColor(i) End If If MultiAlignments = False Then lbls(i).Gravity = cAlignment Else lbls(i).Gravity = cAlignments(i) End If End If End If Next End If Else 'If iAlteredTextColour = -1 And iAlteredRowColour = -1 And bItalicRows = False If mNumberOfFixedColumns = 0 Then For i = 0 To lbls.Length - 1 If (Header.GetView(I).Width > 1 ) Then SV2.Panel.AddView(lbls(i), Header.GetView(I).Left, Row * cRowHeight, Header.GetView(I).Width, cRowHeight - cLineWidth) lbls(i).Text = values(i) lbls(i).TextColor = txtColor If i = SelectedCol And (SelectedRows.indexof(Row) <> -1) Then 'so selected cells remain as they were '------------------------------------- lbls(i).TextColor = cSelectedCellTextColor lbls(i).Background = SelectedCellDrawable Else If iAlteredTextColour <> -1 And arrAlteredRowTextColour2(Row) Then lbls(i).TextColor = iAlteredTextColour Else lbls(i).TextColor = txtColor End If If iAlteredRowColour <> -1 And arrAlteredRowColour2(Row) Then lbls(i).Color = iAlteredRowColour Else lbls(i).Background = rowColor(i) End If If bItalicRows And arrAlterRowsItalic2(Row) Then lbls(i).Typeface = tfItalic Else lbls(i).Typeface = Typeface.DEFAULT End If End If If MultiAlignments = False Then lbls(i).Gravity = cAlignment Else lbls(i).Gravity = cAlignments(i) End If End If Next Else 'mNumberOfFixedColumns = 0 For i = 0 To lbls.Length - 1 If i < mNumberOfFixedColumns Then SVF.Panel.AddView(lbls(i), HeaderFirst.GetView(i).Left, Row * cRowHeight, HeaderFirst.GetView(i).Width, cRowHeight - cLineWidth) lbls(i).Text = values(i) lbls(i).TextColor = txtColor If i = SelectedCol And (SelectedRows.indexof(Row) <> -1) Then lbls(i).TextColor = cSelectedCellTextColor lbls(i).Background = SelectedCellDrawable Else If iAlteredTextColour <> -1 And arrAlteredRowTextColour2(Row) Then lbls(i).TextColor = iAlteredTextColour Else lbls(i).TextColor = txtColor End If If iAlteredRowColour <> -1 And arrAlteredRowColour2(Row) Then lbls(i).Color = iAlteredRowColour Else lbls(i).Background = rowColor(i) End If If bItalicRows And arrAlterRowsItalic2(Row) Then lbls(i).Typeface = tfItalic Else lbls(i).Typeface = Typeface.DEFAULT End If End If If MultiAlignments = False Then lbls(i).Gravity = cAlignment Else lbls(i).Gravity = cAlignments(i) End If Else Private i_1 As Int i_1 = i - mNumberOfFixedColumns If (Header.GetView(i_1).Width > 1 ) Then SV2.Panel.AddView(lbls(i), Header.GetView(i_1).Left, Row * cRowHeight, Header.GetView(i_1).Width, cRowHeight - cLineWidth) lbls(i).Text = values(i) lbls(i).TextColor = txtColor If i = SelectedCol And (SelectedRows.indexof(Row) <> -1) Then lbls(i).TextColor = cSelectedCellTextColor lbls(i).Background = SelectedCellDrawable Else If iAlteredTextColour <> -1 And arrAlteredRowTextColour2(Row) Then lbls(i).TextColor = iAlteredTextColour Else lbls(i).TextColor = txtColor End If If iAlteredRowColour <> -1 And arrAlteredRowColour2(Row) Then lbls(i).Color = iAlteredRowColour Else lbls(i).Background = rowColor(i) End If If bItalicRows And arrAlterRowsItalic2(Row) Then lbls(i).Typeface = tfItalic Else lbls(i).Typeface = Typeface.DEFAULT End If End If If MultiAlignments = False Then lbls(i).Gravity = cAlignment Else lbls(i).Gravity = cAlignments(i) End If End If End If Next End If End If '02/12/2022 moved to here from AddRow SV2.Panel.Height = Data.Size * cRowHeight SVF.Panel.Height = SV2.Panel.Height updateIPLocation End Sub 'added 28/03/2021 Public Sub GetFirstVisibleRow() As Int Dim i As Int For i = 0 To TableObject.Size - 1 If IsRowVisible(i) Then Return i - 1 End If Next Return -1 End Sub 'added 28/03/2021 Public Sub GetLastVisibleRow() As Int Dim i As Int For i = TableObject.Size - 1 To 0 Step -1 If IsRowVisible(i) Then Return i - 1 End If Next Return -1 End Sub Private Sub IsRowVisible(Row As Int) As Boolean 'ignore Return Row < (SV2.VerticalScrollPosition + SV2.Height) / (cRowHeight + 1) And _ Row > SV2.VerticalScrollPosition / cRowHeight End Sub Private Sub HideRow (Row As Int) Dim i As Long Dim lbls() As Label lbls = visibleRows.get(Row) If lbls = Null Then Return End If For i = 0 To lbls.Length - 1 lbls(i).RemoveView Next visibleRows.Remove(Row) LabelsCache.Add(lbls) End Sub Private Sub GetLabels(Row As Int) As Label() Dim i As Long Dim lbls() As Label If LabelsCache.Size > 0 Then lbls = LabelsCache.get(LabelsCache.Size - 1) LabelsCache.RemoveAt(LabelsCache.Size - 1) Else lbls = CreateNewLabels End If For i = 0 To lbls.Length - 1 Dim rc As RowCol rc = lbls(i).Tag rc.Row = Row Next Return lbls End Sub Public Sub CreateNewLabels As Label() Dim i As Int Dim lbls(mNumberOfColumns) As Label For i = 0 To mNumberOfColumns - 1 Dim rc As RowCol rc.Col = i Dim L As Label L.Initialize("Cell") L.TextSize = cTextSize If cUseColumnColors = False Then L.TextColor = cTextColor Else L.TextColor = cTextColors(i) End If If MultiTypeFace = False Then L.Typeface = cTypeFace Else L.Typeface = cTypeFaces(i) End If SetPadding(L, 4dip, 2dip, 4dip, 2dip) L.SingleLine = cSingleLine L.Tag = rc lbls(i) = L L.Tag = rc lbls(i) = L Next Return lbls End Sub 'Set the headers values 'Example:Table1.SetHeader(Array As String("Col1", "Col2", "Col3")) Public Sub SetHeader(Values() As String) Dim col As Int Header.RemoveAllViews HeaderNames.Initialize2(Values) Dim Left = 0 As Int ' Dim Left = cLineWidth As Int Dim Change = 0 As Int Dim w As Int For col = 0 To mNumberOfColumns - 1 Dim L As Label L.Initialize("header") If HeaderMultiAlignments = False Then L.Gravity = cHeaderAlignment Else L.Gravity = cHeaderAlignments(col) End If If HeaderMultiTypeFace = False Then L.Typeface = cHeaderTypeFace Else L.Typeface = cHeaderTypeFaces(col) End If L.TextSize = cTextSize SetPadding(L, 4dip, 2dip, 4dip, 2dip) If cUseColumnColors = False Then L.Color = cHeaderColor L.TextColor = cHeaderTextColor Else L.Color = cHeaderColors(col) L.TextColor = cHeaderTextColors(col) End If L.Text = Values(col) L.Tag = col w = Max(2dip, ColumnWidths(col) - cLineWidth) ' needed to make sure that the width has value >0 Header.AddView(L, Left, 0, w, cHeaderHeight) If cAutomaticWidths = True Then If Values(col).Contains(CRLF) Then Dim str() As String Dim j As Int str = Regex.Split(CRLF, Values(col)) HeaderWidths(col) = cvs.MeasureStringWidth(str(0), L.Typeface, cTextSize) + ExtraWidth For j = 1 To str.Length - 1 HeaderWidths(col) = Max(HeaderWidths(col),cvs.MeasureStringWidth(str(j), L.Typeface, cTextSize) + ExtraWidth) Next Else HeaderWidths(col) = cvs.MeasureStringWidth(Values(col), L.Typeface, cTextSize) + ExtraWidth End If If HeaderWidths(col) > ColumnWidths(col) Then Change = 1 ColumnWidths(col) = Max(HeaderWidths(col), ColumnWidths(col)) Else If ColumnWidths(col) > HeaderWidths(col) And ColumnWidths(col) > DataWidths(col) Then Change = 1 ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If End If Left = Left + ColumnWidths(col) Next If Change = 1 Then SetColumnsWidths(ColumnWidths) End If Header.Left = - SV2.HorizontalScrollPosition End Sub Private Sub Cell_Click Dim rc As RowCol Dim L As Label L = Sender rc = L.Tag iLastSelectedRow = rc.Row iLastSelectedColumn = rc.Col SelectRow(rc) '>>>> added 13/08/2019 '--------------------- If SubExists(cCallBack, "tbl_Cell_Click") Then CallSub3("Main", "tbl_Cell_Click", TableObject, rc) Else CallSub3(cCallBack, cEventName & "_Cell_Click", rc.Col, rc.Row) End If End Sub Private Sub Cell_LongClick Dim rc As RowCol Dim L As Label L = Sender rc = L.Tag '>>>> added 13/08/2019 '--------------------- CallSub3("Main", "tbl_Cell_LongClick", TableObject, rc) End Sub Private Sub Header_LongClick Dim L As Label Dim col As Int L = Sender col = L.Tag If SubExists(cCallBack, cEventName & "_HeaderLongClick") Then CallSub2(cCallBack, cEventName & "_HeaderLongClick", col) End If End Sub 'added 28/09/2018 '---------------- Public Sub GetLastSelectedRow() As Int Return iLastSelectedRow End Sub 'added 28/09/2018 '---------------- Public Sub GetLastSelectedColumn() As Int Return iLastSelectedColumn End Sub Public Sub GetRowNumberIfValue(iCol As Int, strValue As String) As Int Dim i As Int Dim values() As String For i = 0 To Data.Size - 1 values = Data.get(i) If values(iCol) = strValue Then Return i End If Next Return -1 End Sub 'Gets the value of the given cell. Public Sub GetValue(Col As Int, Row As Int) As String Dim values() As String values = Data.get(Row) Return values(Col) End Sub Public Sub GetMultipleValues(Col As Int, iValue As Int) As Map Dim i As Int Dim values() As String Dim lstRows As List Dim mapValues As Map lstRows = getSelectedRows mapValues.Initialize For i = 0 To lstRows.Size - 1 values = Data.get(lstRows.Get(i)) mapValues.Put(values(Col), iValue) Next Return mapValues End Sub 'Sets the value of the given cell. Public Sub SetValue(Col As Int, Row As Int, Value As String) Dim values() As String values = Data.get(Row) values(Col) = Value If visibleRows.ContainsKey(Row) Then Dim lbls() As Label lbls = visibleRows.get(Row) lbls(Col).Text = Value End If End Sub Public Sub SelectRow(rc As RowCol) If Not(cAllowSelection) Then Return Dim prevIndex As Int Dim prev As Int ' if we select an alreday selected row, prev will be rc.row, else will be -1 prevIndex = SelectedRows.indexof(rc.Row) ' -1 if selecting not a selected row If (prevIndex <> -1 And mMultiSelect = False) Then ' if mMultiSelectt = True no column change, only if mMultiSelectt = False SelectedCol = rc.col If visibleRows.ContainsKey(rc.Row) Then HideRow(rc.Row) ShowRow(rc.Row) End If If mZeroSelection = False Then Return End If End If If (prevIndex = -1) Then If (mMultiSelect) Then SelectedRows.Add(rc.Row) 'Select the new row prev = -1 Else ' set selected to the new one ' hide / show all selected rows If (SelectedRows.Size <> 0) Then prev = SelectedRows.get(0) ' there should be only one here ever!!!, keep the unselected row in prev SelectedRows.set(0, rc.Row) ' change it to the new one Else prev = -1 SelectedRows.Add(rc.Row) End If End If Else ' multi select and found a row (unselect it) prev = SelectedRows.get(prevIndex) ' should be RC.row SelectedRows.RemoveAt(prevIndex) ' deselect the old selected row End If 'remove the color of previously selected row If prev > -1 Then If visibleRows.ContainsKey(rc.Row) Then HideRow(prev) ShowRow(prev) End If End If SelectedCol = rc.col If visibleRows.ContainsKey(rc.Row) Then HideRow(rc.Row) ShowRow(rc.Row) End If End Sub Public Sub UnselectAllRows Dim i As Int Dim iRowIDX As Int Dim lstSelectedRows As List lstSelectedRows = TableObject.SelectedRows For i = lstSelectedRows.Size - 1 To 0 Step -1 iRowIDX = lstSelectedRows.Get(i) TableObject.UnselectRow(iRowIDX) Next End Sub 'Unselects the row for the given index Public Sub UnselectRow(Row As Int) If Not(cAllowSelection) Then Return Dim prevIndex As Int prevIndex = SelectedRows.indexof(Row) ' -1 if selecting not a selected row If prevIndex > -1 Then ' if mMultiSelect = True no column change, only if mMultiSelect = False SelectedCol = -1 SelectedRows.RemoveAt(prevIndex) If visibleRows.ContainsKey(Row) Then HideRow(Row) ShowRow(Row) End If End If End Sub 'Makes the given row visible. Public Sub JumpToRow(Row As Int) Sleep(0) SV2.VerticalScrollPosition = Row * cRowHeight End Sub 'Makes the given row visible and set it's row and colum as selected. Public Sub JumpToRowAndSelect(Col As Int, Row As Int) 'Log("JumpToRowAndSelect, Col: " & Col & ", Row: " & Row) 'Log("You may get this warning:") 'Log("Unexpected event (missing RaiseSynchronousEvents): sv_scrollchanged") 'Log("Ignore it, it is NOT harmful !") Dim rc As RowCol rc.Row = Row rc.Col = Col SelectRow(rc) Sleep(0) SV2.VerticalScrollPosition = Row * cRowHeight Private i, Left As Int If Col > 0 Then For i = 0 To Col - 1 Left = Left + ColumnWidths(i) Next End If SV2.HorizontalScrollPosition = Left End Sub 'Clears the previous table and loads the CSV file to the table. 'You should first add the Table to the activity before calling this method. Public Sub LoadTableFromCSV(Dir As String, Filename As String, HeadersExist As Boolean) Dim i As Int Dim List1 As List Dim h() As String bMap = False cAutomaticWidths = False If HeadersExist Then Dim headers As List List1 = StringUtils1.LoadCSV2(Dir, Filename, ",", headers) Dim h(headers.Size) As String For i = 0 To headers.Size - 1 h(i) = headers.get(i) Next Else List1 = StringUtils1.LoadCSV(Dir, Filename, ",") Dim firstRow() As String firstRow = List1.get(0) Dim h(firstRow.Length) As String For i = 0 To firstRow.Length - 1 h(i) = "Col" & (i + 1) Next End If innerClearAll(h.Length, True) Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String For i = 0 To mNumberOfColumns - 1 cColumnDataType(i) = "TEXT" ColumnWidths(i) = SV2.Width / mNumberOfColumns HeaderWidths(i) = ColumnWidths(i) DataWidths(i) = ColumnWidths(i) Next SetHeader(h) SetColumnsWidths(ColumnWidths) For i = 0 To List1.Size - 1 Dim Row() As String Row = List1.get(i) AddRow(Row) Next End Sub 'Clears the previous table and loads the CSV file to the table. 'You should first add the Table to the activity before calling this method. 'This method allows to set the separator character and automatic widht calculation. 'Example: 'Table1.LoadTableFromCSV2(File.DirAssets, "citylist.csv", True, ";", True) Public Sub LoadTableFromCSV2(Dir As String, Filename As String, HeadersExist As Boolean, SeparatorChar As String, AutomaticWidths As Boolean) Dim List1 As List Dim h() As String Dim Col As Int Dim Row As Int bMap = False cAutomaticWidths = AutomaticWidths If HeadersExist Then Dim headers As List List1 = StringUtils1.LoadCSV2(Dir, Filename, SeparatorChar, headers) Dim h(headers.Size) As String For i = 0 To headers.Size - 1 h(i) = headers.get(i) Next Else List1 = StringUtils1.LoadCSV(Dir, Filename, SeparatorChar) Dim firstRow() As String firstRow = List1.get(0) Dim h(firstRow.Length) As String For i = 0 To firstRow.Length - 1 h(i) = "Col" & (i + 1) Next End If innerClearAll(h.Length, True) Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String SetArrColumnsSorted(mNumberOfColumns) 'to keep track of the columns that have been sorted so have the sort types set iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) Dim arrAlteredRowColour2(mNumberOfColumns) As Boolean If iAlteredRowColour <> -1 Then arrAlteredRowColour = General.mapArrAlteredRowColour.Get(TableObject.Panel.Tag) For i = 0 To mNumberOfColumns - 1 arrAlteredRowColour2(i) = arrAlteredRowColour(i) Next End If Dim arrAlteredRowTextColour2(Data.Size) As Boolean If iAlteredTextColour <> -1 Then arrAlteredRowTextColour = General.mapArrAlteredRowTextColour.Get(TableObject.Panel.Tag) For i = 0 To Data.Size - 1 arrAlteredRowTextColour2(i) = arrAlteredRowTextColour(i) Next End If If AutomaticWidths = False Then For Col = 0 To mNumberOfColumns - 1 cColumnDataType(Col) = "TEXT" ColumnWidths(Col) = SV2.Width / mNumberOfColumns HeaderWidths(Col) = ColumnWidths(Col) DataWidths(Col) = ColumnWidths(Col) Next Else If HeadersExist Then Dim strRow(mNumberOfColumns) As String strRow = List1.get(Col) If HeaderMultiTypeFace = False Then For Col = 0 To mNumberOfColumns - 1 HeaderWidths(Col) = cvs.MeasureStringWidth(headers.get(Col), cHeaderTypeFace, cTextSize) + ExtraWidth Next Else For Col = 0 To mNumberOfColumns - 1 HeaderWidths(Col) = cvs.MeasureStringWidth(headers.get(Col), cHeaderTypeFaces(Col), cTextSize) + ExtraWidth Next End If End If Dim arrColMaxStringlen(mNumberOfColumns) As String For Row = 0 To List1.Size - 1 Dim arrRow(mNumberOfColumns) As String arrRow = List1.get(Row) ' For Col = 0 To mNumberOfColumns - 1 ' DataWidths(Col) = Max(DataWidths(Col), cvs.MeasureStringWidth(arrRow(Col), Typeface.DEFAULT, cTextSize) + ExtraWidth) ' Next For Col = 0 To mNumberOfColumns - 1 If arrRow(Col).Length > arrColMaxStringlen(Col).length Then arrColMaxStringlen(Col) = arrRow(Col) End If Next Next For Col = 0 To mNumberOfColumns - 1 DataWidths(Col) = cvs.MeasureStringWidth(arrColMaxStringlen(Col), Typeface.DEFAULT, cTextSize) + ExtraWidth Next For Col = 0 To mNumberOfColumns - 1 cColumnDataType(Col) = "TEXT" ColumnWidths(Col) = Max(HeaderWidths(Col), DataWidths(Col)) Next End If SetHeader(h) SetColumnsWidths(ColumnWidths) For i = 0 To List1.Size - 1 Dim strRow() As String strRow = List1.get(i) AddRow(strRow) Next End Sub 'Saves the table to a CSV file. Public Sub SaveTableToCSV(Dir As String, Filename As String) Dim headers(mNumberOfColumns) As String For i = 0 To headers.Length - 1 Dim L As Label L = Header.GetView(i) headers(i) = L.Text Next StringUtils1.SaveCSV2(Dir, Filename, ",", Data, headers) End Sub 'Saves the table to a CSV file with a given separator character. Public Sub SaveTableToCSV2(Dir As String, Filename As String, SeparatorChar As String) Dim headers(mNumberOfColumns) As String For i = 0 To headers.Length - 1 Dim L As Label L = Header.GetView(i) headers(i) = L.Text Next StringUtils1.SaveCSV2(Dir, Filename, SeparatorChar, Data, headers) End Sub ' new functunality added by nir --> ' remove a row 'row is the row number Public Sub RemoveRow(Row As Int) If (Row <0 Or Row > Data.Size-1) Then Return ' cant remove row outside of the table scope SV2_ScrollChanged(SV2.HorizontalScrollPosition,SV2.VerticalScrollPosition) ' this strange call will set min/max visible area 'Dim sr As Int ' to keep the previos selected row (in case mMultiSelect is off) 'sr = -1 ' not the selected row Dim prevIndex As Int prevIndex = SelectedRows.IndexOf(Row) ' if the rmeoved one was selected or not/ For i=0 To SelectedRows.Size -1 ' updated selection Dim keepSel As Int keepSel = SelectedRows.get(i) If (keepSel > Row) Then SelectedRows.set(i,keepSel-1) ' dec row number in all rows appear after the soon tobe removed removed row ' future optimization: hide and show all rows touched and that within visible range, for now we hide/show all rows in visible scope End If Next If (prevIndex <> -1) Then 'sr = Row ' in case the row was selected keep it in sr SelectedRows.RemoveAt(prevIndex) ' removed the current row from the selected list End If Data.RemoveAt(Row) lstRowColorIndexes.RemoveAt(Row) For i = minVisibleRow To maxVisibleRow ' hide all visible rows HideRow(i) Next If Data.Size > 0 Then maxVisibleRow = Min(maxVisibleRow, Data.Size - 1) ' adjust visible rows minVisibleRow = Min(minVisibleRow, Data.Size - 1) For i = minVisibleRow To maxVisibleRow ' show all visible rows (should select the ones needed to be selected as well) 'If (mMultiSelect OR sr = i) Then HideRow(i) ' in multi select we made too much mess, we need to redraw the whole view (can be optimized if needed!) ShowRow(i) Next End If SV2.Panel.Height = Data.Size * cRowHeight SVF.Panel.Height = SV2.Panel.Height updateIPLocation SV2_ScrollChanged(SV2.HorizontalScrollPosition,Min(SV2.VerticalScrollPosition, SV2.Panel.Height)) If (lblStatusLine.IsInitialized And enableStatusLineAutoFill=True) Then setStatusLine(Data.Size & " rows") ' should this be automatic ? End Sub ' return array of strings hold all the values for a row. Public Sub GetValues(Row As Int ) As String() Dim rowData() As String = Data.get(Row) ' will throw an excpetion if row is not correct Dim tmp(mNumberOfColumns) As String For i=0 To mNumberOfColumns-1 ' copy the array tmp(i) = rowData(i) Next Return tmp End Sub ' insert a new row at a specific index Public Sub insertRowAt (Row As Int, Values() As String) As Boolean If (Row < 0) Then Row = 0 If (Row > Data.Size) Then AddRow(Values) Return True End If SV2_ScrollChanged(SV2.HorizontalScrollPosition,SV2.VerticalScrollPosition) ' this strange call will set min/max visible area Dim L As List L.Initialize L.Add(Values) ' fix selection For i=0 To SelectedRows.Size -1 ' updated selection Dim keepSel As Int keepSel = SelectedRows.get(i) If (keepSel >= Row) Then SelectedRows.set(i,keepSel+1) ' dec row number in all rows appear after the soon tobe removed removed row ' future optimization: hide and show all rows touched and that within visible range, for now we hide/show all rows in visible scope End If Next For i = minVisibleRow To maxVisibleRow HideRow(i) Next Data.AddAllAt(Row,L) ' now I can add the row SV2_ScrollChanged(SV2.HorizontalScrollPosition,SV2.VerticalScrollPosition) ' this strange call will set min/max visible area For i = minVisibleRow To maxVisibleRow ShowRow(i) Next SV2.Panel.Height = Data.Size * cRowHeight SVF.Panel.Height = SV2.Panel.Height updateIPLocation SV2_ScrollChanged(SV2.HorizontalScrollPosition,Min(SV2.VerticalScrollPosition, SV2.Panel.Height)) If (lblStatusLine.IsInitialized And enableStatusLineAutoFill = True) Then setStatusLine(Data.Size & " rows") ' should this be automatic ? Return False End Sub ' update a row in the table ' row is the row number to update, Values is an array of string at the size of the number of columns ' return true if worked out, false if failed Public Sub UpdateRow(Row As Int, Values () As String) As Boolean Dim i As Int If (Values.Length <> mNumberOfColumns Or Row <0 Or Row>Data.Size-1) Then Return False End If For i=0 To Values.Length-1 SetValue(i,Row,Values(i)) Next Return True End Sub ' update a cell in the table ' col is the columne index and row is the row index of the cell to update, Value is the cell content string ' return true if worked out, false if failed Public Sub UpdateCell(Col As Int, Row As Int, Value As String) As Boolean If (Col < 0 Or Col > mNumberOfColumns - 1 Or Row < 0 Or Row > Data.Size-1) Then Return False End If SetValue(Col, Row, Value) Return True End Sub Public Sub clearSelection SelectedRows.Clear RefreshTable End Sub Private Sub GetVisibleRows(PosY As Int) 'ignore warning minVisibleRow = Max(0, PosY / cRowHeight - 30) maxVisibleRow = Min(Data.Size - 1, (PosY + SV2.Height) / cRowHeight + 30) End Sub ' refresh / redraw the visible part of the table Public Sub RefreshTable SV2_ScrollChanged(SV2.HorizontalScrollPosition,SV2.VerticalScrollPosition) ' this strange call will set min/max visible area For i = minVisibleRow To maxVisibleRow ' hide all visible rows HideRow(i) ShowRow(i) Next End Sub ' refresh the Labels and redraw the visible part of the table Private Sub RefreshLabels Private i, j As Int For i = minVisibleRow To maxVisibleRow ' hide all visible rows HideRow(i) Next For i = 0 To LabelsCache.Size - 1 Private lbls() As Label lbls = LabelsCache.Get(i) For j = 0 To lbls.Length - 1 If MultiTypeFace = True Then lbls(j).Typeface = cTypeFaces(j) lbls(j).TextColor = Colors.Red Else lbls(j).Typeface = cTypeFace End If Next Next For i = minVisibleRow To maxVisibleRow ' show all visible rows again ShowRow(i) Next End Sub ' return true if the table is set to multi select Public Sub GetMultiSelect As Boolean Return mMultiSelect End Sub ' set multi select flag, and clear the selected list (just in case) ' when IsMultiSelect is true, click on a not selected row will add that row to the selected list of rows, and click on an selected row will unselect it ' when IsMultiSelect is false, click on a row will select it (or reselect it if alreday selected) Public Sub setMultiSelect(bMS As Boolean) clearSelection mMultiSelect = bMS End Sub Public Sub getAllowSelection As Boolean Return cAllowSelection End Sub ' set allow selection flag, and clear the selected list (just in case) ' AllowSelection = True by default Public Sub setAllowSelection(AllowSelection As Boolean) cAllowSelection = AllowSelection If pnlTable.IsInitialized Then clearSelection End If End Sub ' return the header panel Public Sub getHeaderPanel As Panel Return Header End Sub ' return the selected row numbers as a list of int. Public Sub getSelectedRows As List Dim sr As List sr.Initialize sr.AddAll(SelectedRows) Return sr End Sub ' set column col to length '1' which means it will be hidden Public Sub hideCol(col As Int) Dim tmpWidths(SavedWidths.Length) As Int For i = 0 To SavedWidths.Length-1 tmpWidths(i) = SavedWidths(i) Next tmpWidths(col) = 1 SetColumnsWidths(tmpWidths) End Sub ' unhide column col, and give it a new size ??? Public Sub unHideCol(col As Int, newSize As Int) Dim tmpWidths(SavedWidths.Length) As Int For i=0 To SavedWidths.Length-1 tmpWidths(i) = SavedWidths(i) Next tmpWidths(col) = newSize SetColumnsWidths(tmpWidths) End Sub Private Sub IP_Click If SubExists(cCallBack, cEventName & "_HeaderClick") Then CallSub2(cCallBack, cEventName & "_HeaderClick", -1) End If End Sub ' update top/height for internalPanel Private Sub updateIPLocation If (SV2.Height > Data.Size * cRowHeight) Then internalPanel.Top = Data.Size * cRowHeight + cHeaderHeight internalPanel.Height = SV2.Height - (Data.Size * cRowHeight) Else internalPanel.Height = 0 End If End Sub Public Sub getSize As Long Return Data.Size End Sub 'Gets or sets the Table Left property Public Sub setLeft(Left As Int) cLeft = Left pnlTable.Left = Left End Sub Public Sub getLeft As Int Return pnlTable.Left End Sub 'Gets or sets the Table Left property Public Sub setTop(Top As Int) cTop = Top pnlTable.Top = Top End Sub Public Sub getTop As Int Return pnlTable.Top End Sub 'Gets or sets the Table Width property Public Sub setWidth(Width As Int) cWidth = Width pnlTable.Width = Width SV2.Width = Width internalPanel.Width = Width updateIPLocation End Sub Public Sub getWidth As Int Return pnlTable.Width End Sub 'Gets or sets the Table Height property Public Sub setHeight(Height As Int) cHeight = Height pnlTable.Height = Height If (cShowStatusLine = True) Then SV2.Height = Height - cRowHeight - cHeaderHeight Else SV2.Height = Height - cHeaderHeight End If lblStatusLine.Top = SV2.Top + SV2.Height updateIPLocation End Sub Public Sub getHeight As Int Return pnlTable.Height End Sub 'Gets or sets the Table Visible property Public Sub setVisible(Visible As Boolean) pnlTable.Visible = Visible End Sub Public Sub getVisible As Boolean Return pnlTable.Visible End Sub 'Gets or sets the grid line wisth Public Sub setLineWidth(LineWidth As Int) cLineWidth = LineWidth End Sub Public Sub getLineWidth As Int Return cLineWidth End Sub Private Sub Header_Click Dim L As Label Dim col As Int Dim bSorted As Boolean 'no point in sorting in this case '-------------------------------- If Data.Size < 2 Then Return L = Sender col = L.Tag If General.iMinSortThreshold = 0 Then General.iMinSortThreshold = 120 'seems to be fastest, tested for 12000 Long numbers End If If cSortColumn = True Then Dim dir As Int = 0 ' unsorted If (sortedCol = col) Then ' we are sorting the same col, reverse dir Select sortingDir Case 0: dir = -1 ' going up Case 1: dir = -1 Case -1: dir = 1 End Select Else dir = -1 ' start with going up End If bSorted = SortTable(col, dir <= 0) If bSorted Then ShowHeaderSorting(col, dir) sortedCol = col 'only change if a sort actually did happen sortingDir = dir 'only change if a sort actually did happen Else ShowHeaderSorting(col, 2) 'no sort done so rectangular sort icon End If End If If SubExists(cCallBack, cEventName & "_HeaderClick") Then CallSub2(cCallBack, cEventName & "_HeaderClick", col) End If End Sub Public Sub ShowHeaderSorting(col As Int, dir As Int) Dim L As Int ' calculate left Dim t As Int ' calculate top Dim oView As View Dim ParentView As Panel pnlSortingView.RemoveView If mNumberOfFixedColumns > 0 Then If col = 0 Then oView = HeaderFirst.GetView(0) ParentView = HeaderFirst Else oView = Header.GetView(col - 1) ParentView = Header End If Else oView = Header.GetView(col) ParentView = Header End If If oView.IsInitialized = False Then Return 'needed for hidden (width = 0) columns L = oView.Left + oView.Width - cSortBitmapWidth - 2dip Select Case dir Case 0 Return Case -1 pnlSortingView.SetBackgroundImage(bmpAsc) t = oView.Top + oView.Height - cSortBitmapHeight - 2dip Case 1 pnlSortingView.SetBackgroundImage(bmpDes) t = oView.Top + oView.Height - cSortBitmapHeight - 2dip 'not sure why this was -3dip Case 2 'for if no sort took place as all values where the same pnlSortingView.SetBackgroundImage(bmpEqual) t = oView.Top + oView.Height - cSortBitmapHeight - 2dip End Select ParentView.AddView(pnlSortingView, L, t, cSortBitmapWidth, cSortBitmapHeight) End Sub 'added this, so we can set the icon and tell this class the direction, if we know the order already '-------------------------------------------------------------------------------------------------- Public Sub SetSortingDir(Col As Int, dir As Int) sortedCol = Col sortingDir = dir End Sub Public Sub SetArrColumnsSorted(iColumns As Int) sortingDir = 0 ' -1, 0, 1 as asc, unsorted, desc sortedCol = -1 Dim arrDataSorted(iColumns) As Boolean Dim arrDateColumns(iColumns) As Boolean bDataTempDone = False Dim arrSortIndex() As Int mapSortingIndexes.Initialize End Sub Public Sub ResetSortColumns Dim arrSortIndex() As Int 'reset, so length = 0 If mNumberOfColumns > 0 Then Dim arrDataSorted(mNumberOfColumns) As Boolean End If iPreviousSortColumn = -1 End Sub Public Sub SortTable2(col As Int, bAscending As Boolean) As Boolean Dim i As Long Dim lUB As Long Dim arrRow() As String Dim bSorted As Boolean Dim bDoMultiColumnSort As Boolean Dim bValidArrSortIndex As Boolean lUB = Data.Size - 1 'DataTemp is a copy of Data, before any sort was done 'It is needed to produce the sort arrays (except for long dates) 'and also to put the sorted data back into Data '--------------------------------------------------------------- If bDataTempDone = False Then DataTemp.Initialize For i = 0 To lUB DataTemp.Add(Data.Get(i)) Next bDataTempDone = True End If 'setup the 1D sort array, date column is already setup in eg LoadSQLiteDB4 '------------------------------------------------------------------------- If (arrDataSorted(col) = False And arrDateColumns(col) = False) Then Select Case strColumnDataTypes(col) Case "I" Dim arrColLong(Data.Size) As Long For i = 0 To lUB arrRow = DataTemp.Get(i) Try arrColLong(i) = arrRow(col) Catch 'just do nil as QSort1DInt_IDX can cope with nulls End Try 'ignore Next Case "R" Dim arrColDouble(Data.Size) As Double For i = 0 To lUB arrRow = DataTemp.Get(i) Try arrColDouble(i) = arrRow(col) Catch 'just do nil as QSort1DDouble_IDX can cope with nulls End Try 'ignore Next Case "T" Dim arrColString(Data.size) As String For i = 0 To lUB arrRow = DataTemp.Get(i) Try arrColString(i) = arrRow(col) Catch End Try 'ignore Next Case "N" 'all values Null 'nil to do as there won't be a sort End Select End If 'determine if to do multi-column sort '------------------------------------ If arrSortIndex.Length > 0 Then If arrSortIndex(0) > -1 Then bValidArrSortIndex = True End If End If bDoMultiColumnSort = General.bMultiColumnSort And bValidArrSortIndex '------------------------ 'Get the sort index array '------------------------ If arrDataSorted(col) = False Then If arrDateColumns(col) Then If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMLongIDX2(mapLongDates.Get(col), arrSortIndex, True, -1, -1) Else arrSortIndex = cSorting.SortOMLongIDX(mapLongDates.Get(col), True, -1, -1) End If Else Select Case strColumnDataTypes(col) Case "I" If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMLongIDX2(arrColLong, arrSortIndex, bAscending, -1, -1) Else arrSortIndex = cSorting.SortOMLongIDX(arrColLong, True, -1, -1) End If Case "R" If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMDoubleIDX2(arrColDouble, arrSortIndex, True, -1, -1) Else arrSortIndex = cSorting.SortOMDoubleIDX(arrColDouble, True, -1, -1) End If Case "T" If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMStringIDX2(arrColString, arrSortIndex, True, False, -1, -1) Else arrSortIndex = cSorting.SortOMStringIDX(arrColString, True, False, -1, -1) End If Case "N" 'all values are null, do no sort Dim arrSortIndex(1) As Int arrSortIndex(0) = -1 End Select End If arrDataSorted(col) = True mapSortingIndexes.Put(col, arrSortIndex) Else arrSortIndex = mapSortingIndexes.Get(col) 'retrieve an existing index for re-use End If If arrSortIndex(0) > -1 Then '------------------ 'Do the colour sort '------------------ iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) 'this is table specific iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) 'this is table specific If iAlteredRowColour <> -1 Then Dim arrAlteredRowColour2(arrAlteredRowColour.Length) As Boolean If bAscending Then For i = 0 To lUB arrAlteredRowColour2(i) = arrAlteredRowColour(arrSortIndex(i)) Next Else For i = 0 To lUB arrAlteredRowColour2(i) = arrAlteredRowColour(arrSortIndex(lUB - i)) Next End If End If If iAlteredTextColour <> -1 Then Dim arrAlteredRowTextColour2(arrAlteredRowTextColour.Length) As Boolean If bAscending Then For i = 0 To lUB arrAlteredRowTextColour2(i) = arrAlteredRowTextColour(arrSortIndex(i)) Next Else For i = 0 To lUB arrAlteredRowTextColour2(i) = arrAlteredRowTextColour(arrSortIndex(lUB - i)) Next End If End If '----------------------- 'Do the font italic sort '----------------------- bItalicRows = General.mapRowsItalic.GetDefault(TableObject.Panel.Tag, False) If bItalicRows Then Dim arrAlterRowsItalic2(arrAlterRowsItalic.Length) As Boolean If bAscending Then For i = 0 To lUB arrAlterRowsItalic2(i) = arrAlterRowsItalic(arrSortIndex(i)) Next Else For i = 0 To lUB arrAlterRowsItalic2(i) = arrAlterRowsItalic(arrSortIndex(lUB - i)) Next End If End If End If 'If arrSortIndex(0) > -1 Then SelectedRows.Clear 'sort the actual table data 'note that should not do a simple reversed order, but instead 'a block reversal where if items are the same they reversed as 'a block, keeping the same order '------------------------------------------------------------- If arrSortIndex(0) > -1 Then 'so don't move rows if all values are the same For i = 0 To lUB Data.Set(i, DataTemp.Get(arrSortIndex(i))) Next RefreshTable bSorted = True End If iPreviousSortColumn = col bPreviousSortAscending = bAscending Return bSorted End Sub Public Sub SortTable(Col As Int, bAscending As Boolean) As Boolean Dim i As Int Dim iUB As Int Dim arrRow() As String Dim bDoMultiColumnSort As Boolean Dim bValidArrSortIndex As Boolean Dim bSorted As Boolean Dim bUniqueColumn As Boolean If Col <> iPreviousSortColumn Then iPreviousSortColumn = Col arrDataSorted(Col) = False End If iUB = Data.Size - 1 '--------------------------------------------------------------- 'DataTemp is a copy of Data, before any sort was done 'It is needed to produce the sort arrays (except for long dates) 'and also to put the sorted data back into Data '--------------------------------------------------------------- If bDataTempDone = False Then DataTemp.Initialize For i = 0 To iUB DataTemp.Add(Data.Get(i)) Next bDataTempDone = True End If '------------------------------------------------------------------------- 'setup the 1D sort array, date column is already setup in eg LoadSQLiteDB4 '------------------------------------------------------------------------- If (arrDataSorted(Col) = False And arrDateColumns(Col) = False) Then Select Case strColumnDataTypes(Col) Case "I" Dim arrColLong(Data.Size) As Long For i = 0 To iUB arrRow = DataTemp.Get(i) Try arrColLong(i) = arrRow(Col) Catch 'just do nil as QSort1DInt_IDX can cope with nulls End Try 'ignore Next Case "R" Dim arrColDouble(Data.Size) As Double For i = 0 To iUB arrRow = DataTemp.Get(i) Try arrColDouble(i) = arrRow(Col) Catch 'just do nil as QSort1DDouble_IDX can cope with nulls End Try 'ignore Next Case "T" Dim arrColString(Data.size) As String For i = 0 To iUB arrRow = DataTemp.Get(i) Try arrColString(i) = arrRow(Col) Catch End Try 'ignore Next Case "N", "B" 'all values Null 'nil to do as there won't be a sort End Select End If '------------------------------------ 'determine if to do multi-column sort '------------------------------------ If arrSortIndex.Length > 0 Then If arrSortIndex(0) > -1 Then bValidArrSortIndex = True End If End If bDoMultiColumnSort = General.bMultiColumnSort And bValidArrSortIndex And mNumberOfColumns > 1 '------------------------ 'Get the sort index array '------------------------ If arrDataSorted(Col) = False Then If arrDateColumns(Col) Then If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMLongIDX2(mapLongDates.Get(Col), arrSortIndex, bAscending, -1, -1) Else arrSortIndex = cSorting.SortOMLongIDX(mapLongDates.Get(Col),bAscending, -1, -1) End If Else 'If arrDateColumns(Col) Select Case strColumnDataTypes(Col) Case "I" If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMLongIDX2(arrColLong, arrSortIndex, True, -1, -1) Else arrSortIndex = cSorting.SortOMLongIDX(arrColLong, True, -1, -1) End If Case "R" If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMDoubleIDX2(arrColDouble, arrSortIndex,True, -1, -1) Else arrSortIndex = cSorting.SortOMDoubleIDX(arrColDouble, True, -1, -1) End If Case "T" If bDoMultiColumnSort Then arrSortIndex = cSorting.SortOMStringIDX2(arrColString, arrSortIndex, True, General.bSortTableCaseInsensitive, -1, -1) Else arrSortIndex = cSorting.SortOMStringIDX(arrColString, True, General.bSortTableCaseInsensitive, -1, -1) End If Case "N", "B"'all values are null, do no sort Dim arrSortIndex(1) As Int arrSortIndex(0) = -1 End Select End If 'If arrDateColumns(Col) arrDataSorted(Col) = True mapSortingIndexes.Put(Col, arrSortIndex) Else 'If arrDataSorted(Col) = False arrSortIndex = mapSortingIndexes.Get(Col) 'retrieve an existing index (always ascending) for re-use End If 'If arrDataSorted(Col) = False SelectedRows.Clear '----------------------------------------------------------------------------- 'reverse the sort index if sorting descending 'this is better than just reverting the Data.Set loop as that doesn't maintain 'the previous sort order, so we need this for multi-column (just 2) sorting 'Don't store the altered arrSortIndex to the map here! '----------------------------------------------------------------------------- If arrSortIndex.Length > 0 Then If arrSortIndex(0) > -1 Then bValidArrSortIndex = True End If End If If bAscending = False And bValidArrSortIndex Then bUniqueColumn = bMap And TableObject.pnlTable.Tag = "tblDialog" And Col = 0 If arrDateColumns(Col) Then arrSortIndex = cSorting.ReverseIndexLong(mapLongDates.Get(Col), arrSortIndex, bUniqueColumn) Else Select Case strColumnDataTypes(Col) Case "I" arrSortIndex = cSorting.ReverseIndexLong(arrColLong, arrSortIndex, bUniqueColumn) Case "R" arrSortIndex = cSorting.ReverseIndexDouble(arrColDouble, arrSortIndex, bUniqueColumn) Case "T" arrSortIndex = cSorting.ReverseIndexString(arrColString, arrSortIndex, bUniqueColumn) End Select End If End If 'If bAscending = False And bValidArrSortIndex If arrSortIndex(0) > -1 Then 'Alter the index for row colour '------------------------------ iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) 'this is table specific If iAlteredRowColour <> -1 Then Dim arrAlteredRowColour2(arrAlteredRowColour.Length) As Boolean For i = 0 To iUB arrAlteredRowColour2(i) = arrAlteredRowColour(arrSortIndex(i)) Next End If 'Alter the index for text colour '------------------------------- iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) 'this is table specific If iAlteredTextColour <> -1 Then Dim arrAlteredRowTextColour2(arrAlteredRowTextColour.Length) As Boolean For i = 0 To iUB arrAlteredRowTextColour2(i) = arrAlteredRowTextColour(arrSortIndex(i)) Next End If 'Alter the index for Italic font '------------------------------- bItalicRows = General.mapRowsItalic.GetDefault(TableObject.Panel.Tag, False) If bItalicRows Then Dim arrAlterRowsItalic2(arrAlterRowsItalic.Length) As Boolean For i = 0 To iUB arrAlterRowsItalic2(i) = arrAlterRowsItalic(arrSortIndex(i)) Next End If End If 'If arrSortIndex(0) > -1 '-------------------------- 'sort the actual table data '-------------------------- If arrSortIndex(0) > -1 Then 'so don't move rows if all values are the same For i = 0 To iUB Data.Set(i, DataTemp.Get(arrSortIndex(i))) Next RefreshTable bSorted = True End If iPreviousSortColumn = Col bPreviousSortAscending = bAscending 'not used for now Return bSorted End Sub 'sets the cell alignment for each column each column can have a diferent alignment 'Example:''Dim alignments() As Int 'alignments = Array As Int (Bit.Or(Gravity.LEFT, Gravity.CENTER_VERTICAL), Gravity.CENTER, Bit.Or(Gravity.RIGHT, Gravity.CENTER_VERTICAL), Gravity.CENTER) 'Table1.SetCellAlignments(alignments) Public Sub SetCellAlignments(Alignments() As Int) If Alignments.Length <> mNumberOfColumns Then ToastMessageShow("The number of aligments is not equal to the number of columns.", False) Return End If cAlignments0 = Alignments cAlignments = cAlignments0 MultiAlignments = True If Data.Size > 0 Then RefreshTable End If End Sub 'sets the cell alignments for each column all columns with the same alignment 'Example: 'Table1.CellAlignment = Bit.OR(Gravity.CENTER_HORIZONTAL, Gravity.CENTER_VERTICAL) Public Sub setCellAlignment(Alignment As Int) Dim i As Int cAlignment = Alignment Dim cAlignments(mNumberOfColumns) As Int For i = 0 To mNumberOfColumns - 1 cAlignments(i) = cAlignment Next MultiAlignments = False If Data.Size > 0 Then RefreshTable End If End Sub 'sets the header alignment for each column each column can have a diferent alignment 'Example:''Dim alignments() As Int 'alignments = Array As Int (Bit.Or(Gravity.LEFT, Gravity.CENTER_VERTICAL), Gravity.CENTER, Bit.Or(Gravity.RIGHT, Gravity.CENTER_VERTICAL), Gravity.CENTER) 'Table1.SetHeaderAlignments(Alignments) Public Sub SetHeaderAlignments(Alignments() As Int) Dim i As Int If Alignments.Length <> mNumberOfColumns Then ToastMessageShow("The number of aligments is not equal to the number of columns.", False) Return End If Dim i As Int Dim cHeaderAlignments0(mNumberOfColumns) As Int cHeaderAlignments0 = Alignments cHeaderAlignments = cHeaderAlignments0 If Header.NumberOfViews > 0 Then If mNumberOfFixedColumns = 0 Then For i = 0 To mNumberOfColumns - 1 Dim lbl As Label lbl = Header.GetView(i) lbl.Gravity = cHeaderAlignments(i) Next Else For i = 0 To mNumberOfFixedColumns - 1 Dim lbl As Label lbl = HeaderFirst.GetView(i) lbl.Gravity = cHeaderAlignments(i) Next For i = 0 To mNumberOfColumns - mNumberOfFixedColumns - 1 Dim lbl As Label lbl = Header.GetView(i) lbl.Gravity = cHeaderAlignments(i + mNumberOfFixedColumns) Next End If End If HeaderMultiAlignments = True End Sub 'sets the header alignments for each column, all columns with the same alignment 'Example: 'Table1.HeaderAlignment = Bit.OR(Gravity.CENTER_HORIZONTAL, Gravity.CENTER_VERTICAL) Public Sub setHeaderAlignment(Alignment As Int) Dim i As Int cHeaderAlignment = Alignment If cHeaderAlignments.Length = 0 Then Private cHeaderAlignments(mNumberOfColumns) As Int End If For i = 0 To mNumberOfColumns - 1 cHeaderAlignments(i) = cHeaderAlignment Dim lbl As Label lbl = Header.GetView(i) lbl.Gravity = cHeaderAlignments(i) Next HeaderMultiAlignments = False End Sub Public Sub getCellAlignment As Int Return cAlignment End Sub 'sets or gets the header height Public Sub setHeaderHeight(Height As Int) cHeaderHeight = Height If Header.IsInitialized Then Header.Height = cHeaderHeight For i = 0 To mNumberOfColumns - 1 Dim lbl As Label lbl = Header.GetView(i) lbl.Height = Height Next SV2.Top = cHeaderHeight If cShowStatusLine = True Then SV2.Height = pnlTable.Height - cHeaderHeight - cRowHeight Else SV2.Height = pnlTable.Height - cHeaderHeight End If End If End Sub Public Sub getHeaderHeight As Int Return cHeaderHeight End Sub 'sets or gets the header color Public Sub setHeaderColor(Color As Int) cHeaderColor = Color End Sub Public Sub getHeaderColor As Int Return cHeaderColor End Sub 'sets or gets the header text color Public Sub setHeaderTextColor(Color As Int) cHeaderTextColor = Color End Sub Public Sub getHeaderTextColor As Int Return cHeaderTextColor End Sub 'sets or gets the odd rows color Public Sub setRowColor1(Color As Int) cRowColor1 = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getRowColor1 As Int Return cRowColor1 End Sub 'sets or gets the even rows color Public Sub setRowColor2(Color As Int) cRowColor2 = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getRowColor2 As Int Return cRowColor2 End Sub 'sets a specific color to the given row Public Sub SetRowColorN(Row As Int, Color As Int) Private col As Int Private New = False As Boolean If lstRowColors.IndexOf(Color) > 0 Then lstRowColorIndexes.Set(Row, lstRowColors.IndexOf(Color) + 2) Else lstRowColors.Add(Color) lstRowColorIndexes.Set(Row, lstRowColors.Size + 1) 'specific row color indexes begin with 2 New = True End If If Data.Size > 0 Then Private cdi(mNumberOfColumns) As Object For col = 0 To mNumberOfColumns - 1 Private cdw As ColorDrawable cdw.Initialize(Color, 0) cdi(col) = cdw Next If New = False Then lstRowDrawables.Set(lstRowColors.IndexOf(Color), cdi) Else lstRowDrawables.Add(cdi) End If RefreshLabels End If End Sub 'gets the specific color of the given row Public Sub GetRowColorN(Row As Int) As Int Return lstRowColors.Get(lstRowColorIndexes.Get(Row) - 2) End Sub 'removes the specific color of the given row Public Sub RemoveRowColorN(Row As Int) lstRowColorIndexes.Set(Row, 0) If pnlTable.IsInitialized Then RefreshLabels End If End Sub 'sets or gets the selected row color Public Sub setSelectedRowColor(Color As Int) cSelectedRowColor = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True) End If End Sub Public Sub getSelectedRowColor As Int Return cSelectedRowColor End Sub 'sets or gets the selected cell color Public Sub setSelectedCellColor(Color As Int) cSelectedCellColor = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns,True) End If End Sub Public Sub getSelectedCellColor As Int Return cSelectedCellColor End Sub 'sets or gets the table color (color of lines between cells) Public Sub setTableColor(Color As Int) cTableColor = Color If SV2.IsInitialized = True Then SV2.Panel.Color = cTableColor If Header.IsInitialized Then Header.Color = cTableColor End If End If End Sub Public Sub getTableColor As Int Return cTableColor End Sub 'sets or gets the cell text color Public Sub setTextColor(Color As Int) Dim i As Long cTextColor = Color If SV2.IsInitialized = True Then For i = 0 To SV2.Panel.NumberOfViews - 1 Dim lbl As Label lbl = SV2.Panel.GetView(i) lbl.TextColor = cTextColor Next End If End Sub Public Sub getTextColor As Int Return cTextColor End Sub 'sets or gets the cell text size Public Sub setTextSize(Size As Float) cTextSize = Size Private i As Int If Header.IsInitialized Then For i = 0 To Header.NumberOfViews - 1 Dim lbl As Label lbl = Header.GetView(i) lbl.TextSize = cTextSize Next End If If SV2.IsInitialized = True Then For i = 0 To SV2.Panel.NumberOfViews - 1 Dim lbl As Label lbl = SV2.Panel.GetView(i) lbl.TextSize = cTextSize Next End If End Sub Public Sub getTextSize As Float Return cTextSize End Sub 'added 05/01/2021 <<<<<<<<<< Public Sub SetFontAndRowSize(dActivityHeightRatio As Double) cTextSize = cTextSize * dActivityHeightRatio cRowHeight = cRowHeight * dActivityHeightRatio cHeaderHeight = cHeaderHeight * dActivityHeightRatio End Sub 'sets or gets the row height Public Sub setRowHeight(RowHeight As Int) If cRowHeight = cHeaderHeight Then setHeaderHeight(RowHeight) End If cRowHeight = RowHeight End Sub Public Sub getRowHeight As Int Return cRowHeight End Sub 'Sets different typefaces for columns 'If TypeFaces() is an array with only one TypeFace this one is applied to all columns. 'This method must be called before filling the table 'Example code: 'Dim tf() As TypeFace 'tf = Array As Typeface(Typeface.DEFAULT, Typeface.DEFAULT_BOLD, , Typeface.DEFAULT, Typeface.DEFAULT_BOLD) 'Table1.SetTypeFaces(tf) Public Sub SetTypeFaces(TypeFaces() As Typeface) If TypeFaces.Length = 1 Then cTypeFace = TypeFaces(0) MultiTypeFace = False Else If TypeFaces.Length <> mNumberOfColumns Then ToastMessageShow("Invalid number of columns", False) Return End If cTypeFaces0 = TypeFaces cTypeFaces = cTypeFaces0 MultiTypeFace = True End If If Data.Size > 0 Then RefreshLabels End If End Sub 'load data from a SQLite database 'SQLite = SQL object 'Query = SQLite query 'AutomaticWidths True > set the column widths automaticaly 'ATTENTION: if you expect REAL numbers with more than 7 digits you should use LoadSQLiteDB2 'SQLite limits REAL numbers converted to Strings like Floats (7 digits) not Doubles Public Sub LoadSQLiteDB(SQLite As SQL, _ Query As String, _ AutomaticWidths As Boolean) Dim Curs As Cursor Curs = SQLite.ExecQuery(Query) cAutomaticWidths = AutomaticWidths mNumberOfColumns = Curs.ColumnCount innerClearAll(mNumberOfColumns, True) Dim Headers(mNumberOfColumns) As String Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String Dim col, row As Int Dim str As String For col = 0 To mNumberOfColumns - 1 cColumnDataType(col) = "TEXT" Headers(col) = Curs.GetColumnName(col) If AutomaticWidths = False Then ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth DataWidths(col) = 0 For row = 0 To Curs.RowCount - 1 Curs.Position = row str = Curs.GetString2(col) If str <> Null Then DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) End If Next ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next SetHeader(Headers) SetColumnsWidths(ColumnWidths) For row = 0 To Curs.RowCount - 1 Dim R(mNumberOfColumns), str As String For col = 0 To mNumberOfColumns - 1 Curs.Position = row str = Curs.GetString2(col) If str <> Null Then R(col) = str Else R(col) = "" End If Next AddRow(R) Next Curs.Close End Sub 'load data from a SQLite database 'SQLite = SQL object 'Query = SQLite query 'AutomaticWidths True > set the column widths automaticaly 'ColumDataTypes Array of strings with the data types ' "I" = INTEGER ' "R" = REAL ' "T" = TEXT 'Example: 'Table1.LoadSQLiteDB2(SQL1, "SELECT * FROM Test", True, Array As String("I", "T", "R", "I")) Public Sub LoadSQLiteDB2(SQLite As SQL, _ Query As String, _ AutomaticWidths As Boolean, _ ColumnDataTypes() As String) Dim Curs As Cursor Curs = SQLite.ExecQuery(Query) cAutomaticWidths = AutomaticWidths mNumberOfColumns = Curs.ColumnCount innerClearAll(mNumberOfColumns, True) Dim Headers(mNumberOfColumns) As String Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String Dim col, row As Int Dim ii As Long Dim dd As Double Dim str As String For col = 0 To mNumberOfColumns - 1 If ColumnDataTypes(col) = "T" Then cColumnDataType(col) = "TEXT" Else cColumnDataType(col) = "NUMBER" End If Headers(col) = Curs.GetColumnName(col) If AutomaticWidths = False Then ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth DataWidths(col) = 0 For row = 0 To Curs.RowCount - 1 Curs.Position = row str = Curs.GetString2(col) If str <> Null Then Select ColumnDataTypes(col) Case "I" ii = Curs.GetInt2(col) str = ii Case "R" dd = Curs.GetDouble2(col) str = dd End Select Else str = "" End If DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) Next ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next SetHeader(Headers) SetColumnsWidths(ColumnWidths) For row = 0 To Curs.RowCount - 1 Curs.Position = row Dim R(mNumberOfColumns), str As String For col = 0 To mNumberOfColumns - 1 str = Curs.GetString2(col) If str = Null Then R(col) = "" Else Select ColumnDataTypes(col) Case "I" ii = Curs.GetLong2(col) R(col) = ii Case "R" dd = Curs.GetDouble2(col) R(col) = dd Case "T" R(col) = Curs.GetString2(col) Case Else '"BLOB" R(col) = "" End Select End If Next AddRow(R) Next Curs.Close End Sub 'load data from a SQLite database 'uses SQL.ExecQuery2, the query can include question marks which will be replaced with the values in the array. 'SQLite = SQL object 'Query = SQLite query 'Values = Array of Strings with the values 'AutomaticWidths True > set the column widths automaticaly 'ATTENTION: if you expect REAL numbers with more than 7 digits you should use LoadSQLiteDB2 'SQLite limits REAL numbers converted to Strings like Floats (7 digits) not Doubles Public Sub LoadSQLiteDB3(SQLite As SQL, _ Query As String, _ Values() As String, _ AutomaticWidths As Boolean) Dim Curs As Cursor Dim Headers(mNumberOfColumns) As String Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String Dim col, row As Int Dim str As String Curs = SQLite.ExecQuery2(Query, Values) cAutomaticWidths = AutomaticWidths mNumberOfColumns = Curs.ColumnCount innerClearAll(mNumberOfColumns, True) For col = 0 To mNumberOfColumns - 1 cColumnDataType(col) = "TEXT" Headers(col) = Curs.GetColumnName(col) If AutomaticWidths = False Then ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth DataWidths(col) = 0 For row = 0 To Curs.RowCount - 1 Curs.Position = row str = Curs.GetString2(col) If str <> Null Then DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) End If Next ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next SetHeader(Headers) SetColumnsWidths(ColumnWidths) For row = 0 To Curs.RowCount - 1 Dim R(mNumberOfColumns), str As String For col = 0 To mNumberOfColumns - 1 Curs.Position = row str = Curs.GetString2(col) If str <> Null Then R(col) = str Else R(col) = "" End If Next AddRow(R) Next Curs.Close End Sub Sub SetupColourArrays(iRows As Int, iHeaderRow As Int) Try If TableObject.IsInitialized Then If TableObject.pnlTable.IsInitialized Then iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) Else iAlteredRowColour = -1 iAlteredTextColour = -1 End If Else iAlteredRowColour = -1 iAlteredTextColour = -1 End If Catch iAlteredRowColour = -1 iAlteredTextColour = -1 End Try If iAlteredRowColour <> -1 Then Dim arrAlteredRowColour2(iRows + iHeaderRow) As Boolean arrAlteredRowColour = General.mapArrAlteredRowColour.GetDefault(TableObject.Panel.Tag, -1) For i = 0 To iRows - 1 arrAlteredRowColour2(i) = arrAlteredRowColour(i) Next End If If iAlteredTextColour <> -1 Then Dim arrAlteredRowTextColour2(iRows) As Boolean arrAlteredRowTextColour = General.mapArrAlteredRowTextColour.Get(TableObject.Panel.Tag) For i = 0 To iRows - 1 arrAlteredRowTextColour2(i) = arrAlteredRowTextColour(i) Next End If End Sub Sub SetupItalicArray(iRows As Int) Try If TableObject.IsInitialized Then If TableObject.pnlTable.IsInitialized Then bItalicRows = General.mapRowsItalic.GetDefault(TableObject.Panel.Tag, False) Else bItalicRows = False End If Else bItalicRows = False End If Catch bItalicRows = False End Try If bItalicRows Then Dim arrAlterRowsItalic2(iRows) As Boolean arrAlterRowsItalic = General.mapArrRowsItalic.Get(TableObject.Panel.Tag) For i = 0 To iRows - 1 arrAlterRowsItalic2(i) = arrAlterRowsItalic(i) Next End If End Sub 'this is the one used by the SQL editor Public Sub LoadSQLiteDB4(RS1 As ResultSet, _ bAutomaticWidths As Boolean, _ ColumnNames() As String, _ ColumnDataTypes() As String, _ MaxColumnWidths() As Int, _ ColWidths() As Int) Dim i As Long Dim c As Int Dim lSpacePos As Long Dim strTemp As String Dim bColumnDataTypesSupplied As Boolean Dim bColWidthsSupplied As Boolean Dim strHeaderUC As String Dim fTicksDateWidth As Float Dim fAgeWidth As Float Dim fDateWidth As Float DateTime.DateFormat = General.strTableDateFormat bMap = False 'new data, so need new sorting indexes '------------------------------------- SetArrColumnsSorted(RS1.ColumnCount) 'to keep track of the columns that have been sorted so have the sort types set SetupColourArrays(RS1.RowCount, 0) SetupItalicArray(RS1.RowCount) If ColumnDataTypes <> Null Then bColumnDataTypesSupplied = ColumnDataTypes(0).Length > 0 End If If ColWidths <> Null Then bColWidthsSupplied = ColWidths(0) > 0 End If mNumberOfColumns = RS1.ColumnCount Dim arrDataTypesX(mNumberOfColumns) As String For c = 0 To mNumberOfColumns - 1 arrDataTypesX(c) = ColumnDataTypes(c) Next 'strColumnDataTypes is module private variable 'note we need to accomodate all cursor columns, so even if column is skipped! '---------------------------------------------------------------------------- Dim strColumnDataTypes(RS1.ColumnCount) As String cAutomaticWidths = bAutomaticWidths innerClearAll(mNumberOfColumns, True) Dim Headers(mNumberOfColumns) As String Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim arrDateColumns(RS1.ColumnCount) As Boolean 'as this may be needed for sorting although it may not be displayed! Dim col As Int Dim str As String Dim bColumnNamesSupplied As Boolean Dim iCursorPos As Int Dim bDateColumn As Boolean 'as we shouldn't alter the cursor position for the calling procedure! '-------------------------------------------------------------------- iCursorPos = RS1.Position bColumnNamesSupplied = ColumnNames(0).Length > 0 If bColumnDataTypesSupplied = False Then Dim ColumnDataTypes(mNumberOfColumns) As String End If For col = 0 To RS1.ColumnCount - 1 If MaxColumnWidths(col) = 0 Then MaxColumnWidths(col) = General.iMaxColumnWidth End If Next 'note that data types as data column boolean are needed for all cursor columns as they may be needed for sorting! '---------------------------------------------------------------------------------------------------------------- For col = 0 To RS1.ColumnCount - 1 If bColumnDataTypesSupplied = False Then strColumnDataTypes(col) = "T" Else Select ColumnDataTypes(col) Case "I" strColumnDataTypes(col) = "I" Case "R" strColumnDataTypes(col) = "R" Case "T" strColumnDataTypes(col) = "T" Case "XL2Age" strColumnDataTypes(col) = "I" fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) Case "XD" arrDateColumns(col) = True strColumnDataTypes(col) = "I" bDateColumn = True fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) Case "Ticks_Date" arrDateColumns(col) = True strColumnDataTypes(col) = "I" bDateColumn = True fTicksDateWidth = cvs.MeasureStringWidth("24/12/2014 12:55", Typeface.DEFAULT, cTextSize) Case "YEAR", "MONTH", "DAY" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" Case "BeforeSpace" strColumnDataTypes(col) = "T" Case Else '"BLOB" strColumnDataTypes(col) = "B" End Select End If Next For col = 0 To mNumberOfColumns - 1 If ColumnDataTypes(col) <> "B" Then If bColumnNamesSupplied Then Headers(col) = ColumnNames(col) Else Headers(col) = RS1.GetColumnName(col) End If strHeaderUC = Headers(col).ToUpperCase If bColumnDataTypesSupplied Then If strHeaderUC.IndexOf("DATE_TIME") > -1 Or _ RS1.GetColumnName(col).ToUpperCase.IndexOf("DATE_TIME") > -1 Then ColumnDataTypes(col) = "Ticks_Date" fTicksDateWidth = cvs.MeasureStringWidth("24/12/2015 23:52", Typeface.DEFAULT, cTextSize) Else If (strHeaderUC.IndexOf("DATE") > -1 Or strHeaderUC.IndexOf("DOB") > -1) And _ ColumnDataTypes(col) <> "Ticks_Date" Then ColumnDataTypes(col) = "XD" arrDateColumns(col) = True fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) Else If strHeaderUC = "AGE" Then RS1.Position = 0 If RS1.GetInt2(col) > 1000 Then 'make sure we have a date and not an age! ColumnDataTypes(col) = "XL2Age" End If fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) End If End If End If Else 'If bColumnDataTypesSupplied If strHeaderUC.IndexOf("DATE_TIME") > -1 Then ColumnDataTypes(col) = "Ticks_Date" fTicksDateWidth = cvs.MeasureStringWidth("24/12/2015 23:52", Typeface.DEFAULT, cTextSize) Else If strHeaderUC.IndexOf("DATE") > -1 Or strHeaderUC.IndexOf("DOB") > -1 Then ColumnDataTypes(col) = "XD" arrDateColumns(col) = True fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) ColWidths(col) = fDateWidth + ExtraWidth Else If strHeaderUC.IndexOf("COUNT") > -1 Or _ strHeaderUC.IndexOf("YEARS") > -1 Or _ strHeaderUC.IndexOf("MONTHS") > -1 Or _ strHeaderUC.IndexOf("WEEKS") > -1 Or _ strHeaderUC.IndexOf("HOURS") > -1 Or _ strHeaderUC.IndexOf("MINUTES") > -1 Or _ strHeaderUC.IndexOf("SECONDS") > -1 Then ColumnDataTypes(col) = "I" Else If strHeaderUC = "YEAR" Or strHeaderUC = "MONTH" Or strHeaderUC = "DAY" Or strHeaderUC = "AGE" Then ColumnDataTypes(col) = "I" fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) ColWidths(col) = fAgeWidth + ExtraWidth End If End If End If End If End If 'If bColumnDataTypesSupplied If bAutomaticWidths = False Then If bColWidthsSupplied Then ColumnWidths(col) = ColWidths(col) HeaderWidths(col) = ColWidths(col) DataWidths(col) = ColWidths(col) Else ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip End If Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth DataWidths(col) = 0 If arrDateColumns(col) = False Then If ColumnDataTypes(col) = "XL2Age" Then DataWidths(col) = fAgeWidth + ExtraWidth Else If MaxColumnWidths(col) > -1 Then 'as column will be hidden RS1.Position = -1 Dim strMaxColString As String Do While RS1.NextRow If ColumnDataTypes(col) = "BLOB" Then '<<<<<<<<<<<<<<<<< this fails to avoid error with blob field!! str = "" Else str = RS1.GetString2(col) If ColumnDataTypes(col) = "BeforeSpace" Then lSpacePos = str.IndexOf(" ") If lSpacePos > -1 Then str = str.SubString2(0, lSpacePos - 1) 'get the real final text width End If End If ' If str <> Null Then ' DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If If str <> Null Then If str.Length > strMaxColString.Length Then strMaxColString = str End If End If End If Loop DataWidths(col) = cvs.MeasureStringWidth(strMaxColString, Typeface.DEFAULT, cTextSize) + ExtraWidth End If End If Else'If arrDateColumns(col) = False If ColumnDataTypes(col) = "Ticks_Date" Then DataWidths(col) = fTicksDateWidth + ExtraWidth Else DataWidths(col) = fDateWidth + ExtraWidth End If bDateColumn = True End If 'If ColumnDataTypes(col) <> "XD" And ColumnDataTypes(col) <> "Ticks_Date" ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) If MaxColumnWidths(col) > 0 Then If ColumnWidths(col) > MaxColumnWidths(col) Then ColumnWidths(col) = MaxColumnWidths(col) End If End If End If End If 'If ColumnDataTypes(col) <> "B" Then Next 'col SetHeader(Headers) SetColumnsWidths(ColumnWidths) 'note that this is needed for all cursor columns, including columns that will be skipped in the display 'this is because it may be needed for sorting, which is now done on cursor data, not table data! '------------------------------------------------------------------------------------------------------ If bColumnDataTypesSupplied Then RS1.Position = -1 Do While RS1.NextRow Dim R(mNumberOfColumns) As String Dim str As String For col = 0 To mNumberOfColumns - 1 If ColumnDataTypes(col) <> "B" Then str = RS1.GetString2(col) If str = Null Then 'Otherwise Null will show in the view R(col) = "" Else Select ColumnDataTypes(col) Case "T", "I", "R" R(col) = str Case "XL2Age" R(col) = General.ExcelDate2Age(CInt(str)) Case "XD" R(col) = General.ExcelDate2String(CInt(str)) Case "Ticks_Date" 'all date-time values are stored as seconds since 01/01/1970 midnight (not ticks) If RS1.GetColumnName(col) = "JOURNEY_DATE_TIME" Then R(col) = General.Ticks2String(CLng(str), "dd/MM/yyyy HH:mm:ss", True) 'as these are very small time intervals Else R(col) = General.Ticks2String(CLng(str), "dd/MM/yyyy HH:mm", True) End If Case "BeforeSpace" strTemp = str lSpacePos = strTemp.IndexOf(" ") If lSpacePos > -1 Then R(col) = strTemp.SubString2(0, lSpacePos) Else R(col) = strTemp End If Case Else R(col) = "" End Select End If Else 'If ColumnDataTypes(col) <> "B" R(col) = "" End If 'If ColumnDataTypes(col) <> "B" Next 'For col = 0 To mNumberOfColumns - 1 AddRow(R) Loop Else 'If bColumnDataTypesSupplied If bDateColumn = False Then RS1.Position = -1 Do While RS1.NextRow Dim R(mNumberOfColumns) As String Dim str As String For col = 0 To mNumberOfColumns - 1 If ColumnDataTypes(col) = "B" Then R(col) = "" Else str = RS1.GetString2(col) If str <> Null Then R(col) = str Else R(col) = "" End If End If Next AddRow(R) Loop Else 'If bDateColumn = False RS1.Position = -1 Do While RS1.NextRow Dim R(mNumberOfColumns), str As String For col = 0 To mNumberOfColumns - 1 If ColumnDataTypes(col) = "B" Then R(col) = "" Else If arrDateColumns(col) Then str = General.ExcelDate2String(RS1.GetLong2(col)) Else str = RS1.GetString2(col) End If If str <> Null Then R(col) = str Else R(col) = "" End If End If Next AddRow(R) Loop End If 'If bDateColumn = False End If 'If bColumnDataTypesSupplied If bDateColumn Then mapLongDates.Initialize For col = 0 To mNumberOfColumns - 1 If arrDateColumns(col) Then Dim arrLongDates(RS1.RowCount) As Long For i = 0 To RS1.RowCount - 1 RS1.Position = i arrLongDates(i) = RS1.GetInt2(col) Next mapLongDates.Put(col, arrLongDates) End If Next End If 'Hide column. This is used for keeping sqlite table rowid available, but not visible 'We use -1 argument here as 0 means there is no max column width '----------------------------------------------------------------------------------- For col = 0 To mNumberOfColumns - 1 'hide columns holding blobs, eg SQL_EXTRA of table SAVED_SQL '----------------------------------------------------------- If MaxColumnWidths(col) = -1 Or ColumnDataTypes(col) = "B" Then hideCol(col) End If Next RefreshTable 'as we shouldn't alter the cursor position for the calling procedure! '-------------------------------------------------------------------- RS1.Position = iCursorPos End Sub Public Sub LoadSQLiteDBFromMap(oMap As Map, _ ColumnNames() As String, _ ColumnDataTypes() As String, _ MaxColumnWidths() As Int, _ ColWidths() As Int) Dim i As Long Dim iCols As Int Dim lSpacePos As Long Dim bColWidthsSupplied As Boolean Dim fTicksDateWidth As Float Dim fAgeWidth As Float Dim fDateWidth As Float Dim bDateColumn As Boolean Dim col As Int Dim bArrayAsValues As Boolean Dim iArrayType As Int Dim strValue As String 'Dim iKey As Int 'Dim dKey As Double 'Dim iMapKeyDataType As Int iCols = ColumnNames.Length mNumberOfColumns = iCols bArrayAsValues = GetType(oMap.GetValueAt(0)).CharAt(0) = "[" If bArrayAsValues Then Select Case General.ArrayType(oMap.GetValueAt(0)) Case "Byte" iArrayType = 0 Dim arrByte() As Byte Case "Short" iArrayType = 1 Case "Int" iArrayType = 2 Dim arrInt() As Int Case "Long" iArrayType = 3 Dim arrLong() As Long Case "Float" iArrayType = 4 Dim arrFloat() As Float Case "Double" iArrayType = 5 Dim arrDouble() As Double Case "Char" iArrayType = 6 Case "String" iArrayType = 7 Dim arrString() As String Case "Object" iArrayType = 8 Dim arrObject() As Object End Select End If DateTime.DateFormat = General.strTableDateFormat bMap = True SetArrColumnsSorted(iCols) 'to keep track of the columns that have been sorted so have the sort types set SetupColourArrays(oMap.Size, 0) If ColWidths <> Null Then bColWidthsSupplied = ColWidths(0) > 0 End If 'strColumnDataTypes is module private variable 'note we need to accomodate all cursor columns, so even if column is skipped! '---------------------------------------------------------------------------- Dim strColumnDataTypes(iCols) As String For col = 0 To iCols - 1 If MaxColumnWidths(col) = 0 Then MaxColumnWidths(col) = General.iMaxColumnWidth End If Next Dim arrDataTypesX(mNumberOfColumns) As String For c = 0 To mNumberOfColumns - 1 arrDataTypesX(c) = ColumnDataTypes(c) Next cAutomaticWidths = bColWidthsSupplied = False innerClearAll(iCols, True) Dim Headers(iCols) As String Dim ColumnWidths(iCols) As Int Dim HeaderWidths(iCols) As Int Dim DataWidths(iCols) As Int Dim cColumnDataType(iCols) As String 'as this may be needed for sorting although it may not be displayed! Dim arrDateColumns(iCols) As Boolean 'as this may be needed for sorting although it may not be displayed! 'note that data types as data column boolean are needed for all cursor columns as they may be needed for sorting! '---------------------------------------------------------------------------------------------------------------- For col = 0 To iCols - 1 'Log("ColumnDataTypes(" & col & "): " & ColumnDataTypes(col)) Select ColumnDataTypes(col) Case "I", "I_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" Case "R", "R_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "R" Case "T", "T_S" cColumnDataType(col) = "TEXT" strColumnDataTypes(col) = "T" Case "XL2Age", "XL2Age_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) Case "XD", "XD_S" bDateColumn = True cColumnDataType(col) = "TEXT" arrDateColumns(col) = True strColumnDataTypes(col) = "I" fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) If col = 0 Then Dim arrLongDates0(oMap.Size) As Long Else Dim arrLongDates1(oMap.Size) As Long End If Case "Ticks_Date", "Ticks_Date_S" bDateColumn = True cColumnDataType(col) = "TEXT" arrDateColumns(col) = True strColumnDataTypes(col) = "I" fTicksDateWidth = cvs.MeasureStringWidth("24/12/2014 12:55", Typeface.DEFAULT, cTextSize) If col = 0 Then Dim arrLongDates0(oMap.Size) As Long Else Dim arrLongDates1(oMap.Size) As Long End If Case "YEAR", "YEAR_S", "MONTH", "MONTH_S", "DAY", "DAY_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" Case "BeforeSpace", "BeforeSpace_S" cColumnDataType(col) = "TEXT" strColumnDataTypes(col) = "T" Case Else '"BLOB" cColumnDataType(col) = "TEXT" strColumnDataTypes(col) = "T" End Select Next For col = 0 To iCols - 1 Headers(col) = ColumnNames(col) If cAutomaticWidths = False Then If bColWidthsSupplied Then ColumnWidths(col) = ColWidths(col) HeaderWidths(col) = ColWidths(col) DataWidths(col) = ColWidths(col) Else ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip End If Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth If arrDateColumns(col) = False Then If ColumnDataTypes(col) = "XL2Age" Then DataWidths(col) = fAgeWidth + ExtraWidth Else If MaxColumnWidths(col) > -1 Then 'as otherwise column will be hidden If col = 0 Then Dim strMaxColString As String For Each str As String In oMap.Keys If ColumnDataTypes(col) = "BeforeSpace" Then lSpacePos = str.IndexOf(" ") If lSpacePos > -1 Then str = str.SubString2(0, lSpacePos - 1) 'get the real final text width End If End If ' If str <> Null Then ' DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If If str <> Null Then If str.Length > strMaxColString.Length Then strMaxColString = str End If End If Next DataWidths(col) = cvs.MeasureStringWidth(strMaxColString, Typeface.DEFAULT, cTextSize) + ExtraWidth Else Dim strMaxColString As String For Each str As String In oMap.Values If ColumnDataTypes(col) = "BeforeSpace" Then lSpacePos = str.IndexOf(" ") If lSpacePos > -1 Then str = str.SubString2(0, lSpacePos - 1) 'get the real final text width End If End If ' If str <> Null Then ' DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If If str <> Null Then If str.Length > strMaxColString.Length Then strMaxColString = str End If End If Next DataWidths(col) = cvs.MeasureStringWidth(strMaxColString, Typeface.DEFAULT, cTextSize) + ExtraWidth End If End If End If Else'If arrDateColumns(col) = False If ColumnDataTypes(col) = "Ticks_Date" Then DataWidths(col) = fTicksDateWidth + ExtraWidth Else DataWidths(col) = fDateWidth + ExtraWidth End If End If 'If ColumnDataTypes(col) <> "XD" And ColumnDataTypes(col) <> "Ticks_Date" ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next 'col SetHeader(Headers) SetColumnsWidths(ColumnWidths) SV2.VerticalScrollPosition = 0 If bArrayAsValues Then For Each oKey As Object In oMap.Keys Dim R(iCols) As String If oKey = Null Then 'Otherwise Null will show in the view R(0) = "" Else 'If strKey = Null 'deal with the map keys '---------------------- Select ColumnDataTypes(0) Case "I", "R", "T" R(0) = oKey Case "XL2Age" R(0) = General.ExcelDate2Age(CLng(oKey)) Case "XD" R(0) = General.ExcelDate2String(CLng(oKey)) arrLongDates0(i) = oKey Case "Ticks_Date" 'all date-time values are stored as seconds since 01/01/1970 midnight (not ticks) R(0) = General.Ticks2String(CLng(oKey), "dd/MM/yyyy HH:mm", True) arrLongDates0(i) = oKey Case "BeforeSpace" lSpacePos = oKey.As(String).IndexOf(" ") If lSpacePos > -1 Then R(0) = oKey.As(String).SubString2(0, lSpacePos) Else R(0) = oKey End If Case Else '"BLOB" R(0) = "" End Select End If 'If strKey = Null 'deal with the map values '------------------------ If iCols > 1 Then Select Case iArrayType Case 0 arrByte = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrByte(col - 1) Next Case 2 arrInt = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrInt(col - 1) Next Case 3 arrLong = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrLong(col - 1) Next Case 4 arrFloat = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrFloat(col - 1) Next Case 5 arrDouble = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrDouble(col - 1) Next Case 7 arrString = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrString(col - 1) Next Case 8 arrObject = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrObject(col - 1) Next End Select End If AddRow(R) i = i + 1 Next Else 'If bArrayAsValues ' Log("ColumnDataTypes(0): " & ColumnDataTypes(0)) ' Log("ColumnDataTypes(1): " & ColumnDataTypes(1)) ' Log("GetMapItemDataType: " & General.GetMapItemDataType(oMap.GetKeyAt(0))) For Each oKey As Object In oMap.Keys Dim R(iCols) As String If oKey = Null Then 'Otherwise Null will show in the table R(0) = "" Else 'deal with the map keys '---------------------- Select ColumnDataTypes(0) Case "I", "R", "T" R(0) = oKey Case "XD" R(0) = General.ExcelDate2String(oKey.As(Int)) arrLongDates0(i) = oKey Case "XL2Age" R(0) = General.ExcelDate2Age(CLng(oKey)) Case "Ticks_Date" R(0) = General.Ticks2String(CLng(oKey), "dd/MM/yyyy HH:mm", True) arrLongDates0(i) = oKey Case "BeforeSpace" lSpacePos = oKey.As(String).IndexOf(" ") If lSpacePos > -1 Then R(0) = oKey.As(String).SubString2(0, lSpacePos) Else R(0) = oKey End If Case Else '"BLOB" R(0) = "" If iCols > 1 Then R(1) = "" End If End Select 'deal with the map values '------------------------ If iCols > 1 Then Select Case ColumnDataTypes(1) Case "I", "R", "T" R(1) = oMap.Get(oKey) Case "XL2Age" R(1) = General.ExcelDate2Age(CLng(oMap.Get(oKey))) Case "XD" R(1) = General.ExcelDate2String(CLng(oMap.Get(oKey))) Case "Ticks_Date" R(1) = General.Ticks2String(CLng(oMap.Get(oKey)), "dd/MM/yyyy HH:mm", True) Case "BeforeSpace" strValue = oMap.Get(oKey) lSpacePos = strValue.IndexOf(" ") If lSpacePos > -1 Then R(1) = strValue.SubString2(0, lSpacePos) Else R(1) = strValue End If Case Else R(1) = "" End Select End If End If AddRow(R) i = i + 1 'this is needed for arrLongDates0 and arrLongDates1 Next End If 'If bArrayAsValues If bDateColumn Then mapLongDates.Initialize End If If arrDateColumns(0) Then mapLongDates.Put(0, arrLongDates0) End If If iCols > 1 Then If arrDateColumns(1) Then mapLongDates.Put(1, arrLongDates1) End If End If RefreshTable End Sub Public Sub LoadSQLiteDBFromOrderedMap(oMap As B4XOrderedMap, _ ColumnNames() As String, _ ColumnDataTypes() As String, _ MaxColumnWidths() As Int, _ ColWidths() As Int) Dim i As Long Dim iCols As Int Dim lSpacePos As Long Dim bColWidthsSupplied As Boolean Dim fTicksDateWidth As Float Dim fAgeWidth As Float Dim fDateWidth As Float Dim bDateColumn As Boolean Dim col As Int Dim bArrayAsValues As Boolean Dim iArrayType As Int Dim strValue As String iCols = ColumnNames.Length mNumberOfColumns = iCols bArrayAsValues = GetType(oMap.Values.Get(0)).CharAt(0) = "[" If bArrayAsValues Then Select Case General.ArrayType(oMap.Values.Get(0)) Case "Byte" iArrayType = 0 Dim arrByte() As Byte Case "Short" iArrayType = 1 Case "Int" iArrayType = 2 Dim arrInt() As Int Case "Long" iArrayType = 3 Dim arrLong() As Long Case "Float" iArrayType = 4 Dim arrFloat() As Float Case "Double" iArrayType = 5 Dim arrDouble() As Double Case "Char" iArrayType = 6 Case "String" iArrayType = 7 Dim arrString() As String Case "Object" iArrayType = 8 Dim arrObject() As Object End Select End If DateTime.DateFormat = General.strTableDateFormat bMap = True SetArrColumnsSorted(iCols) 'to keep track of the columns that have been sorted so have the sort types set SetupColourArrays(oMap.Size, 0) If ColWidths <> Null Then bColWidthsSupplied = ColWidths(0) > 0 End If 'strColumnDataTypes is module private variable 'note we need to accomodate all cursor columns, so even if column is skipped! '---------------------------------------------------------------------------- Dim strColumnDataTypes(iCols) As String For col = 0 To iCols - 1 If MaxColumnWidths(col) = 0 Then MaxColumnWidths(col) = General.iMaxColumnWidth End If Next Dim arrDataTypesX(mNumberOfColumns) As String For c = 0 To mNumberOfColumns - 1 arrDataTypesX(c) = ColumnDataTypes(c) Next cAutomaticWidths = bColWidthsSupplied = False innerClearAll(iCols, True) Dim Headers(iCols) As String Dim ColumnWidths(iCols) As Int Dim HeaderWidths(iCols) As Int Dim DataWidths(iCols) As Int Dim cColumnDataType(iCols) As String 'as this may be needed for sorting although it may not be displayed! Dim arrDateColumns(iCols) As Boolean 'as this may be needed for sorting although it may not be displayed! Dim str As String 'note that data types as data column boolean are needed for all cursor columns as they may be needed for sorting! '---------------------------------------------------------------------------------------------------------------- For col = 0 To iCols - 1 Select ColumnDataTypes(col) Case "I", "I_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" Case "R", "R_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "R" Case "T", "T_S" cColumnDataType(col) = "TEXT" strColumnDataTypes(col) = "T" Case "XL2Age", "XL2Age_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) Case "XD", "XD_S" bDateColumn = True cColumnDataType(col) = "TEXT" arrDateColumns(col) = True strColumnDataTypes(col) = "I" fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) If col = 0 Then Dim arrLongDates0(oMap.Size) As Long Else Dim arrLongDates1(oMap.Size) As Long End If Case "Ticks_Date", "Ticks_Date_S" bDateColumn = True cColumnDataType(col) = "TEXT" arrDateColumns(col) = True strColumnDataTypes(col) = "I" fTicksDateWidth = cvs.MeasureStringWidth("24/12/2014 12:55", Typeface.DEFAULT, cTextSize) If col = 0 Then Dim arrLongDates0(oMap.Size) As Long Else Dim arrLongDates1(oMap.Size) As Long End If Case "YEAR", "YEAR_S", "MONTH", "MONTH_S", "DAY", "DAY_S" cColumnDataType(col) = "NUMBER" strColumnDataTypes(col) = "I" Case "BeforeSpace", "BeforeSpace_S" cColumnDataType(col) = "TEXT" strColumnDataTypes(col) = "T" Case Else '"BLOB" cColumnDataType(col) = "TEXT" strColumnDataTypes(col) = "T" End Select Next For col = 0 To iCols - 1 Headers(col) = ColumnNames(col) If cAutomaticWidths = False Then If bColWidthsSupplied Then ColumnWidths(col) = ColWidths(col) HeaderWidths(col) = ColWidths(col) DataWidths(col) = ColWidths(col) Else ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip End If Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth DataWidths(col) = 0 If arrDateColumns(col) = False Then If ColumnDataTypes(col) = "XL2Age" Then DataWidths(col) = fAgeWidth + ExtraWidth Else If MaxColumnWidths(col) > -1 Then 'as column will be hidden If col = 0 Then Dim strMaxColString As String For Each str As String In oMap.Keys If ColumnDataTypes(col) = "BeforeSpace" Then lSpacePos = str.IndexOf(" ") If lSpacePos > -1 Then str = str.SubString2(0, lSpacePos - 1) 'get the real final text width End If End If ' If str <> Null Then ' DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If If str <> Null Then If str.Length > strMaxColString.Length Then strMaxColString = str End If End If Next DataWidths(col) = cvs.MeasureStringWidth(strMaxColString, Typeface.DEFAULT, cTextSize) + ExtraWidth Else Dim strMaxColString As String For Each str As String In oMap.Values If ColumnDataTypes(col) = "BeforeSpace" Then lSpacePos = str.IndexOf(" ") If lSpacePos > -1 Then str = str.SubString2(0, lSpacePos - 1) 'get the real final text width End If End If ' If str <> Null Then ' DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If If str <> Null Then If str.Length > strMaxColString.Length Then strMaxColString = str End If End If Next DataWidths(col) = cvs.MeasureStringWidth(strMaxColString, Typeface.DEFAULT, cTextSize) + ExtraWidth End If End If End If Else'If arrDateColumns(col) = False If ColumnDataTypes(col) = "Ticks_Date" Then DataWidths(col) = fTicksDateWidth + ExtraWidth Else DataWidths(col) = fDateWidth + ExtraWidth End If End If 'If ColumnDataTypes(col) <> "XD" And ColumnDataTypes(col) <> "Ticks_Date" ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next 'col SetHeader(Headers) SetColumnsWidths(ColumnWidths) SV2.VerticalScrollPosition = 0 If bArrayAsValues Then For Each oKey As Object In oMap.Keys Dim R(iCols) As String If oKey = Null Then 'Otherwise Null will show in the view R(0) = "" Else 'If strKey = Null 'deal with the map keys '---------------------- Select ColumnDataTypes(0) Case "I", "R", "T" R(0) = oKey Case "XL2Age" R(0) = General.ExcelDate2Age(CLng(oKey)) Case "XD" R(0) = General.ExcelDate2String(CLng(oKey)) arrLongDates0(i) = oKey Case "Ticks_Date" 'all date-time values are stored as seconds since 01/01/1970 midnight (not ticks) R(0) = General.Ticks2String(CLng(oKey), "dd/MM/yyyy HH:mm", True) arrLongDates0(i) = oKey Case "BeforeSpace" lSpacePos = oKey.As(String).IndexOf(" ") If lSpacePos > -1 Then R(0) = oKey.As(String).SubString2(0, lSpacePos) Else R(0) = oKey End If Case Else '"BLOB" R(0) = "" End Select End If 'If strKey = Null 'deal with the map values '------------------------ If iCols > 1 Then Select Case iArrayType Case 0 arrByte = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrByte(col - 1) Next Case 2 arrInt = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrInt(col - 1) Next Case 3 arrLong = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrLong(col - 1) Next Case 4 arrFloat = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrFloat(col - 1) Next Case 5 arrDouble = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrDouble(col - 1) Next Case 7 arrString = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrString(col - 1) Next Case 8 arrObject = oMap.Get(oKey) For col = 1 To iCols - 1 R(col) = arrObject(col - 1) Next End Select End If AddRow(R) i = i + 1 Next Else 'If bArrayAsValues For Each oKey As Object In oMap.Keys Dim R(iCols) As String If oKey = Null Then 'Otherwise Null will show in the table R(0) = "" Else 'deal with the map keys '---------------------- Select ColumnDataTypes(0) Case "I", "R", "T" R(0) = oKey Case "XD" R(0) = General.ExcelDate2String(oKey.As(Int)) arrLongDates0(i) = oKey Case "XL2Age" R(0) = General.ExcelDate2Age(CLng(oKey)) Case "Ticks_Date" R(0) = General.Ticks2String(CLng(oKey), "dd/MM/yyyy HH:mm", True) arrLongDates0(i) = oKey Case "BeforeSpace" lSpacePos = oKey.As(String).IndexOf(" ") If lSpacePos > -1 Then R(0) = oKey.As(String).SubString2(0, lSpacePos) Else R(0) = oKey End If Case Else '"BLOB" R(0) = "" If iCols > 1 Then R(1) = "" End If End Select 'deal with the map values '------------------------ If iCols > 1 Then Select Case ColumnDataTypes(1) Case "I", "R", "T" R(1) = oMap.Get(oKey) Case "XL2Age" R(1) = General.ExcelDate2Age(CLng(oMap.Get(oKey))) Case "XD" R(1) = General.ExcelDate2String(CLng(oMap.Get(oKey))) Case "Ticks_Date" R(1) = General.Ticks2String(CLng(oMap.Get(oKey)), "dd/MM/yyyy HH:mm", True) Case "BeforeSpace" strValue = oMap.Get(oKey) lSpacePos = strValue.IndexOf(" ") If lSpacePos > -1 Then R(1) = strValue.SubString2(0, lSpacePos) Else R(1) = strValue End If Case Else R(1) = "" End Select End If End If AddRow(R) i = i + 1 'this is needed for arrLongDates0 and arrLongDates1 Next End If 'If bArrayAsValues If bDateColumn Then mapLongDates.Initialize End If If arrDateColumns(0) Then mapLongDates.Put(0, arrLongDates0) End If If iCols > 1 Then If arrDateColumns(1) Then mapLongDates.Put(1, arrLongDates1) End If End If RefreshTable End Sub Public Sub LoadSQLiteDBFrom1DStringArray(arrString() As String, _ strColumnName As String, _ iColWidth As Int, _ strColumnDataType As String) Dim i As Long Dim bColWidthsSupplied As Boolean Dim bDateColumn As Boolean Dim fAgeWidth As Float Dim fDateWidth As Float Dim fTicksDateWidth As Float Dim iSpacePos As Int DateTime.DateFormat = General.strTableDateFormat bMap = False Dim strColumnDataTypes(1) As String Dim cColumnDataType(1) As String 'note that data types as data column boolean are needed for all cursor columns as they may be needed for sorting! '---------------------------------------------------------------------------------------------------------------- Select strColumnDataType Case "I", "I_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "I" Case "R", "R_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "R" Case "T", "T_S" cColumnDataType(0) = "TEXT" strColumnDataTypes(0) = "T" Case "XL2Age", "XL2Age_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "I" fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) Case "XD", "XD_S" bDateColumn = True cColumnDataType(0) = "TEXT" arrDateColumns(0) = True strColumnDataTypes(0) = "I" fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) Dim arrLongDates0(arrString.Length) As Long Case "Ticks_Date", "Ticks_Date_S" bDateColumn = True cColumnDataType(0) = "TEXT" arrDateColumns(0) = True strColumnDataTypes(0) = "I" fTicksDateWidth = cvs.MeasureStringWidth("24/12/2014 12:55", Typeface.DEFAULT, cTextSize) Dim arrLongDates0(arrString.Length) As Long Case "YEAR", "YEAR_S", "MONTH", "MONTH_S", "DAY", "DAY_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "I" Case "BeforeSpace", "BeforeSpace_S" cColumnDataType(0) = "TEXT" strColumnDataTypes(0) = "T" Case Else '"BLOB" cColumnDataType(0) = "TEXT" strColumnDataTypes(0) = "T" End Select SetArrColumnsSorted(1) 'to keep track of the columns that have been sorted so have the sort types set iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) SetupColourArrays(arrString.Length, 0) bColWidthsSupplied = iColWidth > -1 cAutomaticWidths = iColWidth = -1 innerClearAll(1, True) Dim Headers(1) As String Dim ColumnWidths(1) As Int Dim HeaderWidths(1) As Int Dim DataWidths(1) As Int Dim cColumnDataType(1) As String 'as this may be needed for sorting although it may not be displayed! Dim arrDateColumns(1) As Boolean 'as this may be needed for sorting although it may not be displayed! Dim lRows As Long lRows = arrString.Length 'note that data types as data column boolean are needed for all cursor columns as they may be needed for sorting! '---------------------------------------------------------------------------------------------------------------- cColumnDataType(0) = "TEXT" Headers(0) = strColumnName If cAutomaticWidths = False Then If bColWidthsSupplied Then ColumnWidths(0) = iColWidth HeaderWidths(0) = iColWidth DataWidths(0) = iColWidth Else ColumnWidths(0) = 130dip HeaderWidths(0) = 130dip DataWidths(0) = 130dip End If Else HeaderWidths(0) = cvs.MeasureStringWidth(Headers(0), Typeface.DEFAULT, cTextSize) + ExtraWidth DataWidths(0) = 0 If arrDateColumns(0) = False Then If strColumnDataType = "XL2Age" Then DataWidths(0) = fAgeWidth + ExtraWidth Else Dim strMaxColString As String For i = 0 To arrString.Length - 1 If strColumnDataType = "BeforeSpace" Then iSpacePos = arrString(i).IndexOf(" ") If iSpacePos > -1 Then arrString(i) = arrString(i).SubString2(0, iSpacePos - 1) 'get the real final text width End If End If ' If arrString(i) <> Null Then ' DataWidths(0) = Max(DataWidths(0), cvs.MeasureStringWidth(arrString(i), Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If If arrString(i) <> Null Then If arrString(i).Length > strMaxColString Then strMaxColString = arrString(i) End If End If Next DataWidths(0) = cvs.MeasureStringWidth(strMaxColString, Typeface.DEFAULT, cTextSize) + ExtraWidth End If Else'If arrDateColumns(col) = False If strColumnDataType = "Ticks_Date" Then DataWidths(0) = fTicksDateWidth + ExtraWidth Else DataWidths(0) = fDateWidth + ExtraWidth End If End If 'If ColumnDataTypes(col) <> "XD" And ColumnDataTypes(col) <> "Ticks_Date" ColumnWidths(0) = Max(HeaderWidths(0), DataWidths(0)) End If ColumnWidths(0) = DataWidths(0) HeaderWidths(0) = DataWidths(0) SetHeader(Headers) SetColumnsWidths(ColumnWidths) SV2.VerticalScrollPosition = 0 For i = 0 To lRows - 1 Dim R(1) As String If arrString(i) = Null Then 'Otherwise Null will show in the view R(0) = "" Else Select strColumnDataType Case "I" R(0) = CLng(arrString(i)) Case "R" R(0) = arrString(i) Case "T" R(0) = arrString(i) Case "XL2Age" R(0) = General.ExcelDate2Age(CInt(arrString(i))) Case "XD" R(0) = General.ExcelDate2String(CInt(arrString(i))) arrLongDates0(0) = arrString(i) Case "Ticks_Date" 'all date-time values are stored as seconds since 01/01/1970 midnight (not ticks) R(0) = General.Ticks2String(CLng(arrString(i)), "dd/MM/yyyy HH:mm", True) arrLongDates0(i) = arrString(i) Case "BeforeSpace" If iSpacePos > -1 Then R(0) = arrString(i).SubString2(0, iSpacePos) Else R(0) = arrString(i) End If Case Else '"BLOB" R(0) = "" End Select End If AddRow(R) Next If bDateColumn Then mapLongDates.Initialize End If If arrDateColumns(0) Then mapLongDates.Put(0, arrLongDates0) End If RefreshTable End Sub Public Sub LoadSQLiteDBFromList(oList As List, _ ColumnNames() As String, _ ColumnDataTypes() As String, _ ColWidths() As Int) Dim i As Long Dim lSpacePos As Long Dim bColWidthsSupplied As Boolean Dim fTicksDateWidth As Float Dim fAgeWidth As Float Dim fDateWidth As Float DateTime.DateFormat = General.strTableDateFormat bMap = False SetArrColumnsSorted(1) 'to keep track of the columns that have been sorted so have the sort types set iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) SetupColourArrays(oList.Size, 0) If ColWidths <> Null Then bColWidthsSupplied = ColWidths(0) > 0 End If 'strColumnDataTypes is module private variable 'note we need to accomodate all cursor columns, so even if column is skipped! '---------------------------------------------------------------------------- Dim strColumnDataTypes(1) As String cAutomaticWidths = bColWidthsSupplied = False innerClearAll(1, True) Dim Headers(1) As String Dim ColumnWidths(1) As Int Dim HeaderWidths(1) As Int Dim DataWidths(1) As Int Dim cColumnDataType(1) As String 'as this may be needed for sorting although it may not be displayed! Dim arrDateColumns(1) As Boolean 'as this may be needed for sorting although it may not be displayed! Dim str As String Dim lRows As Long Dim bDateColumn As Boolean lRows = oList.Size 'note that data types as data column boolean are needed for all cursor columns as they may be needed for sorting! '---------------------------------------------------------------------------------------------------------------- Select ColumnDataTypes(0) Case "I", "I_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "I" Case "R", "R_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "R" Case "T", "T_S" cColumnDataType(0) = "TEXT" strColumnDataTypes(0) = "T" Case "XL2Age", "XL2Age_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "I" fAgeWidth = cvs.MeasureStringWidth("122", Typeface.DEFAULT, cTextSize) Case "XD", "XD_S" cColumnDataType(0) = "TEXT" arrDateColumns(0) = True strColumnDataTypes(0) = "I" Dim arrLongDates(oList.Size) As Long bDateColumn = True fDateWidth = cvs.MeasureStringWidth(General.strTableDateExample, Typeface.DEFAULT, cTextSize) Case "Ticks_Date", "Ticks_Date_S" cColumnDataType(0) = "TEXT" arrDateColumns(0) = True strColumnDataTypes(0) = "I" Dim arrLongDates(oList.Size) As Long bDateColumn = True fTicksDateWidth = cvs.MeasureStringWidth("24/12/2014 12:55", Typeface.DEFAULT, cTextSize) Case "YEAR", "YEAR_S", "MONTH", "MONTH_S", "DAY", "DAY_S" cColumnDataType(0) = "NUMBER" strColumnDataTypes(0) = "I" Case "BeforeSpace", "BeforeSpace_S" cColumnDataType(0) = "TEXT" strColumnDataTypes(0) = "T" Case Else '"BLOB" cColumnDataType(0) = "TEXT" strColumnDataTypes(0) = "T" End Select Headers(0) = ColumnNames(0) If cAutomaticWidths = False Then If bColWidthsSupplied Then ColumnWidths(0) = ColWidths(0) HeaderWidths(0) = ColWidths(0) DataWidths(0) = ColWidths(0) Else ColumnWidths(0) = 130dip HeaderWidths(0) = 130dip DataWidths(0) = 130dip End If Else HeaderWidths(0) = cvs.MeasureStringWidth(Headers(0), Typeface.DEFAULT, cTextSize) + ExtraWidth If arrDateColumns(0) = False Then If ColumnDataTypes(0) = "XL2Age" Then DataWidths(0) = fAgeWidth + ExtraWidth Else Dim strMaxColString As String For i = 0 To lRows - 1 str = oList.Get(i) ' fDataWidth = cvs.MeasureStringWidth(oList.Get(i),Typeface.DEFAULT, cTextSize) + ExtraWidth ' If fDataWidth > DataWidths(0) Then ' DataWidths(0) = fDataWidth ' End If If str <> Null Then If str.Length > strMaxColString.Length Then strMaxColString = str End If End If Next DataWidths(0) = cvs.MeasureStringWidth(strMaxColString,Typeface.DEFAULT, cTextSize) + ExtraWidth End If Else'If arrDateColumns(col) = False If ColumnDataTypes(0) = "Ticks_Date" Then DataWidths(0) = fTicksDateWidth + ExtraWidth Else DataWidths(0) = fDateWidth + ExtraWidth End If End If 'If ColumnDataTypes(col) <> "XD" And ColumnDataTypes(col) <> "Ticks_Date" ColumnWidths(0) = Max(HeaderWidths(0), DataWidths(0)) End If Dim arrDataTypesX(mNumberOfColumns) As String For c = 0 To mNumberOfColumns - 1 arrDataTypesX(c) = ColumnDataTypes(c) Next SetHeader(Headers) SetColumnsWidths(ColumnWidths) SV2.VerticalScrollPosition = 0 For i = 0 To lRows - 1 Dim R(1) As String str = oList.Get(i) If str = Null Then 'Otherwise Null will show in the view R(0) = "" Else Select ColumnDataTypes(0) Case "I" R(0) = CLng(str) Case "R" R(0) = str Case "T" R(0) = str Case "XL2Age" R(0) = General.ExcelDate2Age(CInt(str)) Case "XD" R(0) = General.ExcelDate2String(CInt(str)) arrLongDates(i) = str Case "Ticks_Date" 'all date-time values are stored as seconds since 01/01/1970 midnight (not ticks) R(0) = General.Ticks2String(CLng(str), "dd/MM/yyyy HH:mm", True) Case "BeforeSpace" lSpacePos = str.IndexOf(" ") If lSpacePos > -1 Then R(0) = str.SubString2(0, lSpacePos) Else R(0) = str End If Case Else '"BLOB" R(0) = "" End Select End If '-------------- AddRow(R) Next If bDateColumn Then mapLongDates.Initialize mapLongDates.Put(0, arrLongDates) End If RefreshTable End Sub Sub CLng(o As Object) As Long Try Return Floor(o) Catch Return 0 End Try End Sub Sub CInt(o As Object) As Int Try Return Floor(o) Catch Return 0 End Try End Sub Sub CDbl(o As Object) As Double 'ignore Try Return o Catch Return 0 End Try End Sub Sub ClearStringNull(strNull As String, strReplace As String) As String If strNull <> Null Then Return strNull Else Return strReplace End If End Sub Public Sub RemoveView pnlTable.RemoveView End Sub Private Sub SetPadding(v As View, Left As Int, Top As Int, Right As Int, Bottom As Int) Dim r As Reflector r.Target = v r.RunMethod4("setPadding", Array As Object(Left, Top, Right, Bottom), Array As String("java.lang.int", "java.lang.int", "java.lang.int", "java.lang.int")) End Sub 'A Header click sorts the selected column If SortColum = True Public Sub setSortColumn(SortColumn As Boolean) cSortColumn = SortColumn End Sub Public Sub getSortColumn As Boolean Return cSortColumn End Sub 'Uses different column colors insted of different row colors if UseColumnColors = True Public Sub setUseColumnColors(UseColumnColors As Boolean) cUseColumnColors = UseColumnColors If cColumnColors.Length = 0 Then Dim i As Int Dim cColumnColors(mNumberOfColumns) As Int Dim cTextColors(mNumberOfColumns) As Int For i = 0 To mNumberOfColumns - 1 If i Mod 2 = 0 Then cColumnColors(i) = cRowColor1 Else cColumnColors(i) = cRowColor2 End If cTextColors(i) = cTextColor Next End If If cHeaderColors.Length = 0 Then Dim i As Int Dim cHeaderColors(mNumberOfColumns) As Int Dim cHeaderTextColors(mNumberOfColumns) As Int For i = 0 To mNumberOfColumns - 1 cHeaderColors(i) = cHeaderColor cHeaderTextColors(i) = cHeaderTextColor Next End If End Sub Public Sub getUseColumnColors As Boolean Return cUseColumnColors End Sub 'Sets the colors for each column Public Sub SetColumnColors(ColumnColors() As Int) cColumnColors = ColumnColors End Sub Public Sub GetColumnColors As Int() Return cColumnColors End Sub 'Sets the colors for the text in each column Public Sub SetTextColors(TextColors() As Int) cTextColors = TextColors End Sub Public Sub GetTextColors As Int() Return cTextColors End Sub 'Sets the colors for each Header Public Sub SetHeaderColors(HeaderColors() As Int) cHeaderColors = HeaderColors End Sub Public Sub GetHeaderColors As Int() Return cHeaderColors End Sub 'Sets the colors for each Header text Public Sub SetHeaderTextColors(HeaderTextColors() As Int) cHeaderTextColors = HeaderTextColors End Sub Public Sub GetHeaderTextColors As Int() Return cHeaderTextColors End Sub Public Sub getHeaderTypeFace As Typeface Return cHeaderTypeFace End Sub 'Sets or gets the same TypeFace for all Header texts Public Sub setHeaderTypeFace(HeaderTypeFace As Typeface) cHeaderTypeFace = HeaderTypeFace HeaderMultiTypeFace = False If Header.NumberOfViews > 0 Then For col = 0 To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col) lbl.Typeface = cHeaderTypeFace Next End If End Sub 'Sets the TypeFace for each Header text Public Sub SetHeaderTypeFaces(HeaderTypeFaces() As Typeface) Private col As Int If HeaderTypeFaces.Length = 1 Then cHeaderTypeFace = HeaderTypeFaces(0) HeaderMultiTypeFace = False If Header.NumberOfViews > 0 Then If mNumberOfFixedColumns = 0 Then For col = 0 To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col) lbl.Typeface = cHeaderTypeFace Next Else Private lbl As Label lbl = HeaderFirst.GetView(0) lbl.Typeface = cHeaderTypeFaces(0) For col = 0 To mNumberOfColumns - 2 Private lbl As Label lbl = Header.GetView(col) lbl.Typeface = cHeaderTypeFace Next End If End If Else If HeaderTypeFaces.Length <> mNumberOfColumns Then ToastMessageShow("Invalid number of columns", False) Log("SetHeaderTypeFaces: Invalid number of columns") Return Else cHeaderTypeFaces0 = HeaderTypeFaces cHeaderTypeFaces = cHeaderTypeFaces0 HeaderMultiTypeFace = True If Header.NumberOfViews > 0 Then If mNumberOfFixedColumns = 0 Then For col = 0 To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col) lbl.Typeface = cHeaderTypeFaces(col) Next Else For i = 0 To mNumberOfFixedColumns - 1 Private lbl As Label lbl = HeaderFirst.GetView(i) lbl.Typeface = cHeaderTypeFaces(i) Next For col = 0 To mNumberOfColumns - mNumberOfFixedColumns - 1 Private lbl As Label lbl = Header.GetView(col) lbl.Typeface = cHeaderTypeFaces(col + mNumberOfFixedColumns - 1) Next End If End If End If End If End Sub 'True sets the cells to single line Public Sub setSingleLine(SingleLine As Boolean) Private row, col As Int cSingleLine = SingleLine If LabelsCache.Size > 0 Then For row = 0 To LabelsCache.Size - 1 Private lbls(mNumberOfColumns) As Label lbls = LabelsCache.Get(row) For col = 0 To mNumberOfColumns - 1 Private jo As JavaObject jo = lbls(col) jo.RunMethod("setSingleLine", Array(cSingleLine)) Next Next End If End Sub Public Sub getSingleLine As Boolean Return cSingleLine End Sub Public Sub SetAutomaticWidths Dim row, col As Int Dim Vals(mNumberOfColumns) As String Dim Width, Widths(mNumberOfColumns) As Int cAutomaticWidths = True For col = 0 To mNumberOfColumns - 1 If MultiTypeFace = False Then Widths(col) = cvs.MeasureStringWidth(HeaderNames.Get(col), cTypeFace, cTextSize) + ExtraWidth Else Widths(col) = cvs.MeasureStringWidth(HeaderNames.Get(col), cTypeFaces(col), cTextSize) + ExtraWidth End If For row = 0 To Data.Size - 1 Vals = Data.Get(row) If MultiTypeFace = False Then Width = cvs.MeasureStringWidth(Vals(col), cTypeFace, cTextSize) + ExtraWidth Else Width = cvs.MeasureStringWidth(Vals(col), cTypeFaces(col), cTextSize) + ExtraWidth End If If Widths(col) < Width Then Widths(col) = Width End If Next Next SetColumnsWidths(Widths) End Sub 'True shows the status line at the bottom Public Sub setShowStatusLine(ShowStatusLine As Boolean) cShowStatusLine = ShowStatusLine If cShowStatusLine = True Then SV2.Height = cHeight - Header.Height - cRowHeight lblStatusLine.Visible = True Else SV2.Height = cHeight - Header.Height lblStatusLine.Visible = False End If SVF.Height = SV2.Height End Sub Public Sub setStatusLine(s As String) If (lblStatusLine.IsInitialized) Then lblStatusLine.Text = s End Sub Public Sub getShowStatusLine As Boolean Return cShowStatusLine End Sub 'Gets the base Panel of the Table Public Sub getPanel As Panel Try Return pnlTable '<<<<<<<<< java.lang.NumberFormatException: For input string: "null" Catch Return Null End Try End Sub 'Scales the Table with the two scale factors. 'This routine is useful with Scale Module. ' It must be called before filling the Table. 'ScaleX = horizontal sclae factor 'ScaleY = Vertical sclae factor 'ScaleAllDone = True if ScaleAll of the Scale Module was already used 'ScaleAllDone = False if ScaleAll of the Scale Module was not used Public Sub ScaleTable(ScaleX As Double, ScaleY As Double, ScaleAllDone As Boolean) If Data.Size = 0 Then ToastMessageShow("Table.ScaleTAble must be called before filling the Table", False) Log("Table.ScaleTable must be called before filling the Table") Return End If cTextSize = cTextSize * Min(ScaleX, ScaleY) cLineWidth = cLineWidth * ScaleX ExtraWidth = ExtraWidth * ScaleX cRowHeight = cRowHeight * ScaleY cHeaderHeight = cHeaderHeight * ScaleY For i = 0 To mNumberOfColumns - 1 ColumnWidths(i) = ColumnWidths(i) * ScaleX DataWidths(i) = DataWidths(i) * ScaleX HeaderWidths(i) = HeaderWidths(i) * ScaleX SavedWidths(i) = SavedWidths(i) * ScaleX Next If ScaleAllDone = False Then cLeft = cLeft * ScaleX cTop = cTop * ScaleY cWidth = cWidth * ScaleX cHeight = cHeight * ScaleY pnlTable.Left = cLeft pnlTable.Top = cTop pnlTable.Width = cWidth pnlTable.Height = cHeight Header.Height = cHeaderHeight SV2.Width = cWidth SV2.Top = cHeaderHeight If (cShowStatusLine = True) Then SV2.Height = cHeight - cRowHeight - cHeaderHeight Else SV2.Height = cHeight - cHeaderHeight End If lblStatusLine.TextSize = cTextSize lblStatusLine.Height = cRowHeight lblStatusLine.Top = SV2.Top + SV2.Height End If CreateNewLabels End Sub 'Gets or sets the Table Tag Public Sub setTag(Tag As Object) pnlTable.Tag = Tag End Sub Public Sub getTag As Int Return pnlTable.Tag End Sub 'sets the data type of a column 'Col = index of the column 'DataType can be either "TEXT" or "NUMBER" Public Sub SetColumnDataType(Col As Int, DataType As String) If Col < 0 Or Col > mNumberOfColumns - 1 Then ToastMessageShow("Wrong column index", False) Return End If If DataType <> "TEXT" And DataType <> "NUMBER" Then ToastMessageShow("Wrong data type only TEXT abd NUMBER are allowed", False) Return End If cColumnDataType(Col) = DataType End Sub 'sets the data type of all columns 'Col = index of the column 'DataType() array, can be either "TEXT" or "NUMBER" 'Example: 'SetColumnDataTypes(Array As String("NUMBER", "TEXT", "TEXT", "TEXT", "NUMBER") Public Sub SetColumnDataTypes(DataType() As String) If DataType.Length <> mNumberOfColumns Then ToastMessageShow("Wrong number of columns", False) Return End If For Col = 0 To mNumberOfColumns - 1 If DataType(Col) <> "TEXT" And DataType(Col) <> "NUMBER" Then ToastMessageShow("Wrong data type only TEXT abd NUMBER are allowed", False) Return End If Next cColumnDataType = DataType End Sub 'gets the number of columns, read only Public Sub getNumberOfColumns As Int Return mNumberOfColumns End Sub 'gets the number of rowsolumns, read only Public Sub getNumberOfRows As Int Return Data.Size End Sub 'gets or sets the SortRemoveAccents property 'Sorts without accented characters. 'Removes the accents for a correct sorting. 'This can slow down the sorting. Public Sub getSortRemoveAccents As Boolean Return cSortRemoveAccents End Sub Public Sub setSortRemoveAccents(SortRemoveAccents As Boolean) cSortRemoveAccents = SortRemoveAccents End Sub 'returns a new string without accented characters Private Sub RemoveAccents(s As String) As String 'ignore warning Dim normalizer As JavaObject normalizer.InitializeStatic("java.text.Normalizer") Dim n As String = normalizer.RunMethod("normalize", Array As Object(s, "NFD")) Dim sb As StringBuilder sb.Initialize For i = 0 To n.Length - 1 If Regex.IsMatch("\p{InCombiningDiacriticalMarks}", n.CharAt(i)) = False Then sb.Append(n.CharAt(i)) End If Next Return sb.ToString End Sub 'sets or gets the color of the sort width 'should be an even value in dips Public Sub setSortBitmapWidth(Width As Int) cSortBitmapWidth = Width InitializeSortingBitmaps End Sub Public Sub getSortBitmapWidth As Int Return cSortBitmapWidth End Sub 'sets or gets the color of the sort bitmaps Public Sub setSortBitmapColor(Color As Int) cSortBitmapColor = Color InitializeSortingBitmaps End Sub Public Sub getSortBitmapColor As Int Return cSortBitmapColor End Sub 'sets the two custom sorting Bitmaps. 'the files must be in the Files folder 'the default width of the parent view is 10dip 'this value is the SortBitmapWidth property. 'the height of the parent view is half the width, set internally. 'the SortBitmapColor property has no effect with custom bitmaps. Public Sub SetSortingBitmaps(BitmapAscFilename As String, BitmapDesFilename As String) bmpAsc.Initialize(File.DirAssets, BitmapAscFilename) bmpDes.Initialize(File.DirAssets, BitmapDesFilename) mCustomSortingBitmaps = True End Sub 'loads an excel sheet into the Table 'Dir = directory of the excel file 'FileName = excel file name 'AutomaticWidths True > set the column widths automaticaly 'the code is commented to avoid the need to add the Excel library! 'to use it uncomment the lines. Public Sub LoadExcel(oXLWorkSheet As ReadableSheet, ColWidths() As Int, ColumnDataTypes() As String) Dim Col As Int Dim row As Int Dim strHeaders() As String Dim bColumnDataTypesSupplied As Boolean Dim bDateColumn As Boolean Dim UB As Int Dim UB2 As Int Dim bColourArray As Boolean Dim iFirstColumnWidth As Int 'Dim iMaxColumnLen As Int 'Dim strMaxColumnString As String Dim iSheetRowCount As Int = oXLWorkSheet.RowsCount DateTime.DateFormat = General.strTableDateFormat bColumnDataTypesSupplied = ColumnDataTypes(0).Length > 0 cAutomaticWidths = ColWidths(0) = 0 mNumberOfColumns = oXLWorkSheet.ColumnsCount + 1 'as we are adding the row number in column one UB = iSheetRowCount - 2 'Sheet1.RowsCount includes the header row! UB2 = mNumberOfColumns - 1 'add one as we are putting the row number in column one as in the desktop XL '--------------------------------------------------------------------------- Dim strHeaders(mNumberOfColumns) As String Dim strColumnDataTypes(mNumberOfColumns) As String strColumnDataTypes(0) = "I" 'as that will hold the row numbers SetArrColumnsSorted(mNumberOfColumns) 'to keep track of the columns that have been sorted If General.mapAlteredTableRowColour.IsInitialized Then iAlteredRowColour = General.mapAlteredTableRowColour.GetDefault(TableObject.Panel.Tag, -1) bColourArray = True Else iAlteredRowColour = -1 End If If General.mapAlteredTableTextColour.IsInitialized Then iAlteredTextColour = General.mapAlteredTableTextColour.GetDefault(TableObject.Panel.Tag, -1) bColourArray = True Else iAlteredTextColour = -1 End If If bColourArray Then SetupColourArrays(UB, 0) End If 'get the field names, skip the first column as that will have the row number with no field name '---------------------------------------------------------------------------------------------- For c = 1 To UB2 strHeaders(c) = oXLWorkSheet.GetCellValue(c - 1, 0) Next 'pick up data types from field names or list data types '------------------------------------------------------ If bColumnDataTypesSupplied = False Then Dim ColumnDataTypes(mNumberOfColumns) As String ColumnDataTypes(0) = "I" 'this will be first column, showing row numbers For Col = 1 To UB2 If strHeaders(Col).ToLowerCase.IndexOf("date_time") > -1 Then ColumnDataTypes(Col) = "Ticks_Date" Else If strHeaders(Col).ToLowerCase.IndexOf("date") > -1 Or _ strHeaders(Col).ToLowerCase.IndexOf("dob") > -1 Then ColumnDataTypes(Col) = "XD" End If End If Next ColumnDataTypes = GetDataTypesFromSheet(oXLWorkSheet, True, ColumnDataTypes) End If Dim arrDataTypesX(mNumberOfColumns) As String For c = 0 To mNumberOfColumns - 1 arrDataTypesX(c) = ColumnDataTypes(c) Next innerClearAll(mNumberOfColumns, True) Dim Headers(mNumberOfColumns) As String Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String Dim arrDateColumns(mNumberOfColumns) As Boolean SetArrColumnsSorted(mNumberOfColumns) 'to keep track of the columns that have been sorted 'check how to sort '----------------- For Col = 0 To UB2 strColumnDataTypes(Col) = cColumnDataType(Col) Select ColumnDataTypes(Col) Case "I" cColumnDataType(Col) = "NUMBER" Case "R" cColumnDataType(Col) = "NUMBER" Case "T" cColumnDataType(Col) = "TEXT" Case "XL2Age" cColumnDataType(Col) = "NUMBER" Case "XD" cColumnDataType(Col) = "TEXT" arrDateColumns(Col) = True bDateColumn = True Case "Ticks_Date" cColumnDataType(Col) = "TEXT" arrDateColumns(Col) = True bDateColumn = True Case "BeforeSpace" cColumnDataType(Col) = "TEXT" Case Else '"BLOB" cColumnDataType(Col) = "TEXT" End Select Next 'to sort dates shown as text as integers '--------------------------------------- If bDateColumn Then mapLongDates.Initialize For Col = 1 To UB2 'skip column 0 as that will just have the row numbers If arrDateColumns(Col) = True Then Dim arrLongDates(UB + 1) As Long 'need new Dim to add to mapLongDates !! 'row 0 is for the headers! For row = 1 To iSheetRowCount - 1 'sheet row count starts at 0 !! arrLongDates(row - 1) = oXLWorkSheet.GetCellValue(Col - 1, row) Next mapLongDates.Put(Col, arrLongDates) End If Next End If 'transfer sheet to string array, doing conversions, note arrCSV holds converted string dates! '-------------------------------------------------------------------------------------------- Dim arrCSV(UB + 1, UB2 + 1) As String 'UB2 had already one added for the extra first column! 'reading from the sheet is very fast and no benefit trying to avoid that repeatedly '---------------------------------------------------------------------------------- For Col = 1 To UB2 'skip the first column as that will just have the consecutive row numbers If ColumnDataTypes(Col) = "XD" Then Dim arrLong() As Long arrLong = mapLongDates.Get(Col) For row = 0 To UB arrCSV(row, Col) = General.ExcelDate2String(arrLong(row)) Next Else If ColumnDataTypes(Col) = "Ticks_Date" Then Dim arrLong() As Long arrLong = mapLongDates.Get(Col) For row = 0 To UB arrCSV(row, Col) = General.Ticks2String(arrLong(row), "dd/MM/yyyy HH:mm", True) Next Else For row = 1 To iSheetRowCount - 1 'sheet row count starts at 0 !! arrCSV(row - 1, Col) = oXLWorkSheet.GetCellValue(Col - 1, row) Next End If End If Next 'these are the row numbers that will show in the first column For row = 0 To UB arrCSV(row, 0) = row + 1 Next strColumnDataTypes(0) = "I" 'as that will hold the row numbers For Col = 1 To UB2 'skip the first column as that will show the row number with data type I strColumnDataTypes(Col) = ColumnDataTypes(Col) Next 'determine the column widths '--------------------------- For Col = 1 To UB2 'skip the first column as that will have consecutive row numbers Headers(Col) = strHeaders(Col) If cAutomaticWidths = False Then ColumnWidths(Col) = 130dip HeaderWidths(Col) = 130dip DataWidths(Col) = 130dip Else HeaderWidths(Col) = cvs.MeasureStringWidth(Headers(Col), Typeface.DEFAULT, cTextSize) + ExtraWidth General.StartSW(5) Dim strColumnString As String 'this is a lot faster than measuring the string width for every string in the column '----------------------------------------------------------------------------------- For row = 1 To UB If arrCSV(row, Col).Length > strColumnString.Length Then strColumnString = arrCSV(row, Col) End If Next DataWidths(Col) = cvs.MeasureStringWidth(strColumnString, Typeface.DEFAULT, cTextSize) + ExtraWidth 'Log("determine column data width: " & General.FormatMilliSecs(General.StopSW(5))) ColumnWidths(Col) = Max(HeaderWidths(Col), DataWidths(Col)) End If Next iFirstColumnWidth = cvs.MeasureStringWidth(CStr(UB + 1), Typeface.DEFAULT, cTextSize) + ExtraWidth HeaderWidths(0) = iFirstColumnWidth DataWidths(0) = iFirstColumnWidth ColumnWidths(0) = iFirstColumnWidth SetHeader(Headers) SetColumnsWidths(ColumnWidths) 'add the table rows '------------------ For row = 0 To UB Dim R(mNumberOfColumns) As String For Col = 0 To UB2 R(Col) = arrCSV(row, Col) Next AddRow(R) Next RefreshTable End Sub Public Sub LoadCSV(Dir As String, FileName As String, strSeparator As String, AutomaticWidths As Boolean, ColumnDataTypes() As String) As Int Dim col As Int Dim row As Int Dim UB As Int Dim UB2 As Int Dim sUtils As StringUtils Dim lstCSV As List Dim sRow() As String Dim bColumnDataTypesSupplied As Boolean Dim bDateColumn As Boolean DateTime.DateFormat = General.strTableDateFormat bColumnDataTypesSupplied = ColumnDataTypes(0).Length > 0 '-------------------------------------------------------------------------- 'this can fail if the .csv is misformed, eg separator after the last column '-------------------------------------------------------------------------- lstCSV = sUtils.LoadCSV(Dir, FileName, strSeparator) If lstCSV.Size < 2 Then Return -1 End If sRow = lstCSV.Get(0) 'field names UB = lstCSV.Size - 2 'array ubound UB2 = sRow.Length - 1 'array ubound cAutomaticWidths = AutomaticWidths mNumberOfColumns = sRow.Length 'get the header names '-------------------- Dim Headers(mNumberOfColumns) As String For col = 0 To UB2 If Asc(sRow(col)) < 48 Then Return -1 End If Headers(col) = sRow(col) Next Dim strColumnDataTypes(mNumberOfColumns) As String SetArrColumnsSorted(mNumberOfColumns) 'to keep track of the columns that have been sorted so have the sort types set SetupColourArrays(UB, 1) 'pick up data types from field names or list data types '------------------------------------------------------ If bColumnDataTypesSupplied = False Then Dim ColumnDataTypes(mNumberOfColumns) As String For col = 0 To UB2 If sRow(col).ToLowerCase.IndexOf("date_time") > -1 Then ColumnDataTypes(col) = "Ticks_Date" Else If sRow(col).ToLowerCase.IndexOf("date") > -1 Or _ sRow(col).ToLowerCase.IndexOf("dob") > -1 Then ColumnDataTypes(col) = "XD" End If End If Next ColumnDataTypes = GetDataTypesFromList(lstCSV, True, ColumnDataTypes) End If innerClearAll(mNumberOfColumns, True) Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String Dim arrDateColumns(mNumberOfColumns) As Boolean 'check how to sort '----------------- For col = 0 To UB2 strColumnDataTypes(col) = cColumnDataType(col) Select ColumnDataTypes(col) Case "I" cColumnDataType(col) = "NUMBER" Case "R" cColumnDataType(col) = "NUMBER" Case "T" cColumnDataType(col) = "TEXT" Case "XL2Age" cColumnDataType(col) = "NUMBER" Case "XD" cColumnDataType(col) = "TEXT" arrDateColumns(col) = True bDateColumn = True Case "Ticks_Date" cColumnDataType(col) = "TEXT" arrDateColumns(col) = True bDateColumn = True Case "BeforeSpace" cColumnDataType(col) = "TEXT" Case Else '"BLOB" cColumnDataType(col) = "TEXT" End Select Next 'transfer list to string array '----------------------------- Dim arrCSV(UB + 1, UB2 + 1) As String For row = 0 To UB sRow = lstCSV.Get(row + 1) 'as row 1 is the header row For col = 0 To UB2 arrCSV(row, col) = ClearStringNull(sRow(col), "") Next Next 'to sort dates shown as text as integers '--------------------------------------- If bDateColumn Then mapLongDates.Initialize For col = 0 To UB2 If arrDateColumns(col) = True Then Dim arrLongDates(UB + 1) As Long For row = 0 To UB arrLongDates(row) = arrCSV(row, col) 'arrCSV doesn't include the header row Next mapLongDates.Put(col, arrLongDates) End If Next End If 'convert XL dates or date-time to text '------------------------------------- For col = 0 To UB2 If arrDateColumns(col) = True Then Dim arrLong() As Long arrLong = mapLongDates.Get(col) If ColumnDataTypes(col) = "XD" Then For row = 0 To UB arrCSV(row, col) = General.ExcelDate2String(arrLong(row)) Next Else If ColumnDataTypes(col) = "Ticks_Date" Then For row = 0 To UB arrCSV(row, col) = General.Ticks2String(arrLong(row), "dd/MM/yyyy HH:mm", True) Next End If End If End If Next 'determine the column widths '--------------------------- For col = 0 To UB2 If AutomaticWidths = False Then ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth For row = 1 To UB Dim strColumnString As String For row = 1 To UB If arrCSV(row, col).Length > strColumnString.Length Then strColumnString = arrCSV(row, col) End If Next Next DataWidths(col) = cvs.MeasureStringWidth(strColumnString, Typeface.DEFAULT, cTextSize) + ExtraWidth ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next For col = 0 To UB2 strColumnDataTypes(col) = ColumnDataTypes(col) Next SetHeader(Headers) SetColumnsWidths(ColumnWidths) 'need to do this after any column data change (eg dates) 'add the data rows '----------------- For row = 0 To UB Private values(UB2 + 1) As String For col = 0 To UB2 values(col) = arrCSV(row, col) Next AddRow(values) Next Return UB + 1 End Sub Sub CStr(o As Object) As String Return "" & o End Sub Public Sub LoadCSV2(lstCSV As List, AutomaticWidths As Boolean, ColumnDataTypes() As String) As Int Dim col As Int Dim row As Int Dim UB As Int Dim UB2 As Int Dim sRow() As Object 'Dim str As String Dim bColumnDataTypesSupplied As Boolean Dim bDateColumn As Boolean DateTime.DateFormat = General.strTableDateFormat bColumnDataTypesSupplied = ColumnDataTypes(0).Length > 0 If lstCSV.Size < 2 Then Return -1 End If sRow = lstCSV.Get(0) 'field names UB = lstCSV.Size - 2 'array ubound UB2 = sRow.Length - 1 'array ubound cAutomaticWidths = AutomaticWidths mNumberOfColumns = sRow.Length 'get the header names '-------------------- Dim Headers(mNumberOfColumns) As String For col = 0 To UB2 If Asc(sRow(col)) < 48 Then Return -1 End If Headers(col) = sRow(col) Next Dim strColumnDataTypes(mNumberOfColumns) As String SetArrColumnsSorted(mNumberOfColumns) 'to keep track of the columns that have been sorted so have the sort types set SetupColourArrays(UB, 1) 'pick up data types from field names or list data types '------------------------------------------------------ If bColumnDataTypesSupplied = False Then Dim ColumnDataTypes(mNumberOfColumns) As String For col = 0 To UB2 If CStr(sRow(col)).ToLowerCase.IndexOf("date_time") > -1 Then ColumnDataTypes(col) = "Ticks_Date" Else If CStr(sRow(col)).ToLowerCase.IndexOf("date") > -1 Or _ CStr(sRow(col)).ToLowerCase.IndexOf("dob") > -1 Then ColumnDataTypes(col) = "XD" End If End If Next ColumnDataTypes = GetDataTypesFromList(lstCSV, True, ColumnDataTypes) End If innerClearAll(mNumberOfColumns, True) Dim ColumnWidths(mNumberOfColumns) As Int Dim HeaderWidths(mNumberOfColumns) As Int Dim DataWidths(mNumberOfColumns) As Int Dim cColumnDataType(mNumberOfColumns) As String Dim arrDateColumns(mNumberOfColumns) As Boolean 'check how to sort '----------------- For col = 0 To UB2 strColumnDataTypes(col) = cColumnDataType(col) Select ColumnDataTypes(col) Case "I" cColumnDataType(col) = "NUMBER" Case "R" cColumnDataType(col) = "NUMBER" Case "T" cColumnDataType(col) = "TEXT" Case "XL2Age" cColumnDataType(col) = "NUMBER" Case "XD" cColumnDataType(col) = "TEXT" arrDateColumns(col) = True bDateColumn = True Case "Ticks_Date" cColumnDataType(col) = "TEXT" arrDateColumns(col) = True bDateColumn = True Case "BeforeSpace" cColumnDataType(col) = "TEXT" Case Else '"BLOB" cColumnDataType(col) = "TEXT" End Select Next 'transfer list to string array '----------------------------- Dim arrCSV(UB + 1, UB2 + 1) As String For row = 0 To UB sRow = lstCSV.Get(row + 1) 'as row 1 is the header row For col = 0 To UB2 arrCSV(row, col) = ClearStringNull(sRow(col), "") Next Next 'to sort dates shown as text as integers '--------------------------------------- If bDateColumn Then mapLongDates.Initialize For col = 0 To UB2 If arrDateColumns(col) = True Then Dim arrLongDates(UB + 1) As Long For row = 0 To UB arrLongDates(row) = arrCSV(row, col) 'arrCSV doesn't include the header row Next mapLongDates.Put(col, arrLongDates) End If Next End If 'convert XL dates or date-time to text '------------------------------------- For col = 0 To UB2 If arrDateColumns(col) = True Then Dim arrLong() As Long arrLong = mapLongDates.Get(col) If ColumnDataTypes(col) = "XD" Then For row = 0 To UB arrCSV(row, col) = General.ExcelDate2String(arrLong(row)) Next Else If ColumnDataTypes(col) = "Ticks_Date" Then For row = 0 To UB arrCSV(row, col) = General.Ticks2String(arrLong(row), "dd/MM/yyyy HH:mm", True) Next End If End If End If Next 'determine the column widths '--------------------------- For col = 0 To UB2 If AutomaticWidths = False Then ColumnWidths(col) = 130dip HeaderWidths(col) = 130dip DataWidths(col) = 130dip Else HeaderWidths(col) = cvs.MeasureStringWidth(Headers(col), Typeface.DEFAULT, cTextSize) + ExtraWidth ' For row = 1 To UB ' str = arrCSV(row, col) ' If str <> Null Then ' DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(str, Typeface.DEFAULT, cTextSize) + ExtraWidth) ' End If ' Next Dim strColumnString As String For row = 1 To UB If arrCSV(row, col) <> Null Then If arrCSV(row, col).Length > strColumnString.Length Then strColumnString = arrCSV(row, col) End If End If Next DataWidths(col) = cvs.MeasureStringWidth(strColumnString, Typeface.DEFAULT, cTextSize) + ExtraWidth ColumnWidths(col) = Max(HeaderWidths(col), DataWidths(col)) End If Next For col = 0 To UB2 strColumnDataTypes(col) = ColumnDataTypes(col) Next SetHeader(Headers) SetColumnsWidths(ColumnWidths) 'need to do this after any column data change (eg dates) 'add the data rows '----------------- For row = 0 To UB Private values(UB2 + 1) As String For col = 0 To UB2 values(col) = arrCSV(row, col) Next AddRow(values) Next Return UB + 1 End Sub Sub GetDataTypeFromString(strString As String) As String Dim i As Long Dim lBytes As Long Dim arrBytes(1) As Byte Dim bHasNumber As Boolean Dim bHasDot As Boolean arrBytes = BC.StringToBytes(strString, "ASCII") lBytes = arrBytes.Length For i = 0 To lBytes - 1 If arrStringTypeCheck(arrBytes(i)) = 0 Then Return "T" End If If arrStringTypeCheck(arrBytes(i)) = 1 Then bHasNumber = True If bHasDot Then Exit End If End If If arrStringTypeCheck(arrBytes(i)) = 2 Then bHasDot = True If bHasNumber Then Exit End If End If Next If bHasNumber Then If bHasDot Then Return "R" Else Return "I" End If Else Return "" End If End Sub Sub GetDataTypesFromSheet(oSheet As ReadableSheet, bSkipFirstRow As Boolean, ColumnDataTypes() As String) As String() Dim c As Int Dim r As Long Dim UB As Long Dim UB2 As Int Dim iStartRow As Int Dim iColumns As Int Dim lRows As Long Dim strType As String lRows = oSheet.RowsCount iColumns = ColumnDataTypes.Length 'this will be sheet columns + 1 as we are adding row numbers in column 1 UB = lRows - 1 UB2 = iColumns - 1 Dim arrDataTypes(iColumns) As String Dim arrColHasReal(iColumns) As Boolean Dim arrColHasInt(iColumns) As Boolean If bSkipFirstRow Then iStartRow = 1 Else iStartRow = 0 End If 'first column will be ignored as that will have already data type I as it will have the row numbers '-------------------------------------------------------------------------------------------------- For c = 1 To UB2 If ColumnDataTypes(c).Length = 0 Then For r = iStartRow To UB strType = GetDataTypeFromString(oSheet.GetCellValue(c - 1, r)) If strType = "T" Then arrDataTypes(c) = "T" 'text Exit Else If strType = "R" Then arrColHasReal(c) = True End If If strType = "I" Then arrColHasInt(c) = True End If End If Next If arrDataTypes(c) <> "T" Then If arrColHasReal(c) Then arrDataTypes(c) = "R" 'real Else If arrColHasInt(c) Then arrDataTypes(c) = "I" 'integer Else arrDataTypes(c) = "N" 'null End If End If End If Else arrDataTypes(c) = ColumnDataTypes(c) End If Next Return arrDataTypes End Sub Sub GetDataTypesFromList(oList As List, bSkipFirstRow As Boolean, ColumnDataTypes() As String) As String() Dim c As Int Dim r As Long Dim iStartRow As Int Dim sRow() As Object Dim iColumns As Int Dim lRows As Long Dim strType As String lRows = oList.Size sRow = oList.Get(0) iColumns = sRow.Length Dim arrDataTypes(iColumns) As String Dim arrColHasReal(iColumns) As Boolean Dim arrColHasInt(iColumns) As Boolean If bSkipFirstRow Then iStartRow = 1 Else iStartRow = 0 End If For c = 0 To iColumns - 1 If ColumnDataTypes(c).Length = 0 Then For r = iStartRow To lRows - 1 sRow = oList.Get(r) strType = GetDataTypeFromString(CStr(sRow(c))) If strType = "T" Then arrDataTypes(c) = "T" 'text Exit Else If strType = "R" Then arrColHasReal(c) = True End If If strType = "I" Then arrColHasInt(c) = True End If End If Next If arrDataTypes(c) <> "T" Then If arrColHasReal(c) Then arrDataTypes(c) = "R" 'real Else If arrColHasInt(c) Then arrDataTypes(c) = "I" 'integer Else arrDataTypes(c) = "N" 'null End If End If End If Else arrDataTypes(c) = ColumnDataTypes(c) End If Next Return arrDataTypes End Sub '------------------------------------------------------------------------------------------ 'gets or sets the NumberFixedColumns property 'When > 0 then, the specified number of first columns remains at their place they will not scroll horizontally 'Default value = 0 'Max value = 3 Public Sub setNumberOfFixedColumns(NumberOfFixedColumns As Int) NumberOfFixedColumns = Max(0, Min(3, NumberOfFixedColumns)) 'set the value in the limits 0 - 3 If mNumberOfFixedColumns = NumberOfFixedColumns Then Return End If If Header.NumberOfViews = 0 Then mNumberOfFixedColumns = NumberOfFixedColumns 'New Else Private col As Int Private Headers(mNumberOfColumns) As String If HeaderFirst.NumberOfViews = 0 Then For col = 0 To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col) Headers(col) = lbl.Text Next Else For col = 0 To mNumberOfFixedColumns - 1 Private lbl As Label lbl = HeaderFirst.GetView(col) Headers(col) = lbl.Text Next For col = mNumberOfFixedColumns To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col - mNumberOfFixedColumns) Headers(col) = lbl.Text Next End If HeaderFirst.RemoveAllViews Header.RemoveAllViews mNumberOfFixedColumns = NumberOfFixedColumns innerClearAll(mNumberOfColumns, False) SetHeader(Headers) SetColumnsWidths(ColumnWidths) SV2.Panel.Height = Data.Size * cRowHeight SVF.Panel.Height = SV2.Panel.Height ' Update the table Private currentMax As Int currentMax = Min(Data.Size - 1, SV2.Height / cRowHeight + 30) For row = 0 To currentMax ShowRow(row) Next End If End Sub Public Sub getNumberOfFixedColumns As Int Return mNumberOfFixedColumns End Sub 'gets or sets the FirstColumnFixed property 'When True, the first column remains at its place it will not scroll horizontally 'Default value = True 'This property is obsolete you should set NumberFixedColumns 'If you set it to True and NumberFixedColumns = 0, NumberFixedColumns will be set to 1 'If you set it to Galse and NumberFixedColumns = 1, NumberFixedColumns will be set to 0 Public Sub setFirstColumnFixed(FirstColumnFixed As Boolean) If FirstColumnFixed = True Then If mNumberOfFixedColumns = 0 Then setNumberOfFixedColumns(1) End If Else If mNumberOfFixedColumns = 1 Then setNumberOfFixedColumns(0) End If End If End Sub Public Sub getFirstColumnFixed As Boolean Return mFirstColumnFixed End Sub 'returns white for a dark color or returns black for a light color for a good contrast between bachground and text colors Private Sub GetContrastColor(Color As Int) As Int Private a, r, g, b, yiq As Int 'ignore a = Bit.UnsignedShiftRight(Bit.And(Color, 0xff000000), 24) r = Bit.UnsignedShiftRight(Bit.And(Color, 0xff0000), 16) g = Bit.UnsignedShiftRight(Bit.And(Color, 0xff00), 8) b = Bit.And(Color, 0xff) yiq = r * 0.299 + g * 0.587 + b * 0.114 If yiq > 128 Then Return Colors.Black Else Return Colors.White End If End Sub