使用delphi 开发多层应用（十四）使用Basic4android 显示kbmMW server数据

前面说了basic4android 直接访问kbmMW server 的方法，由于javaclient 不直接支持服务器端数据库的操作，

要显示数据的内容就需要通过JSON 方式来转换。今天就大概介绍一下转换的办法。

首先要在服务器端把数据库转换为JSON ，为了方便，我修改了一下前面的转换过程。

function Txalionsrv.datatojson(intablename: string): string;
var
  alljson: ISuperObject;
  datajson: ISuperObject;
  recordjson: ISuperObject;

  totalcount: string;
  starti, endi, i: integer;
begin


  alljson := TSuperObject.Create(stobject);


  cx.sql.clear;
  cx.sql.add('select count(*) from (' + intablename + ')');

  try
   cx.Open;
  except
     on E:Exception do
        begin

           result:='数据库打开错误!'+e.Message;
           exit;
        end;
 end;
  totalcount := cx.fields[0].AsString;
  if totalcount > '0' then
  begin

    datajson := TSuperObject.Create(starray);
    with cx do
    begin
      sql.clear;
      sql.Add(' select * from ( '+intablename+' )');

      try

         Open;
         except
        result:='数据库打开错误!2';
         exit;

      end;
      while not eof do
      begin
        recordjson := TSuperObject.Create(stobject);

        for i := 0 to fields.Count - 1 do
        begin
          recordjson.s[fields[i].FieldName] := fields[i].AsString;
        end;

        datajson.o[''] := recordjson;
        recordjson := nil;
        next;
      end;
    end;

    alljson.o['topics'] := datajson;

    alljson.s['totalCount'] := totalcount;

    datajson := nil;
  end;

  result := alljson.AsJSon();

  alljson := nil;


end;



function Txalionsrv.Performgetdata(ClientIdent:TkbmMWClientIdentity; const Args:array of Variant):Variant;
begin
   result:=datatojson(args[0]);
end;

function Txalionsrv.ProcessRequest(const Func: string;
  const ClientIdent: TkbmMWClientIdentity;
  const Args: array of Variant): Variant;

  var
   AFunc:string;
begin
     AFunc:=UpperCase(Func);
     if AFunc='SUMALL' then
        Result:=Performsumall(ClientIdent,Args)
     else if AFunc='GETIMG' then
        Result:=Performgetimg(ClientIdent,Args)
     else if AFunc='GETDATA' then
        result:=Performgetdata(ClientIdent,Args)

end;

然后运行服务器端。

客户端需要在B4A 上加一个显示数据的activity

主单元的代码为

'Activity module
Sub Process_Globals
    'These global variables will be declared once when the application starts.
    'These variables can be accessed from all modules.
   Dim  sdata As String
End Sub

Sub Globals
    'These global variables will be redeclared each time the activity is created.
    'These variables can only be accessed from this module.
    Dim SimpleClient As TkbmMWClient
    Dim Ip As EditText
    Dim Port As EditText
    Dim mLog As EditText
End Sub

Sub Activity_Create(FirstTime As Boolean)
    Activity.LoadLayout("Main")
    Ip.Text = "192.168.1.215"
    Port.Text = "3000"
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub



Sub ConnectBtn_Click
    SimpleClient.Connect(Ip.Text,Port.Text)    
End Sub
Sub SendBtn_Click
        
    Dim args(2) As String
    args(0)="select Xh,Xm,yanglaoxy,yanglaogr from rssj"
    sdata=SimpleClient.SendRequest ("xalion_srv","","GETDATA",args)
    StartActivity(bmxinxi)
End Sub

bmxinxi的代码如下：

'Activity module
Sub Process_Globals
    'These global variables will be declared once when the application starts.
    'These variables can be accessed from all modules.
    
End Sub

Sub Globals
    'These global variables will be redeclared each time the activity is created.
    'These variables can only be accessed from this module.
 

    Dim SV As ScrollView
    Dim Header As Panel
    Dim Footer As Panel
    Dim Table As Panel
    Dim NumberOfColumns, RowHeight, RowHeight_1, ColumnWidth, ColumnWidth_1 As Int
    Dim HeaderColor, LineColor, CellColor, FontColor, HeaderFontColor As Int
    Dim ColLineWidth, RowLineWidth As Int
    Dim FontSize As Float
    Type RowCol (Row As Int, Col As Int)
    Dim Alignment As Int
    Dim SelectedRow As Int
    Dim SelectedRowColor As Int        
    : SelectedRowColor=Colors.LightGray
    
    'Table settings
    HeaderColor = Colors.Gray
    NumberOfColumns = 4 'will be overwritten when loading from CSV file.
    ColLineWidth = 1dip
    RowLineWidth = 1dip
    RowHeight_1 = 30dip
    RowHeight=RowHeight_1+RowLineWidth
    LineColor = Colors.Black
    CellColor = Colors.White
    FontColor = Colors.Black
    HeaderFontColor = Colors.White
    FontSize = 14
    Alignment = Gravity.CENTER 'change to Gravity.LEFT or Gravity.RIGHT for other alignments.
End Sub

Sub Activity_Create(FirstTime As Boolean)
     
  
    SV.Initialize(0)
'    SV.Color=Colors.Transparent
    SV.Panel.Color=Colors.Black
    Table = SV.Panel
    Table.Color = LineColor
    Activity.AddView(SV, 1%x, 10%y, 99%x, 80%y)
    
    ColumnWidth = SV.Width / NumberOfColumns
    ColumnWidth_1 = ColumnWidth-ColLineWidth
    SelectedRow = -1
 
     loadxinxi(Main.sdata)
End Sub
 

Sub loadxinxi(s As String)
    Dim JSON As JSONParser
    Dim Master As Map
    Dim records As List
    
    Dim XINXI As Map
    
    Dim recordcount As String
    
    
      ClearAll
    
    Dim h(4) As String
    h(0)="序号"
    h(1)="姓名"
    h(2)="学院"
    h(3)="个人"
    
    NumberOfColumns = h.Length
    ColumnWidth = SV.Width / NumberOfColumns 'update the columns widths
    ColumnWidth_1 = ColumnWidth-ColLineWidth
    SetHeader(h)
    JSON.Initialize(s)
    Master = JSON.NextObject
    records=Master.Get("topics")
    
     
 
    Dim data(4) As String
    For i=0 To records.Size-1
      Dim row() As String
        XINXI=records.Get(i)
        data(0)=XINXI.Get("XH")
        data(1)=XINXI.get("XM")
        data(2)=XINXI.get("YANGLAOXY")
        data(3)=XINXI.get("YANGLAOGR")
        
        row =data
        AddRow(row)
    Next
    recordcount=Master.Get("totalCount")
    h(0)="合计"
    h(1)=recordcount
    h(2)=""
    h(3)=""
   SetFooter(h)
    Activity.Title="职工信息" 

End Sub

Sub Cell_Click
    Dim rc As RowCol
    Dim l As Label
    Dim l0 As Label
    l = Sender
    rc = l.Tag
    SelectRow(rc.Row)
    l0=GetView(rc.Row,0)
    'activity.Title = "Cell clicked: (" & rc.Row & ", " & rc.Col & l0.Text &")"
    myxh=l0.Text
     
     
End Sub

Sub Header_Click
    Dim l As Label
    Dim col As Int
    l = Sender
    col = l.Tag
    Activity.Title = "Header clicked: " & col
End Sub

Sub SelectRow(Row As Int)
    'remove the color of previously selected row
    If SelectedRow > -1 Then
        For col = 0 To NumberOfColumns - 1
            GetView(SelectedRow, col).Color = CellColor
        Next
    End If
    SelectedRow = Row
    For col = 0 To NumberOfColumns - 1
        GetView(Row, col).Color = SelectedRowColor
    Next
End Sub

'Returns the label in the specific cell
Sub GetView(Row As Int, Col As Int) As Label
    Dim l As Label
    l = Table.GetView(Row * NumberOfColumns + Col)
    Return l
End Sub

'Adds a row to the table
Sub AddRow(Values() As String)
    If Values.Length <> NumberOfColumns Then
        Log("Wrong number of values.")
        Return
    End If
    Dim lastRow As Int
    lastRow = NumberOfRows
    For i = 0 To NumberOfColumns - 1
        Dim l As Label
        l.Initialize("cell")
        l.Text = Values(i)
        l.Gravity = Alignment
        l.TextSize = FontSize
        l.TextColor = FontColor
        l.Color=Colors.White
        Dim rc As RowCol
        rc.Initialize
        rc.Col = i
        rc.Row = lastRow
        l.Tag = rc
        Table.AddView(l, ColumnWidth * i, RowHeight * lastRow, ColumnWidth_1, RowHeight_1)
    Next
    Table.Height = NumberOfRows * RowHeight
End Sub

'Set the headers values
Sub SetHeader(Values() As String)
    If Header.IsInitialized Then Return 'should only be called once
    Header.Initialize("")
    For i = 0 To NumberOfColumns - 1
        Dim l As Label
        l.Initialize("header")
        l.Text = Values(i)
        l.Gravity = Gravity.CENTER
        l.TextSize = FontSize
        l.Color = HeaderColor
        l.TextColor = HeaderFontColor
        l.Tag = i
        Header.AddView(l, ColumnWidth * i, 0, ColumnWidth_1, RowHeight_1)
    Next
    Activity.AddView(Header, SV.Left, SV.Top - RowHeight, SV.Width, RowHeight)
End Sub

Sub SetFooter(Values() As String)
    If Footer.IsInitialized Then Return 'should only be called once
    Footer.Initialize("")
    For i = 0 To NumberOfColumns - 1
        Dim l As Label
        l.Initialize("footer")
        l.Text = Values(i)
        l.Gravity = Gravity.CENTER
        l.TextSize = FontSize
        l.Color = HeaderColor
        l.TextColor = HeaderFontColor
        l.Tag = i
        Footer.AddView(l, ColumnWidth * i, 0, ColumnWidth_1, RowHeight_1)
    Next
    Activity.AddView(Footer, SV.Left, SV.Top+SV.Height, SV.Width, RowHeight)
End Sub

Sub NumberOfRows As Int
    Return Table.NumberOfViews / NumberOfColumns
End Sub

'Sets the value of the given cell
Sub SetCell(Row As Int, Col As Int, Value As String)
    GetView(Row, Col).Text = Value
End Sub

'Gets the value of the given cell
Sub GetCell(Row As Int, Col As Int) As String
    Return GetView(Row, Col).Text
End Sub

'Clears the table
Sub ClearAll
    For i = Table.NumberOfViews -1 To 0 Step -1
        Table.RemoveViewAt(i)
    Next
    Table.Height = 0
    SelectedRow = -1
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub

现在运行客户端，就会回来下面界面，而且还支持滑动显示呢.

 

注意：本文纯粹是为了演示目的，在实际操作中由于JSON 数据量比较大，因此在显示数据时

要考虑到分页，同时可以通过压缩来减少网络流量。