使用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 数据量比较大，因此在显示数据时

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