Javascript In Delphi Twebbrowser, Closing Threads

July 27, 2023 Post a Comment

I am attempting to build a system in delphi that allows users to use Google Maps. It all works fine, but i'm noticing that every time a new TWebBrowser object is created and the ja

Solution 1:

This does not answer this question, it only simplifies the problem to be simulated.

See how many threads is running after each button click. It uses the Simple Google Maps example, so the problem is not even in your javascript part.

Unit1 - contains main form, where is just a button with OnClick event handler

unit Unit1;

interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, PsAPI, TlHelp32, Unit2;

typeTForm1= class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetThreadCount(const APID: Cardinal): Integer;
var
  NextProc: Boolean;
  ProcHandle: THandle;
  ThreadEntry: TThreadEntry32;
begin
  Result := 0;
  ProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
  if (ProcHandle <> INVALID_HANDLE_VALUE) then
  try
    ThreadEntry.dwSize := SizeOf(ThreadEntry);
    NextProc := Thread32First(ProcHandle, ThreadEntry);
    while NextProc do
    begin
      if ThreadEntry.th32OwnerProcessID = APID then
      Inc(Result);
      NextProc := Thread32Next(ProcHandle, ThreadEntry);
    end;
  finallyCloseHandle(ProcHandle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ModalForm: TForm2;
begin
  ModalForm := TForm2.Create(nil);
  try
    ModalForm.ShowModal;
  finally
    ModalForm.Free;
  end;
  ShowMessage('Thread count: ' + 
    IntToStr(GetThreadCount(GetCurrentProcessId)));
end;

end.

Unit2 - contains form with the TWebBrowser on it and the form's OnCreate event handler

unit Unit2;

interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ActiveX;

typeTForm2= class(TForm)
    WebBrowser1: TWebBrowser;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

const
  HTMLString: AnsiString =
    '<!DOCTYPE html>' +
    '<html>' +
    '  <head>' +
    '    <title>Google Maps JavaScript API v3 Example: Map Simple</title>' +
    '    <meta name="viewport"' +
    '        content="width=device-width, initial-scale=1.0, user-scalable=no">' +
    '    <meta charset="UTF-8">' +
    '    <style type="text/css">' +
    '      html, body, #map_canvas {' +
    '        margin: 0;' +
    '        padding: 0;' +
    '        height: 100%;' +
    '      }' +
    '    </style>' +
    '    <script type="text/javascript"' +
    '        src="http://maps.googleapis.com/maps/api/js?sensor=false"></script>' +
    '    <script type="text/javascript">' +
    '      var map;' +
    '      function initialize() {' +
    '        var myOptions = {' +
    '          zoom: 8,' +
    '          center: new google.maps.LatLng(-34.397, 150.644),' +
    '          mapTypeId: google.maps.MapTypeId.ROADMAP' +
    '        };' +
    '        map = new google.maps.Map(document.getElementById(''map_canvas''),' +
    '            myOptions);' +
    '      }' +
    '      google.maps.event.addDomListener(window, ''load'', initialize);' +
    '    </script>' +
    '  </head>' +
    '  <body>' +
    '    <div id="map_canvas"></div>' +
    '  </body>' +
    '</html>';

procedure TForm2.FormCreate(Sender: TObject);
var
  HTMLStream: TMemoryStream;
begin
  WebBrowser1.Navigate('about:blank');
  ifAssigned(WebBrowser1.Document) then
  begin
    HTMLStream := TMemoryStream.Create;
    try
      HTMLStream.WriteBuffer(Pointer(HTMLString)^, Length(HTMLString));
      HTMLStream.Seek(0, soFromBeginning);
      (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(HTMLStream));
    finally
      HTMLStream.Free;
    end;
  end;
end;

end.

JavaScript Passion

Javascript In Delphi Twebbrowser, Closing Threads

Solution 1:

Post a Comment for "Javascript In Delphi Twebbrowser, Closing Threads"