盒子论坛 v2.1

D10.2+Win7平台
控件：Tabcontrol->ListItem1->Listbox->ListBoxItem 30条
->ListItem2->TwebBrowser;
基本没啥代码，ListBox只有最底下的2条能正常响应手机的手势，上滑动、下滑、点击，上面的没响应。
删除TwebBrowser控件，一切正常。
是啥原因，请高手指点。
----------------------------------------------
-

作者：

liuzemin (liuzemin)	★☆☆☆☆	-
	普通会员

2018/3/15 16:37:58

1楼：

Andriod真机调试的。
----------------------------------------------
-

作者：

liuzemin (liuzemin)	★☆☆☆☆	-
	普通会员

2018/3/15 17:24:26

2楼：

unit TabbedTemplate;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.TabControl,
  FMX.StdCtrls, FMX.Gestures, System.Rtti, FMX.Grid.Style, FMX.Grid,
  FMX.ExtCtrls, FMX.ScrollBox, FMX.Controls.Presentation, FireDAC.Stan.Intf,
  FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
  FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
  FireDAC.FMXUI.Wait, Data.DB,
  FireDAC.Comp.Client, FireDAC.Phys.DS, FireDAC.Phys.DSDef, FireDAC.Stan.Param,
  FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DbxDatasnap,
  Data.DBXCommon, IPPeerClient, Datasnap.DBClient, Datasnap.DSConnect,
  Data.SqlExpr, FireDAC.Comp.DataSet, FMX.Styles.Objects, FireDAC.FMXUI.Error,
  FireDAC.Comp.UI, FMX.WebBrowser, FMX.ListBox, FMX.Layouts, FMX.Objects,
  FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
  FMX.ListView;

type
  TTabbedForm = class(TForm)
    HeaderToolBar: TToolBar;
    ToolBarLabel: TLabel;
    FDConnection1: TFDConnection;
    DSPconnection1: TDSProviderConnection;
    ClientDataSet1: TClientDataSet;
    FDStoredProc1: TFDStoredProc;
    FDMemTable1: TFDMemTable;
    StyleBook1: TStyleBook;
    GestureManager1: TGestureManager;
    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
    FDGUIxErrorDialog1: TFDGUIxErrorDialog;
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    Label3: TLabel;
    TabItem3: TTabItem;
    TabItem4: TTabItem;
    ListBox1: TListBox;
    ListBoxItem1: TListBoxItem;
    ListBoxItem2: TListBoxItem;
    ListBoxItem3: TListBoxItem;
    ListBoxItem4: TListBoxItem;
    ListBoxItem5: TListBoxItem;
    ListBoxItem6: TListBoxItem;
    ListBoxItem7: TListBoxItem;
    ListBoxItem8: TListBoxItem;
    ListBoxItem9: TListBoxItem;
    ListBoxItem10: TListBoxItem;
    ListBoxItem11: TListBoxItem;
    ListBoxItem12: TListBoxItem;
    ListBoxItem13: TListBoxItem;
    ListBoxItem14: TListBoxItem;
    ListBoxItem15: TListBoxItem;
    ListBoxItem16: TListBoxItem;
    ListBoxItem17: TListBoxItem;
    ListBoxItem18: TListBoxItem;
    ListBoxItem19: TListBoxItem;
    ListBoxItem20: TListBoxItem;
    ListBoxItem21: TListBoxItem;
    ListBoxItem22: TListBoxItem;
    ListBoxItem23: TListBoxItem;
    ListBoxItem24: TListBoxItem;
    ListBoxItem25: TListBoxItem;
    ListBoxItem26: TListBoxItem;
    ListBoxItem27: TListBoxItem;
    ListBoxItem28: TListBoxItem;
    ListBoxItem29: TListBoxItem;
    ListBoxItem30: TListBoxItem;
    ListView1: TListView;
    WebBrowser1: TWebBrowser;
    procedure FormCreate(Sender: TObject);
    procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo;
      var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CornerButton3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TabItem1Click(Sender: TObject);
    procedure ListBoxItem1Click(Sender: TObject);

  private
    { Private declarations }
    procedure listdata;   //显示数据
  public
    { Public declarations }
  end;

var
  TabbedForm: TTabbedForm;
  dataindex : word;       //FMdatatable开始位置
  data_id : word ;        //FMmemTable中第几条记录显示到地图
  WebBrow : TWebBrowser;
implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.iPhone47in.fmx IOS}
{$R *.NmXhdpiPh.fmx ANDROID}

procedure TTabbedForm.CornerButton3Click(Sender: TObject);
var
  temp,loop : word;
  button_name : string;
  year,month,day,hour,minute,t1,t2 : word;
begin
    button_name := (sender as TCornerButton).Name;
    temp := strtoint(copy(button_name,13,length(button_name)-12));
    temp := temp -1;
    self.FDMemTable1.First;  //查找按钮对应的数据
    for loop := 1 to temp do
      self.FDMemTable1.Next ;   //查到按钮对应的数据
    self.TabControl1.ActiveTab := self.TabControl1.Tabs[1];
    decodedate(self.FDMemTable1.Fields[0].AsDateTime,year,month,day);
    decodetime(self.FDMemTable1.Fields[0].AsDateTime,hour,minute,t1,t2);
    self.Label3.Text := format(' 发震时刻:%.4d-%.2d-%.2d %.2d:%.2d:%.2d  ',[year,month,day,hour,minute,t1])+ #10+#13+
          format(' 经纬度：%6.2fN %6.2fE,  ',[self.FDMemTable1.Fields[2].AsFloat,self.FDMemTable1.Fields[3].AsFloat]) +
          self.FDMemTable1.Fields[5].AsString+ #10+#13+
          format(' Ms%3.1f  ',[self.FDMemTable1.Fields[1].asfloat])+
          inttostr(self.FDMemTable1.Fields[4].AsInteger) +'Km';
end;

procedure TTabbedForm.FormActivate(Sender: TObject);
begin
//  self.listdata;   //显示数据
end;

procedure TTabbedForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if   self.FDConnection1.Connected = true then
      self.FDConnection1.Connected := false;
end;

procedure TTabbedForm.FormCreate(Sender: TObject);
begin
  { This defines the default active tab at runtime }
  TabControl1.ActiveTab := TabItem1;
  self.FDConnection1.Connected := true;
  self.FDStoredProc1.Close;
  self.FDStoredProc1.Prepare;
  self.FDStoredProc1.Open;
  self.FDMemTable1.Close;
  self.FDMemTable1.Data := self.FDStoredProc1.Data;
  self.FDMemTable1.Active := true;
  self.FDStoredProc1.Close;
  self.FDConnection1.Connected := false;
  self.FDMemTable1.First;

  self.listdata;   //显示数据

  dataindex := 0;   //数据开始位置为0；

  //self.WebBrowser1.URL := 'E:\t.jsp';
end;

procedure TTabbedForm.FormGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
{$IFDEF ANDROID}
  case EventInfo.GestureID of
    sgiLeft:
    begin
      if TabControl1.ActiveTab <> TabControl1.Tabs[TabControl1.TabCount-1] then
        TabControl1.ActiveTab := TabControl1.Tabs[TabControl1.TabIndex+1];
      Handled := True;
    end;

    sgiRight:
    begin
      if TabControl1.ActiveTab <> TabControl1.Tabs[0] then
        TabControl1.ActiveTab := TabControl1.Tabs[TabControl1.TabIndex-1];
      Handled := True;
    end;
  end;
{$ENDIF}
end;

procedure TTabbedForm.ListBoxItem1Click(Sender: TObject);
var
  temp,loop : word;
  button_name : string;
  year,month,day,hour,minute,t1,t2 : word;
  s,s1 : string;

begin
    button_name := (sender as TListBoxItem).Name;
    temp := strtoint(copy(button_name,12,length(button_name)-11))-1;
    self.FDMemTable1.First;  //查找按钮对应的数据
    for loop := 1 to temp do
      self.FDMemTable1.Next ;   //查到按钮对应的数据
    self.TabControl1.ActiveTab := self.TabControl1.Tabs[2];

    decodedate(self.FDMemTable1.Fields[0].AsDateTime,year,month,day);
    decodetime(self.FDMemTable1.Fields[0].AsDateTime,hour,minute,t1,t2);
    self.Label3.Text := format(' 发震时刻:%.4d-%.2d-%.2d %.2d:%.2d:%.2d  ',[year,month,day,hour,minute,t1])+ #10+#13+
          format(' 经纬度：%6.2fN %6.2fE,  ',[self.FDMemTable1.Fields[2].AsFloat,self.FDMemTable1.Fields[3].AsFloat]) +
          self.FDMemTable1.Fields[5].AsString+ #10+#13+
          format(' Ms%3.1f  ',[self.FDMemTable1.Fields[1].asfloat])+
          inttostr(self.FDMemTable1.Fields[4].AsInteger) +'Km';
    //self.WebBrowser1.Visible := true;
    //self.WebBrowser1.URL := 'H:\2018\eq_info_server_client\Eq_client\t.html' ;
    //self.WebBrowser1.
    s1 :=  '<!DOCTYPE html> '
          +'<html>'
          +'<head>'
          +'<meta name="viewport" con_tent="initial-scale=1.0, user-scalable=yes" />'
          +'<meta http-equiv="Content-Type" con_tent="text/html; charset=utf-8" /> '
          +'<title>Hello, World</title> '
          +'<style type="text/css"> '
          +'html{height:100%}'
          +'body{height:100%;margin:0px;padding:0px}'
          +'#container{height:100%}'
          +'</style> '
          +'<script type="text/javascript" src="

http://api.map.baidu.com/api?v=2.0&ak=uZR5UAGHAR??????????x8D3";>'
          +'</script>'
          +'</head>'
          +'<body> '
          +'<div id="container"></div> '
          +'<script type="text/javascript"> '
          +'var map = new BMap.Map("container");'
          +'var point = new BMap.Point(117, 31.5);'
          +'map.centerAndZoom(point, 9);'
          +'</script>  '
          +'</body>  '
          +'</html>';
    self.WebBrowser1.LoadFromStrings(s1,'

http://api.map.baidu.com');
    //self.WebBrowser1.EvaluateJavaScript('H:\2018\eq_info_server_client\Eq_client\t.jsp')
end;

//显示数据
procedure TTabbedForm.listdata;
var
  year,month,day,hour,minute,t1,t2 : word;
  loop : word;
begin
  for loop := 0 to 29 do
  begin
    decodedate(self.FDMemTable1.Fields[0].AsDateTime,year,month,day);
    decodetime(self.FDMemTable1.Fields[0].AsDateTime,hour,minute,t1,t2);
    self.ListBox1.ListItems[loop].Text :='  Ms'+ format('%.1f',[self.FDMemTable1.Fields[1].asfloat])+'  '+
          self.FDMemTable1.Fields[5].AsString+'  '+
          format('%.4d-%.2d-%.2d %.2d:%.2d  ',[year,month,day,hour,minute]) +
          inttostr(self.FDMemTable1.Fields[4].AsInteger) +'Km';
    self.FDMemTable1.Next;
  end;
end;

procedure TTabbedForm.TabItem1Click(Sender: TObject);
begin
//
end;
end.
----------------------------------------------
-

作者：

liuzemin (liuzemin)	★☆☆☆☆	-
	普通会员

2018/3/15 17:25:11

3楼：

以上是我的全部代码
TwebBrowser控件，就是影响了ListBox的触摸响应
求解
----------------------------------------------
-

作者：

liuzemin (liuzemin)	★☆☆☆☆	-
	普通会员

2018/3/16 15:10:26

4楼：

FireMonkey 底下，Android APP:
在一个 Form 上放页标签，在其中一个页里放一个 TWebBrowser ，其它页放其它界面控件。加个按钮，让 WebBrowser1 去打开一个 URL，显示一个网页。
APP 编译为 Windows 版本，运行，没有任何问题。
编译为 Android 运行在手机上，当 WebBrowser 打开网页后，切换到其它页标签后（WebBrowser1 没在屏幕上显示了），整个界面失去对触摸到响应。用 Debug 方式来运行看，IDE 里面没有任何错误提示出来。
换种方式，将 WebBrowser 放到一个 Layout 上，同时在这个 Layout 上放一个 ListView。加个按钮，隐藏 WebBrowser 以显示 ListView。
同样，当 WebBrowser 打开网页后，如果点按钮隐藏掉它，ListView 倒是显示出来了，然后整个界面就失去对触摸到响应，好像死机了。
再换种方式，增加一个 Form，把 WebBrowser1 放到这个 Form 上面。Form 上放一个按钮，事件代码是关闭这个 Form。命名这个 Form 为 FmWebBrowser.
主界面里面，点按钮，显示有 WebBrowser1 的 Form，打开一个网页。然后点这个 Form 上的关闭按钮，回到主界面，然后主界面失去对触摸的响应。
----------
总结：不管什么方式，只要显示了网页，然后将当前屏幕的 WebBrowser 切换为显示其它界面元素，整个程序失去响应。这个问题在 Berlin 版本是没有的。
----------
上网搜了一下，没搜到相应的问题报告，也没搜到解决办法。
自己试了试，将工程文件里面创建这个 FmWebBrowser 的代码注释掉。在主 Form 里面，需要显示 WebBrowser 的地方，增加一行代码：

if not Assigned(FmWebBrowser) then FmWebBrowser := TFmWebBrowser.Create(Application);
也就是运行期动态创建它。
然后，这个问题就消失了。
看起来，在 FireMonkey Mobile 的程序里面，不能在程序启动的时候就创建 WebBrowser 实例。

http://blog.csdn.net/pcplayer/article/details/78149391
----------------------------------------------
-

作者：

liuzemin (liuzemin)	★☆☆☆☆	-
	普通会员

2018/3/16 15:15:45

5楼：

网上找到的，经测试，可行
----------------------------------------------
-

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/3/16 15:36:52

6楼：

将 FMX.WebBrowser.pas
复制到你的工程中
找到如下代码，并修改。
procedure TCustomWebBrowser.FormHandleCreated(const Sender: TObject; const Msg: TMessage);

  function GetParentForm(Control: TFmxObject): TCommonCustomForm;
  begin
    if (Control.Root <> nil) and (Control.Root.GetObject is TCommonCustomForm) then
      Result := TCommonCustomForm(Control.Root.GetObject)
    else
      Result := nil;
  end;

var
  WBService : IFMXWBService;
begin
  if not (csDesigning in ComponentState) and ((FWeb = nil) or (Sender = GetParentForm(self as TFmxObject))) and
    TPlatformServices.Current.SupportsPlatformService(IFMXWBService, WBService) then
  begin
//Fix And Add By 爱吃猪头肉.
//https://quality.embarcadero.com/browse/RSP-15869
    if FWeb = nil then
    FWeb := WBService.CreateWebBrowser;
    FWeb.SetWebBrowserControl(Self);
    FWeb.UpdateContentFromControl;
    FWeb.URL := FURL;
    FWeb.Navigate;
  end;
end;

你试试，是不是问题依旧。
----------------------------------------------
(C)(P)Flying Wang

作者：

liuzemin (liuzemin)	★☆☆☆☆	-
	普通会员

2018/3/20 15:58:36

7楼：

感谢
男 wang_80919 (Flying Wang) 回复

经测试，改方法不行，问题依旧。
----------------------------------------------
-

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/3/20 16:07:55

8楼：

那就叫 EMB 改。
你看人家 15869 。总会有解决办法的。
----------------------------------------------
(C)(P)Flying Wang

信息

登陆以后才能回复