Giriş Yap

**COMMANDX** · (Son Düzenleme: 24-02-2021, Saat: 12:37, Düzenleyen: COMMANDX.)

Masa Üstü uygulamam için webbrowsere yüklenen Google veya Yandex map ta Mouse ile bir koordinata tıkladığımda form üzerinde bulunan edit1= latitude, edit2=longitude yani enlem ve boylamı nasıl çekebilirim
Mouse ile tıkladığım zaman koordinat almak istiyorum

apikey nedir ilgisi varmıdır ne işe yarıyor bilmiyorum,
.
bulduğum örneklerde işlemin tersi olan örneklere rastladım, örneklerin hepsi enlem boylam girilerek webbrowser mapı yükleyip kordinata zoomlanıyor
Benim aradığım, webbrowser map yüklendiyse mouse ile bir noktaya tıkladığımda Edit lere enlem boylam verisini çekmek
Kısa yolu varmı?

Delphi7 kullanıyorum.

**mrmarman** · 22-02-2021, Saat: 22:57

Merhaba.

bu linkteki örneği denedim çalıştı ancak Google bu maps api'lerini paralı hale getirmiş ekranda yazı geliyor.

**COMMANDX** · (Son Düzenleme: 23-02-2021, Saat: 10:13, Düzenleyen: COMMANDX.)

Hocam teşekkür ederim, Tam aradığım gibi Yarını sabırsızlıkla bekliyorum, Derleyici şu an olmadığı için, yarını iple çekiyorum.

Bir de iştahımı kabartmak için gif koymuşsunuz ya

daha artık ne diyim.

Stackı bi inceleyeyim,

**engerex** · 23-02-2021, Saat: 08:08

Bu "developer vs..." mesajını bi yöntemle kaldırmıştım. Bulabilirsem eklerim.

**COMMANDX** · (Son Düzenleme: 24-02-2021, Saat: 00:25, Düzenleyen: COMMANDX.)

Hocam Kodları uyarladım Webbrowser ile olmadı EmbeddedWebBrowser ile denedim olmadı.
Mümkünse Çalışan Kaynak Kodlarını paylaşmanız mümkün mü?
Hatamı görmek istiyorum, Sanırım javascript tetiklemiyor veya bir yerlerde yanlış yapıyorum mouse ile tıklıyorum
Editler içinde veri = 0 oluyor.

Edit: Deneme işlemi, Not alma kısmı = (Kendime notlar)
Test edilecek yerler, Buton kodu Fonksiyon sonrasına kaydırılacak. (henüz denenmedi)
IOUTILS. PAS inline hata satırı nedeniyle Manuel Reg girilecek. (denenmedi)

Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION]
"project1.exe"=dword:02AF9

ok.
user agent mozilla denenecek (denenmedi})

procedure BrowseEt( strURL : String; WebBrowser:TWebBrowser );
Const
 strUserAgent = 'Mozilla/5.0 (Windows; U; MSIE 9.0; WIndows NT 9.0; en-US))';
Var
 Headers  : OleVariant;
begin
 Headers := 'Content-type: application/x-www-form-urlencoded'#10#13
          + 'User-Agent: '+strUserAgent;
 WebBrowser.Silent := True;
 WebBrowser.Navigate( strURL,
                      EmptyParam, EmptyParam, EmptyParam, Headers);
 while Webbrowser.ReadyState <> READYSTATE_COMPLETE do
 begin
   Sleep(1);
   Application.ProcessMessages;
 end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
 BrowseEt('www.google.map adres', WebBrowser1 );
end;

Bunu da gözden geçireyim

type TBrowserEmulationAdjuster = class
private
    class function GetExeName(): String; inline;
 public const
    // Quelle: https://msdn.microsoft.com/library/ee330730.aspx, Stand: 2017-04-26
    IE11_default   = 11000;
    IE11_Quirks    = 11001;
    IE10_force     = 10001;
    IE10_default   = 10000;
    IE9_Quirks     = 9999;
    IE9_default    = 9000;
    /// <summary>
    /// Webpages containing standards-based !DOCTYPE directives are displayed in IE7
    /// Standards mode. Default value for applications hosting the WebBrowser Control.
    /// </summary>
    IE7_embedded   = 7000;
 public
    class procedure SetBrowserEmulationDWORD(const value: DWORD);
end platform;

class function TBrowserEmulationAdjuster.GetExeName(): String;
begin
  Result := TPath.GetFileName( ParamStr(0) );
end;

class procedure TBrowserEmulationAdjuster.SetBrowserEmulationDWORD(const value: DWORD);
const registryPath = 'Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION';
var
  registry:   TRegistry;
  exeName:   String;
begin
  exeName := GetExeName();

  registry := TRegistry.Create(KEY_SET_VALUE);
  try
     registry.RootKey := HKEY_CURRENT_USER;
     Win32Check( registry.OpenKey(registryPath, True) );
     registry.WriteInteger(exeName, value)
  finally
     registry.Destroy();
  end;

//Button veya Form Oncreate 
TBrowserEmulationAdjuster.SetBrowserEmulationDWORD(TBrowserEmulationAdjuster.IE11_Quirks);

**mrmarman** · 23-02-2021, Saat: 13:18

@COMMANDX Webbrowser ile uygulama geliştirecekseniz bundan sonra FEATURE_BROWSER_EMULATION kısmını ilgili her projenize eklemelisiniz. Aynı kodu aynı kaynaktan aldığımıza göre, Internet Explorer emulasyonu sorunu yaşıyor olmalısınız.

Kaynak kod (emulasyon ve gps koordinatı revize edilmiş haliyle) aşağıdaki gibidir.


Uses MSHTML, ActiveX, Registry, System.IOUtils;

var
  HTMLWindow2: IHTMLWindow2;

const
  HTMLStr: AnsiString =
      '<html> '+
      '<head> '+
      '<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
      '<script type="text/javascript" src="http://maps.google.com/maps/api/js?v=3.22"></script> '+
      '<script type="text/javascript"> '+
      ''+
      ''+
      '  var geocoder; '+
      '  var map;  '+
      '  var markersArray = [];'+
      ''+
      ''+
      '  function initialize() { '+
      '    geocoder = new google.maps.Geocoder();'+
      '    var latlng = new google.maps.LatLng(39.847945244469344,32.842092740777986); '+
      '    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 TForm1.Button1Click(Sender: TObject);
const
  IE11_Quirks    = 11001;
var
  aStream     : TMemoryStream;
begin
  SetBrowserEmulationDWORD( IE11_Quirks );

  WebBrowser1.Silent := true;
  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 TForm1.SetBrowserEmulationDWORD(const value: DWORD);
const
  registryPath = 'Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION';
var
  registry  : TRegistry;
  exeName   : String;
begin
  exeName   := TPath.GetFileName( ParamStr(0) );

  registry  := TRegistry.Create(KEY_SET_VALUE);
  try
     registry.RootKey := HKEY_CURRENT_USER;
     Win32Check( registry.OpenKey(registryPath, True) );
     registry.WriteInteger(exeName, value)
  finally
     registry.Destroy();
  end;
end;


procedure TForm1.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<>Edit1.Text) or (Lng<>Edit2.Text)) then
  begin
    Edit1.Text :=Lat;
    Edit2.Text:=Lng;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  HTMLWindow2.execScript('ClearMarkers()', 'JavaScript');
end;

**COMMANDX** · (Son Düzenleme: 25-02-2021, Saat: 17:32, Düzenleyen: COMMANDX.)

Delphi7 ye uyarladım, Çözüldü , Prosedürü Butondan önceye taşıdım ve ok işaretli olan yer uygulamanın (FEATURE_BROWSER_EMULATION) sorunu kendisini registrye kaydedememesiydi Cevap verip Emek harcadığınız için binlerce teşekkür ederim sn @mrmarman

Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION]
"project1.exe"=dword:02AF9

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, OleCtrls, SHDocVw, StdCtrls,FILECTRL, RzButton, jpeg, ExtCtrls;

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Edit2: TEdit;
   WebBrowser1: TWebBrowser;
   Label1: TLabel;
   Button5: TButton;
   Label2: TLabel;
   Image1: TImage;
   Image2: TImage;
   RzBitBtn1: TRzBitBtn;
   RzBitBtn2: TRzBitBtn;
   procedure WebBrowser1CommandStateChange(Sender: TObject;
     Command: Integer; Enable: WordBool);
   procedure RzBitBtn1Click(Sender: TObject);
   procedure RzBitBtn2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}
Uses MSHTML, ActiveX, Registry;

var
 HTMLWindow2: IHTMLWindow2;

const
 HTMLStr: AnsiString =
     '<html> '+
     '<head> '+
     '<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
     '<script type="text/javascript" src="http://maps.google.com/maps/api/js?v=3.22"></script> '+
     '<script type="text/javascript"> '+
     ''+
     ''+
     '  var geocoder; '+
     '  var map;  '+
     '  var markersArray = [];'+
     ''+
     ''+
     '  function initialize() { '+
     '    geocoder = new google.maps.Geocoder();'+
     '    var latlng = new google.maps.LatLng'+'(39.847945244469344,32.842092740777986); '+
     '    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 TForm1.WebBrowser1CommandStateChange(Sender: 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<>Edit1.Text) or (Lng<>Edit2.Text)) then
 begin
   Edit1.Text :=Lat;
   Edit2.Text:=Lng;
 end;
end;

procedure SetBrowserEmulationDWORD(const value: DWORD);
const
 registryPath = 'Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION';
var
 registry  : TRegistry;
 exeName   : String;
begin

exeName   := extractfilename (Application.exename); // <<< -----  
//eski path filename d7 için burayı yazınca çalıştı


 registry  := TRegistry.Create(KEY_SET_VALUE);
 try
    registry.RootKey := HKEY_CURRENT_USER;
    Win32Check( registry.OpenKey(registryPath, True) );
    registry.WriteInteger(exeName, value)
 finally
    registry.Destroy();
 end;
end;



procedure TForm1.RzBitBtn1Click(Sender: TObject);
begin
 HTMLWindow2.execScript('ClearMarkers()', 'JavaScript');
end;

procedure TForm1.RzBitBtn2Click(Sender: TObject);

const
 IE11_Quirks    = 11001; // <- ok
var
 aStream     : TMemoryStream;
begin
 SetBrowserEmulationDWORD( IE11_Quirks );

 WebBrowser1.Silent := true;
 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;

end.

**tmrksmt** · 24-02-2021, Saat: 22:31

Merhaba...
İlgili linkteki kodu ben de bir ara uyarlayıp denemiştim. Ancak konuyu görünce ilgimi çekti aklıma gelmişken tekrar bir bakayım dedim, bu sefer denediğimde çalışmadı Smile

) Çalışmadı derken hiçbir hata vermiyor ancak Webbrowser'a map getirmiyor! 2-3 ay kadar önce aynı kodlarla çalışıyordu.
Daha önce hangi IE vardı bilmiyorum ama şuanda pc de IE 8 var... Default tarayıcı Chrome...
Sizce sorun ne olabilir acaba?

**mrmarman** · 24-02-2021, Saat: 23:32

@tmrksmt Verdiğim kod içerisinde projenizin EXE'sine özel internet explorer 11.0 emulasyon yapma opsiyonu ekleyen procedure var.
Verdiğim kodu veya daha iyisi @COMMANDX 'in Delphi 7 uyumlu olarak revize ettiğini olduğu gibi deneyin isterseniz.

**tmrksmt** · (Son Düzenleme: 25-02-2021, Saat: 00:03, Düzenleyen: tmrksmt.)

(24-02-2021, Saat: 23:32)mrmarman Adlı Kullanıcıdan Alıntı: @tmrksmt Verdiğim kod içerisinde projenizin EXE'sine özel internet explorer 11.0 emulasyon yapma opsiyonu ekleyen procedure var.
Verdiğim kodu veya daha iyisi @COMMANDX 'in Delphi 7 uyumlu olarak revize ettiğini olduğu gibi deneyin isterseniz.

Evet Muharrem Bey birebir aynı kodları denedim ancak WebBrowser bomboş geliyor nedense çok enteresan.

(24-02-2021, Saat: 23:52)tmrksmt Adlı Kullanıcıdan Alıntı:
(24-02-2021, Saat: 23:32)mrmarman Adlı Kullanıcıdan Alıntı: @tmrksmt Verdiğim kod içerisinde projenizin EXE'sine özel internet explorer 11.0 emulasyon yapma opsiyonu ekleyen procedure var.
Verdiğim kodu veya daha iyisi @COMMANDX 'in Delphi 7 uyumlu olarak revize ettiğini olduğu gibi deneyin isterseniz.

Evet Muharrem Bey birebir aynı kodları denedim ancak WebBrowser bomboş geliyor nedense çok enteresan.

Boş gelen TWebBrowser üzerinde sağ click yapıp "Kaynağı görüntüle" dediğimde Javascript satırlarını görebiliyorum ama Map filan gelmiyor nesne üzerine...

Giriş Yap
Kullanıcı Adı:
Şifreniz:	Şifremi Unuttum?
	Beni Hatırla

Konu ile Alakalı Benzer Konular
Konular		Yazar	Yorumlar	Okunma	Son Yorum
	Shift+Ctrl+C sorunu [ÇÖZÜLDÜ]	woywod	5	309	22-02-2021, Saat: 20:44 Son Yorum: woywod
	Yeni Nesil Hdd için seri numarası alma	cinarbil	5	317	15-02-2021, Saat: 12:12 Son Yorum: serdar
	Çok biçimlilik hakkında (Çözüldü)	vkamadan	2	243	09-02-2021, Saat: 15:47 Son Yorum: vkamadan
	Fast Report Dot Matrix Rapor Oluşturma ve Yazdırma [Çözüldü]	bünyamin68	0	160	25-01-2021, Saat: 10:00 Son Yorum: bünyamin68
	[ÇÖZÜLDÜ] Programın Ram üzerinde kapladığı alan hk.	shooterman	16	5.666	19-01-2021, Saat: 15:41 Son Yorum: mrmarman