[Delphi 轉 Builder ]，使用WebBrowser記憶體錯誤問題

heureux0748 2014-10-18 12:14:31

程式碼



//---------------------------------------------------------------------------

#include <mshtml.h>

#include <math.h>

#include <vcl.h>

#pragma hdrstop



#include "Unit1.h"

//---------------------------------------------------------------------------

#pragma package(smart_init)

#pragma resource "*.dfm"



AnsiString HTMLsrc = "C:/Users/FCU/Desktop/Map.html";

IHTMLDocument2 *ADocument;

IHTMLWindow2 *HWindow2;

IHTMLElement2 *ABody;

AnsiString Lat,Lng;

IHTMLElement *Tag;

IHTMLElementCollection *TagsList;

IHTMLElement *ABody2;

HRESULT QA;



TForm1 *Form1;

//---------------------------------------------------------------------------

__fastcall TForm1::TForm1(TComponent* Owner)

	: TForm(Owner)

{

	WebBrowser1->Navigate2("about:blank");

}

//---------------------------------------------------------------------------

void __fastcall TForm1::FormCreate(TObject *Sender)

{

	WebBrowser1->Navigate2(HTMLsrc);

	WebBrowser1->Document->QueryInterface(__uuidof(IHTMLDocument2), (void **)&ADocument);

	ADocument->QueryInterface(__uuidof(IHTMLWindow2), (void **)&HWindow2);

}

//---------------------------------------------------------------------------

AnsiString GetIdValue(const AnsiString Id)

{

	int Index;

	AnsiString Result = "";

	long scope;

	IDispatch *pDisp;

	HRESULT Qa;

	wchar_t *wszBuf;



	ABody->getElementsByTagName((wchar_t*)("input"),&TagsList); //input 改 Id

	TagsList->get_length(&scope);



	for (Index = 0; Index < scope; Index++)

	{

		 VARIANT vTemp,vEmptyParam;

		 vTemp.vt = VT_UI4;

		 vTemp.lVal = Index;

		 TagsList->item(vTemp,vEmptyParam,&pDisp);

		 Qa = pDisp->QueryInterface(__uuidof(IHTMLElement), (void **)&Tag);



		 if(SUCCEEDED(Qa))

		 {

			Tag->get_innerText(&wszBuf);

			Result = wszBuf;

			Tag->Release();

		 }

		 pDisp->Release();

		 TagsList->Release();

	}

	ABody->Release();

    TagsList->Release();

	return(Result);

}

//---------------------------------------------------------------------------

AnsiString __fastcall TForm1::AddLatLngToList(const AnsiString Lat,const AnsiString Lng)

{

	if (Lat != "" && Lng != "")

	{

		ListView1->Items->Add();

		ListView1->Items->Add()->Caption = Lng;

		ListView1->Items->Add()->SubItems->Add(Lat);

		ListView1->Items->Add()->MakeVisible(false);

	}

	return(0);

}

//---------------------------------------------------------------------------

void __fastcall TForm1::WebBrowser1CommandStateChange(TObject *ASender, int Command,

		  WordBool Enable)

{

  GetIdValue("");

  //Lat = GetIdValue("LatValue");

  //Lng = GetIdValue("LngValue");

  if( Lat != "" && Lng != "" && (Lat != Edit1->Text | Lng != Edit2->Text) )

  {

		Edit1->Text = Lat;

		Edit2->Text = Lng;

		AddLatLngToList(Lat, Lng);

  }

}

//---------------------------------------------------------------------------

希望妖哥或是其他厲害的大大可以救救我。

...全文

509 3 打赏收藏转发到动态举报

写回复

3 条回复

切换为时间正序

请发表友善的回复…

发表回复

aniugee 2014-11-20

打赏
举报

記憶體錯誤是什么意思？ AnsiString HTMLsrc = "C:/Users/FCU/Desktop/Map.html"; WebBrowser1->Navigate2(HTMLsrc); 能否改成：AnsiString HTMLsrc = "C:\\Users\\FCU\\Desktop\\Map.html";

heureux0748 2014-10-18

打赏
举报

HTML部分


<!DOCTYPE html>
<html>
  <head>
    <meta name="viewport" content="initial-scale=1.0, user-scalable=no" />
    <style type="text/css">
      html { height: 100% }
      body { height: 100%; margin: 0; padding: 0 }
      #map_canvas { height: 100% }
    </style>
    <script type="text/javascript"
      src="http://maps.googleapis.com/maps/api/js?&sensor=FALSE">
    </script>
    <script type="text/javascript">

  var geocoder; 
  var map;  
  var markersArray = [];

  function initialize() { 
    geocoder = new google.maps.Geocoder();
    var latlng = new google.maps.LatLng(40.714776,-74.019213); 
    var myOptions = { 
      zoom: 13,
      center: latlng, 
      mapTypeId: google.maps.MapTypeId.ROADMAP 
    }; 
    map = new google.maps.Map(document.getElementById("map_canvas"), myOptions); 
    map.set("streetViewControl", false);
    google.maps.event.addListener(map, "click", 
         function(event) 
                        {
                         document.getElementById("LatValue").value = event.latLng.lat(); 
                         document.getElementById("LngValue").value = event.latLng.lng(); 
                         PutMarker(document.getElementById("LatValue").value, document.getElementById("LngValue").value,"") 
                        } 
   ); 

  } 


  function GotoLatLng(Lat, Lang) { 
   var latlng = new google.maps.LatLng(Lat,Lang);
   map.setCenter(latlng);
  }


function ClearMarkers() {  
  if (markersArray) {        
    for (i in markersArray) {  
      markersArray[i].setMap(null); 
    } 
  } 
}  

  function PutMarker(Lat, Lang, Msg) { 
   var latlng = new google.maps.LatLng(Lat,Lang);
   var marker = new google.maps.Marker({
      position: latlng, 
      map: map,
      title: Msg+" ("+Lat+","+Lang+")"
});
markersArray.push(marker); 
index= (markersArray.length % 10);
if (index==0) { index=10 } 
  icon = "http://www.google.com/mapfiles/kml/paddle/"+index+"-lv.png"; 
  marker.setIcon(icon);
 }


</script> 
</head>

<body onload="initialize()">
  <div id="map_canvas" style="width:100%; height:100%"></div>
  <div id="latlong">
  <input type="hidden" id="LatValue" >
  <input type="hidden" id="LngValue" >
  </div>  

</body> 
</html>

heureux0748 2014-10-18

打赏
举报

要轉Builder的delphi程式碼


unit uMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, XPMan, ComCtrls,MSHTML;
 
type
  TFrmMain = class(TForm)
    WebBrowser1: TWebBrowser;
    PanelHeader: TPanel;
    ButtonGotoLocation: TButton;
    XPManifest1: TXPManifest;
    LabelLatitude: TLabel;
    LabelLongitude: TLabel;
    Longitude: TEdit;
    Latitude: TEdit;
    ButtonClearMarkers: TButton;
    ListView1: TListView;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure ButtonClearMarkersClick(Sender: TObject);
    procedure WebBrowser1CommandStateChange(ASender: TObject; Command: Integer;  Enable: WordBool);
    procedure ButtonGotoLocationClick(Sender: TObject);
  private
    HTMLWindow2: IHTMLWindow2;
    procedure AddLatLngToList(const Lat,Lng:string);
  public
  end;
 
var
  FrmMain: TFrmMain;
 
implementation
 
{$R *.dfm}
 
uses
   ActiveX;
 
const
HTMLStr: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script type="text/javascript">// <![CDATA[
src</span>="http://maps.google.com/maps/api/js?sensor=false&language=en">
// ]]></script> '+
//'<script type="text/javascript">// <![CDATA[
src</span>="http://maps.google.com/maps/api/js?sensor=false">
// ]]></script> '+
'<script type="text/javascript"> '+
''+
''+
'  var geocoder; '+
'  var map;  '+
'  var markersArray = [];'+
''+
''+
'  function initialize() { '+
'    geocoder = new google.maps.Geocoder();'+
'    var latlng = new google.maps.LatLng(40.714776,-74.019213); '+
'    var myOptions = { '+
'      zoom: 13, '+
'      center: latlng, '+
'      mapTypeId: google.maps.MapTypeId.ROADMAP '+
'    }; '+
'    map = new google.maps.Map(document.getElementById("map_canvas"), myOptions); '+
'    map.set("streetViewControl", false);'+
'    google.maps.event.addListener(map, "click", '+
'         function(event) '+
'                        {'+
'                         document.getElementById("LatValue").value = event.latLng.lat(); '+
'                         document.getElementById("LngValue").value = event.latLng.lng(); '+
'                         PutMarker(document.getElementById("LatValue").value, document.getElementById("LngValue").value,"") '+
'                        } '+
'   ); '+
''+
'  } '+
''+
''+
'  function GotoLatLng(Lat, Lang) { '+
'   var latlng = new google.maps.LatLng(Lat,Lang);'+
'   map.setCenter(latlng);'+
'  }'+
''+
''+
'function ClearMarkers() {  '+
'  if (markersArray) {        '+
'    for (i in markersArray) {  '+
'      markersArray[i].setMap(null); '+
'    } '+
'  } '+
'}  '+
''+
'  function PutMarker(Lat, Lang, Msg) { '+
'   var latlng = new google.maps.LatLng(Lat,Lang);'+
'   var marker = new google.maps.Marker({'+
'      position: latlng, '+
'      map: map,'+
'      title: Msg+" ("+Lat+","+Lang+")"'+
'  });'+
'  markersArray.push(marker); '+
'  index= (markersArray.length % 10);'+
'  if (index==0) { index=10 } '+
'  icon = "http://www.google.com/mapfiles/kml/paddle/"+index+"-lv.png"; '+
'  marker.setIcon(icon); '+
'  }'+
''+
''+
''+'</script> '+
'</head> '+
''+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'  <div id="latlong"> '+
'  <input type="hidden" id="LatValue" >'+
'  <input type="hidden" id="LngValue" >'+
'  </div>  '+
''+
'</body> '+
'</html> ';
 
procedure TFrmMain.FormCreate(Sender: TObject);
var
  aStream     : TMemoryStream;
begin
   WebBrowser1.Navigate('about:blank');
    if Assigned(WebBrowser1.Document) then
    begin
      aStream := TMemoryStream.Create;
      try
         aStream.WriteBuffer(Pointer(HTMLStr)^, Length(HTMLStr));
         //aStream.Write(HTMLStr[1], Length(HTMLStr));
         aStream.Seek(0, soFromBeginning);
         (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(aStream));
      finally
         aStream.Free;
      end;
      HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow;
    end;
end;
 
procedure TFrmMain.WebBrowser1CommandStateChange(ASender: TObject;  Command: Integer; Enable: WordBool);
var
  ADocument : IHTMLDocument2;
  ABody     : IHTMLElement2;
  Lat : string;
  Lng : string;
 
      function GetIdValue(const Id : string):string;
      var
        Tag      : IHTMLElement;
        TagsList : IHTMLElementCollection;
        Index    : Integer;
      begin
        Result:='';
        TagsList := ABody.getElementsByTagName('input');
        for Index := 0 to TagsList.length-1 do
        begin
          Tag:=TagsList.item(Index, EmptyParam) As IHTMLElement;
          if CompareText(Tag.id,Id)=0 then
            Result := Tag.getAttribute('value', 0);
        end;
      end;
 
begin
  if TOleEnum(Command) <> CSC_UPDATECOMMANDS then
    Exit;
 
  ADocument := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(ADocument) then
    Exit;
 
  if not Supports(ADocument.body, IHTMLElement2, ABody) then
    exit;
 
  Lat :=GetIdValue('LatValue');
  Lng :=GetIdValue('LngValue');
  if  (Lat<>'') and (Lng<>'') and ((Lat<>Latitude.Text) or (Lng<>Longitude.Text)) then
  begin
    Latitude.Text :=Lat;
    Longitude.Text:=Lng;
    AddLatLngToList(Lat, Lng);
  end;
end;
procedure TFrmMain.AddLatLngToList(const Lat, Lng: string);
var
  Item  : TListItem;
begin
   if (Lat<>'') and (Lng<>'') then
   begin
     Item:=ListView1.Items.Add;
     Item.Caption:=Lng;
     Item.SubItems.Add(Lat);
     Item.MakeVisible(False);
   end;
end; 
procedure TFrmMain.ButtonClearMarkersClick(Sender: TObject);
begin
  HTMLWindow2.execScript('ClearMarkers()', 'JavaScript');
  ListView1.Items.Clear;
end;
procedure TFrmMain.ButtonGotoLocationClick(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then
    HTMLWindow2.execScript(Format('GotoLatLng(%s,%s)',[ListView1.Selected.SubItems[0],ListView1.Selected.Caption]), 'JavaScript');
end;
end.