B4A=true Group=Default Group ModulesStructureVersion=1 Type=Class Version=7.3 @EndOfDesignText@ 'Table CustomView 'Version 3.12 'Define 5 colors and set color for each row ' 'Version 3.11 'Amended Alignment and TypeFace problems ' 'Version 3.10 ' 'Amended error with width setting, when first column fixed ' 'Version 3.09 'Amended error whith height setting, the first column wasn't updated. ' 'Version 3.08 'Improved Hide / Unhide column handling 'Improved SetHeaderTypeFaces and added the HeaderTypeFace property. ' 'Version 3.07 'Added MultiSelect as a Designer property ' 'Version 3.06 'Amended some bugs ' 'Version 3.05 'Added the FirstColumnFixed property which allows to fix the first column ' 'Version 3.04 'Added SelectedRowTextColor and SlectedCellTextColor properties 'Added ZeroSelection property, True > when a selected row is pressed it will be unselected False > it remains selected. ' 'Version 3.03 'Changed JumpToRowAndSelect(Row As Int, Col As Int) to JumpToRowAndSelect(Col As Int, Row As Int) 'Changed LoadSQLiteDB2 signature. Replaced the possible values from "T", "I", "R" to "TEXT", "NUMBER" for coherence with SetColumnDataTypes 'Added internal sorting bitmaps, avoids loading the image files into the Files folder 'Added two new properties: SortBitmapWidth and SortBitmapColor. 'Added SetCustomSortingBitmaps method, which allows to use custom bitmaps instead of the internal ones. ' 'Version 3.02 'Amended as error, cTypeFace ' 'Version 3.01 'Amended setSingleLine problem 'Version 3.00 'Amended SetColumnColors and SetTextColors 'Removed Reflection library dependency ' 'Version 2.29 'Added SaveTableToCSV2 with a user defined separator character ' 'Version 2.28 'Added SetHeaderTypeFaces 'Added SortRemoveAccents property ' 'Version 2.27 'set the two variables sortedCol and sortingDir to Public instaed of Private 'added RemoveAccent routine for sorting with accented characters ' '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: FirstColumnFixed, DisplayName: FirstColumnFixed, FieldType: Boolean, DefaultValue: False, Description: Sets the first column fixed. #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 Private StringUtils1 As StringUtils Private SV2 As ScrollView2D Private SVF As ScrollView Private pnlTable As Panel Private Header As Panel Private HeaderFirst 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 Public Data As List Private LabelsCache As List Private minVisibleRow, 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 cLineWidth = Max(1, 1dip) As Int Private ExtraWidth = 12dip + cLineWidth As Int Private SelectedDrawable(), Drawable1(), Drawable2(), Drawable3() , Drawable4(), Drawable5() As Object Private SelectedCellDrawable As Object Private cRowColor1, cRowColor2, cRowColor3, cRowColor4, cRowColor5, cSelectedRowColor, cSelectedCellColor, cSelectedRowTextColor, cSelectedCellTextColor As Int Private DataColor As List Private cSortColumn = True As Boolean Private cUseColumnColors = False As Boolean Private cSortRemoveAccents = False As Boolean Private mFirstColumnWidth = 0 As Int Private mFirstColumnFixed = False As Boolean Private bmp As Bitmap ' used for the canvas below Private cvs As Canvas ' used to measure string widths in the LoadSQLiteDB routine '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 cRowColor3 = Colors.Red cRowColor4 = Colors.Yellow cRowColor5 = Colors.Green cSelectedRowColor = 0xFF007FFF cSelectedRowTextColor = Colors.Black cSelectedCellColor = 0xFFFC8EAC cSelectedCellTextColor = Colors.Black cRowHeight = 40dip cHeaderHeight = cRowHeight 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 cAllowSelection = True As Boolean Private SavedWidths() As Int' to keep the user set widths for columns Private cShowStatusLine As Boolean =True Private internalPanel As Panel 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 Private debug_counter As Long Private enableStatusLineAutoFill As Boolean = True Private pnlAsc As Panel 'added in version 3.03 Private bmpAsc, bmpDes As Bitmap 'added in version 3.03 Private cvsAsc, cvsDes 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 Dim Const _ COLOR_ROW_EVENODD=0, _ COLOR_ROW_COLOR1=1, _ COLOR_ROW_COLOR2=2, _ COLOR_ROW_COLOR3=3, _ COLOR_ROW_COLOR4=4, _ COLOR_ROW_COLOR5=5 As Int End Sub Public Sub Initialize (CallBack As Object, EventName As String) cEventName = EventName cCallBack = CallBack cSortBitmapWidth = 10dip cSortBitmapColor = Colors.Yellow 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") mFirstColumnFixed = Props.Get("FirstColumnFixed") mMultiSelect = Props.Get("MultiSelect") mZeroSelection = Props.Get("ZeroSelection") cHeaderColor = Props.Get("HeaderColor") cTableColor = Props.Get("TableColor") cHeaderTextColor = Props.Get("HeaderTextColor") cTextColor = Props.Get("CellTextColor") cRowColor1 = Props.Get("Row1Color") cRowColor2 = Props.Get("Row2Color") cRowColor3 = Props.Get("Row3Color") cRowColor4 = Props.Get("Row4Color") cRowColor5 = Props.Get("Row5Color") 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") cSortColumn = Props.Get("SortColumn") cSortRemoveAccents = Props.Get("SortRemoveAccents") cSortBitmapWidth = DipToCurrent(Props.Get("SortBitmapWidth")) cSortBitmapColor = Props.Get("SortBitmapColor") 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 visibleRows.Initialize pnlTable.Tag = "Table" 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 mFirstColumnFixed = False Then mFirstColumnWidth = 0 Else mFirstColumnWidth = 100dip End If pnlTable.AddView(Header, mFirstColumnWidth, 0 , cWidth - mFirstColumnWidth, cHeaderHeight) pnlTable.AddView(HeaderFirst, 0, 0, mFirstColumnWidth, 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, mFirstColumnWidth, Header.Height, cWidth - mFirstColumnWidth, cHeight - Header.Height - cRowHeight) pnlTable.AddView(lblStatusLine,0, SV2.Top + SV2.Height, cWidth, cRowHeight) Else pnlTable.AddView(SV2, mFirstColumnWidth, Header.Height, cWidth - mFirstColumnWidth, 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 InitializeSortingBitmaps End If ' used for string width measuements in the LoadSQLiteDB routine bmp.InitializeMutable(2dip, 2dip) cvs.Initialize2(bmp) DataColor.Initialize End Sub ' InitializeTable ' vNumberOfColumns = number of columns including hidden ones ' enter 1 if you use either LoadSQLiteDB, LoadTableFromCSV or LoadTableFromCSV2 ' cellAlignment = Gravity of the cell alignments of all cells text ' showStatusLine = if to show status line on the bottom of the table or not, to be able to show text to the user Public Sub InitializeTable (NumberOfColumns As Int, cellAlignement As Int, showStatusLine As Boolean) 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) = cWidth / 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 As Path cSortBitmapHeight = cSortBitmapWidth / 2 pnlAsc.Initialize("") pnlTable.AddView(pnlAsc, 0, 0, cSortBitmapWidth, cSortBitmapHeight) cvsAsc.Initialize(pnlAsc) pthAsc.Initialize(0, 0) pthAsc.LineTo(cSortBitmapWidth, 0) pthAsc.LineTo(cSortBitmapHeight, cSortBitmapHeight) cvsAsc.DrawColor(Colors.Transparent) cvsAsc.DrawPath(pthAsc, cSortBitmapColor, True, 1dip) bmpAsc = cvsAsc.Bitmap cvsDes.Initialize(pnlAsc) pthDes.Initialize(0, cSortBitmapHeight) pthDes.LineTo(cSortBitmapHeight, 0) pthDes.LineTo(cSortBitmapWidth, cSortBitmapHeight) cvsDes.DrawColor(Colors.Transparent) cvsDes.DrawPath(pthDes, cSortBitmapColor, True, 1dip) bmpDes = cvsDes.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 mFirstColumnFixed = False 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 mFirstColumnWidth = 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 'mFirstColumnFixed = True v = HeaderFirst.GetView(0) w = Max(2dip, Widths(0) - cLineWidth) mFirstColumnWidth = w HeaderFirst.Width = w + cLineWidth SVF.Width = HeaderFirst.Width SV2.Left = HeaderFirst.Width SV2.Width = cWidth - HeaderFirst.Width v.Width = w For col = 1 To Widths.Length - 1 Private col_1 As Int col_1 = col - 1 v = Header.GetView(col_1) w = Max(2dip, Widths(col) - cLineWidth) v.Width = w If col > 1 Then v.Left = Header.GetView(col - 2).Left + Header.GetView(col - 2).Width + cLineWidth End If Next Header.Width = Header.GetView(Widths.Length - 2).Left + Widths(Widths.Length - 1) ' Header.Left = -SV2.HorizontalScrollPosition + mFirstColumnWidth SV2.Panel.Width = Header.Width Header.Left = mFirstColumnWidth SV2.HorizontalScrollPosition = 0 Dim lbls() As Label For row = 0 To visibleRows.Size - 1 lbls = visibleRows.GetValueAt(row) lbls(0).SetLayout(0, lbls(0).Top, mFirstColumnWidth, cRowHeight - cLineWidth) For col = 1 To lbls.Length - 1 lbls(col).SetLayout(Header.GetView(col - 1).Left, lbls(col).Top, Header.GetView(col - 1).Width, cRowHeight - cLineWidth) Next Next End If lblStatusLine.Width = Header.Width internalPanel.Width = Header.Width End Sub Public Sub GetColumnWidths As Int() Return SavedWidths 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 Drawable3(mNumberOfColumns) As Object Dim Drawable4(mNumberOfColumns) As Object Dim Drawable5(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 For i = 0 To mNumberOfColumns - 1 Dim cd1, cd2, cd3, cd4, cd5 As ColorDrawable Dim sl1 As ColorDrawable cd1.Initialize(cRowColor1, 0) cd2.Initialize(cRowColor2, 0) cd3.Initialize(cRowColor3, 0) cd4.Initialize(cRowColor4, 0) cd5.Initialize(cRowColor5, 0) sl1.Initialize(cSelectedRowColor, 0) Drawable1(i) = cd1 Drawable2(i) = cd2 Drawable3(i) = cd3 Drawable4(i) = cd4 Drawable5(i) = cd5 SelectedDrawable(i) = sl1 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 Dim cd1, cd2, cd3, cd4, cd5 As ColorDrawable Dim sl1 As ColorDrawable cd1.Initialize(cRowColor1, 0) cd2.Initialize(cRowColor2, 0) cd3.Initialize(cRowColor3, 0) cd4.Initialize(cRowColor4, 0) cd5.Initialize(cRowColor5, 0) sl1.Initialize(cSelectedRowColor, 0) Drawable1(i) = cd1 Drawable2(i) = cd2 Drawable3(i) = cd3 Drawable4(i) = cd4 Drawable5(i) = cd5 SelectedDrawable(i) = sl1 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 'SelectedRow = -1 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 currentMin, 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(DataColor.Get(I), 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(DataColor.Get(I), I) Next End If End If minVisibleRow = currentMin maxVisibleRow = currentMax Header.Left = -PosX + mFirstColumnWidth lblStatusLine.Left = - PosX End Sub 'Adds a row to the table 'Example:Table1.AddRow(0, Array As String("aaa", "ccc", "ddd", "eee")) Public Sub AddRow(colorRow As Int, Values() As String) If Values.Length <> mNumberOfColumns Then Log("Wrong number of values =" & Values.Length & " col=" & mNumberOfColumns) Return End If Data.Add(Values) DataColor.Add(colorRow) Dim lastRow As Int lastRow = Data.Size - 1 If lastRow < (SV2.VerticalScrollPosition + SV2.Height) / cRowHeight + 1 Then ShowRow(colorRow, 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 '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 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), cTypeFaces(0), cTextSize) + ExtraWidth 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(DataColor.Get(lastRow), 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(Color As Int, Row As Int) If visibleRows.ContainsKey(Row) Then Return 'Log("ShowRow: " & row) 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 Color = COLOR_ROW_EVENODD Then If Row Mod 2 = 0 Then rowColor = Drawable1 Else rowColor = Drawable2 End If End If If Color = COLOR_ROW_COLOR1 Then rowColor = Drawable1 End If If Color = COLOR_ROW_COLOR2 Then rowColor = Drawable2 End If If Color = COLOR_ROW_COLOR3 Then rowColor = Drawable3 End If If Color = COLOR_ROW_COLOR4 Then rowColor = Drawable4 End If If Color = COLOR_ROW_COLOR5 Then rowColor = Drawable5 End If txtColor = cTextColor End If If mFirstColumnFixed = False 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 For I = 0 To lbls.Length - 1 If I = 0 Then SVF.Panel.AddView(lbls(0), 0, Row * cRowHeight, mFirstColumnWidth, 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 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 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) 'Log("HideRow: " & Row) Dim lbls() As Label lbls = visibleRows.get(Row) If lbls = Null Then ' Log("HideRow: (null) " & Row) 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 lbls() As Label If LabelsCache.Size > 0 Then 'Log("from cache") 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 Private Sub CreateNewLabels As Label() 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) ' added by nir, make each label single line ' If cSingleLine Then ' Dim ref As Reflector ' ref.Target = L ' ref.RunMethod2("setSingleLine", True, "java.lang.boolean") ' End If L.SingleLine = cSingleLine 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 Or cHeaderTextColors.Length <> mNumberOfColumns 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 If mFirstColumnFixed = True And col = 0 Then HeaderFirst.AddView(L, Left, 0, mFirstColumnWidth, cHeaderHeight) Else Header.AddView(L, Left, 0, w, cHeaderHeight) End If 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 If mFirstColumnFixed = False Or (col > 0 And mFirstColumnFixed = True) Then Left = Left + ColumnWidths(col) End If Next If Change = 1 Then SetColumnsWidths(ColumnWidths) End If Header.Left = - SV2.HorizontalScrollPosition + mFirstColumnWidth End Sub Private Sub Cell_LongClick 'Log("Cell: long click") Dim rc As RowCol Dim L As Label L = Sender rc = L.Tag 'SelectRow(rc) If SubExists(cCallBack, cEventName & "_CellLongClick") Then CallSub3(cCallBack, cEventName & "_CellLongClick", rc.Col, rc.Row) End If End Sub Private Sub Header_LongClick 'Log("Header: long click") 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 Private Sub Cell_Click Dim rc As RowCol Dim L As Label L = Sender rc = L.Tag ' SelectRow(rc.Row) SelectRow(rc) If SubExists(cCallBack, cEventName & "_CellClick") Then CallSub3(cCallBack, cEventName & "_CellClick", rc.Col, rc.Row) End If 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 '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(DataColor.Get(rc.Row), 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 'Log ("get at zero: " & SelectedRows) 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) 'Log ("multi select and found row") 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(DataColor.Get(prev), prev) End If End If SelectedCol = rc.col If visibleRows.ContainsKey(rc.Row) Then HideRow(rc.Row) ShowRow(DataColor.Get(rc.Row), rc.Row) End If End Sub 'Unselects the row for the given index Public Sub UnselectRow(rc As RowCol) If Not(cAllowSelection) Then Return Dim prevIndex As Int prevIndex = SelectedRows.indexof(rc.Row) ' -1 if selecting not a selected row If (prevIndex <> -1 And mMultiSelect = False) Then ' if mMultiSelect = True no column change, only if mMultiSelect = False SelectedCol = rc.col If visibleRows.ContainsKey(rc.Row) Then HideRow(rc.Row) ShowRow(DataColor.Get(rc.Row), rc.Row) End If Return ' comment this line if you want to unselect a line 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("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 List1 As List Dim h() As String 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(DataColor.Get(i), 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 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 Dim col, Row As Int 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 For Row = 0 To List1.Size - 1 Dim strRow(mNumberOfColumns) As String strRow = List1.get(Row) For col = 0 To mNumberOfColumns - 1 DataWidths(col) = Max(DataWidths(col), cvs.MeasureStringWidth(strRow(col), Typeface.DEFAULT, cTextSize) + ExtraWidth) Next 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(DataColor.Get(i), 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) For i = minVisibleRow To maxVisibleRow ' hide all visible rows HideRow(i) Next ' If mMultiSelect = False Then ' If sr = Row Then ' current selected row was deleted ' sr = -1 ' Else If sr > Row Then ' sr = sr - 1 ' End If ' End If 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(DataColor.Get(i), 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(DataColor.Get(Row), 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(DataColor.Get(Row), 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 'SV_ScrollChanged(SV2.HorizontalScrollPosition,SV2.VerticalScrollPosition) ' this strange call will set min/max visible area SelectedRows.Clear RefreshTable 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(DataColor.Get(i), i) Next End Sub ' return true if the table is set to multi select Public Sub getMultiSelect As Boolean Return mMultiSelect End Sub 'sets or gets the MultiSelect property 'when mMultiSelect 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 mMultiSelect is false, click on a row will select it (or reselect it if it is alreday selected) Public Sub setMultiSelect(MultiSelect As Boolean) clearSelection mMultiSelect = MultiSelect 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 Public Sub setStatusLine(s As String) If (lblStatusLine.IsInitialized) Then lblStatusLine.Text = s End Sub Private Sub IP_Click ' Log ("panel clicked!") 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 ' Log("updateIPLocation") 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 If mFirstColumnFixed = False Then SV2.Width = Width Else SV2.Width = Width - SVF.Width End If ' 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 SVF.Height = Height - cRowHeight - cHeaderHeight SV2.Height = Height - cRowHeight - cHeaderHeight Else SVF.Height = Height - cHeaderHeight SV2.Height = Height - cHeaderHeight End If lblStatusLine.Top = SV2.Top + SV2.Height SVF_ScrollChanged(0) SV2_ScrollChanged(0, 0) 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 L = Sender col = L.Tag 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 sortedCol = col sortingDir = dir If cColumnDataType(col) = "TEXT" Then sortTable(col,dir <=0) Else sortTableNum(col,dir <=0) End If showHeaderSorting(col, dir) 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 ll As Int = 10dip Dim L As Int ' calculate left Dim t As Int ' calculate top Dim View As View Dim ParentView As Panel pnlSortingView.RemoveView If mFirstColumnFixed = True Then If col = 0 Then View = HeaderFirst.GetView(0) ParentView = HeaderFirst Else View = Header.GetView(col - 1) ParentView = Header End If Else View = Header.GetView(col) ParentView = Header End If L = View.Left + View.Width - cSortBitmapWidth - 2dip If (dir = 0) Then Return ' remove the view only If (dir = -1) Then ' pnlSortingView.SetBackgroundImage(LoadBitmapSample(File.DirAssets, "sort_asc.png", ll, ll)) pnlSortingView.SetBackgroundImage(bmpAsc) t = View.Top + View.Height - cSortBitmapHeight - 2dip Else ' pnlSortingView.SetBackgroundImage(LoadBitmapSample(File.DirAssets, "sort_desc.png", ll, ll)) pnlSortingView.SetBackgroundImage(bmpDes) t = View.Top + View.Height - cSortBitmapHeight - 3dip End If ' Dim View As View ' View = Header.GetView(col) ParentView.AddView(pnlSortingView, L, t, cSortBitmapWidth, cSortBitmapHeight) End Sub ' code for sorting ' http://www.basic4ppc.com/forum/basic4android-getting-started-tutorials/8548-sorting-algorithms-teaching-basic4android.html#post47730 ' sort the table by column number and direction ' col is the column number starting with 0 ' dir as direction true = asc, false = dec Public Sub sortTable(col As Int, dir As Boolean) ' Log ("sorting table for col:" & col) clearSelection debug_counter = 0 'QuickSort(0,Data.Size-1, col, dir) ' TODO add dir SelectionSort(col, dir) RefreshTable End Sub Public Sub SelectionSort (col As Int, dir As Boolean) Dim minIndex As Int If cSortRemoveAccents = False Then For i = 0 To Data.Size- 1 minIndex = i For j = i + 1 To Data.Size - 1 Dim values1() As String = Data.get(j) Dim s1 As String = values1(col) Dim values2() As String = Data.get(minIndex) Dim s2 As String = values2(col) If (dir) Then If s1.CompareTo(s2) < 0 Then minIndex = j Else If s1.CompareTo(s2) > 0 Then minIndex = j End If Next SwapList(i, minIndex) Next Else 'removes the accents from accented characters for sorting For i = 0 To Data.Size- 1 minIndex = i For j = i + 1 To Data.Size - 1 Dim values1() As String = Data.get(j) Dim s1 As String = values1(col) Dim values2() As String = Data.get(minIndex) Dim s2 As String = values2(col) If (dir) Then If s1.CompareTo(RemoveAccents(s2)) < 0 Then minIndex = j Else If s1.CompareTo(RemoveAccents(s2)) > 0 Then minIndex = j End If Next SwapList(i, minIndex) Next End If End Sub ' code for sorting ' http://www.basic4ppc.com/forum/basic4android-getting-started-tutorials/8548-sorting-algorithms-teaching-basic4android.html#post47730 ' sort the table by column number and direction ' col is the column number starting with 0 ' dir as direction true = asc, false = dec Public Sub sortTableNum(col As Int, dir As Boolean) ' Log ("sorting table for col:" & col) clearSelection debug_counter = 0 'QuickSort(0,Data.Size-1, col, dir) ' TODO add dir SelectionSortNum(col, dir) RefreshTable End Sub Public Sub SelectionSortNum (col As Int,dir As Boolean) Dim minIndex As Int For i = 0 To Data.Size- 1 minIndex = i For j = i + 1 To Data.Size - 1 Dim values1() As String = Data.get(j) Dim s1 As Double = values1(col) Dim values2() As String = Data.get(minIndex) Dim s2 As Double = values2(col) If (dir) Then If s1 < s2 Then minIndex = j Else If s1 > s2 Then minIndex = j End If Next SwapList(i, minIndex) Next End Sub Public Sub SwapList(index1 As Int, index2 As Int) Dim temp As Object temp = Data.get(index1) Data.set(index1,Data.get(index2)) Data.set(index2,temp) End Sub ' True to automatically show number of rows in status line, false to turn it off Public Sub setStatusLineAutoFill(status As Boolean) enableStatusLineAutoFill = status End Sub ' ------------------------------------ not in use for now --------------------------------- ' not in use, fail in big numbers where the value is the same Public Sub QuickSort (left As Int, right As Int, col As Int, dir As Boolean) debug_counter = debug_counter +1 ' Log ("counter=" & debug_counter) If right > left Then Dim pivotIndex, pivotNewIndex As Int pivotIndex = Rnd(left, right + 1) 'max value is exclusive pivotNewIndex = Partition(left, right, pivotIndex, col,dir) QuickSort(left, pivotNewIndex - 1, col, dir) QuickSort(pivotNewIndex + 1, right, col, dir) End If End Sub Public Sub Partition (left As Int, right As Int, pivotIndex As Int, col As Int, dir As Boolean) As Int Dim storeIndex As Int Dim pivotValues() As String Dim pivotValue As String pivotValues = Data.get(pivotIndex) pivotValue = pivotValues(col) SwapList(pivotIndex, right) storeIndex = left For i = left To right - 1 Dim values() As String = Data.get(i) Dim s As String = values(col) If (dir) Then If s.CompareTo(pivotValue) < 0 Then ' dir is < acc, > dec SwapList(i, storeIndex) storeIndex = storeIndex + 1 End If Else If s.CompareTo(pivotValue) > 0 Then ' dir is < acc, > dec SwapList(i, storeIndex) storeIndex = storeIndex + 1 End If End If Next SwapList(storeIndex, right) Return storeIndex 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 Dim cAlignments0(mNumberOfColumns) As Int 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 mFirstColumnFixed = False Then For i = 0 To mNumberOfColumns - 1 Dim lbl As Label lbl = Header.GetView(i) lbl.Gravity = cHeaderAlignments(i) Next Else Dim lbl As Label lbl = HeaderFirst.GetView(0) lbl.Gravity = cHeaderAlignments(0) For i = 0 To mNumberOfColumns - 2 Dim lbl As Label lbl = Header.GetView(i) lbl.Gravity = cHeaderAlignments(i + 1) 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 Or gets the 3 rows color Public Sub setRowColor3(Color As Int) cRowColor3 = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getRowColor3 As Int Return cRowColor3 End Sub 'sets Or gets the 4 rows color Public Sub setRowColor4(Color As Int) cRowColor4 = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getRowColor4 As Int Return cRowColor4 End Sub 'sets Or gets the odd rows color Public Sub setRowColor5(Color As Int) cRowColor5 = Color If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getRowColor5 As Int Return cRowColor5 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 row text color Public Sub setSelectedRowTextColor(TextColor As Int) cSelectedRowTextColor = TextColor If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getSelectedRowTextColor As Int Return cSelectedRowTextColor 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 selected cell text color Public Sub setSelectedCellTextColor(TextColor As Int) cSelectedCellTextColor = TextColor If pnlTable.IsInitialized Then innerClearAll(mNumberOfColumns, True)'? End If End Sub Public Sub getSelectedCellTextColor As Int Return cSelectedCellTextColor 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) cTextColor = Color If SV2.IsInitialized = True Then Dim i As Int 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 '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 <> mNumberOfColumns Then ToastMessageShow("Invalid number of columns", False) Return End If If TypeFaces.Length = 1 Then cTypeFace = TypeFaces(0) MultiTypeFace = False Else cTypeFaces = TypeFaces cTypeFaces = cTypeFaces0 MultiTypeFace = True End If If Data.Size > 0 Then 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(DataColor.Get(i), i) Next 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(0, R) Next Curs.Close ' Log(Data.Size) End Sub 'load data from a SQLite database 'SQLite = SQL object 'Query = SQLite query 'AutomaticWidths True > set the column widths automaticaly 'ColumDataTypes Array od strings with the data types ' "TEXT ' "NUMBER" 'Example: 'Table1.LoadSQLiteDB2(SQL1, "SELECT * FROM Test", True, Array As String("NUMBER", "TEXT", "NUMBER", "NUMBER")) 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 'changed in version 3.01 If ColumnDataTypes(col).CharAt(0) = "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(0, 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 Curs = SQLite.ExecQuery2(Query, Values) 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(0, R) Next Curs.Close ' Log(Data.Size) 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) v.Padding = Array As Int (Left, Top, Right, Bottom) 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 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) Log(lbl.Text) 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 mFirstColumnFixed = False 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 mFirstColumnFixed = False Then For col = 0 To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col) lbl.Typeface = cHeaderTypeFaces(col) 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 = cHeaderTypeFaces(col + 1) Next End If End If End If End If End Sub Public Sub GetHeaderTextColors As Int() Return cHeaderTextColors 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 getShowStatusLine As Boolean Return cShowStatusLine End Sub 'Gets the base Panel of the Table Public Sub getPanel As Panel Return pnlTable 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 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 'sets or gets the ZeroSelection property 'With ZeroSelection = True, when press on a selectd row this one will be unselected. 'Default value = False, a selected row remains selected when you press on it. Public Sub setZeroSelection(ZeroSelection As Boolean) mZeroSelection = ZeroSelection End Sub 'gets or sets the FirstColumnFixed property 'When True, the firsr column remains at its place it will not scroll horizontally 'Default value = True Public Sub setFirstColumnFixed(FirstColumnFixed As Boolean) If Header.NumberOfViews = 0 Then mFirstColumnFixed = FirstColumnFixed Else Private col As Int Private Headers(mNumberOfColumns) As String If mFirstColumnFixed = False Then For col = 0 To mNumberOfColumns - 1 Private lbl As Label lbl = Header.GetView(col) Headers(col) = lbl.Text Next Else Private lbl As Label lbl = HeaderFirst.GetView(0) Headers(0) = lbl.Text For col = 0 To mNumberOfColumns - 2 Private lbl As Label lbl = Header.GetView(col) Headers(col + 1) = lbl.Text Next End If HeaderFirst.RemoveAllViews Header.RemoveAllViews mFirstColumnFixed = FirstColumnFixed 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(DataColor.Get(row), row) Next End If End Sub Public Sub getFirstColumnFixed As Boolean Return mFirstColumnFixed End Sub