Thema: Delphi EmbeddedWB für Seattle

Einzelnen Beitrag anzeigen

ScharfeMietze

Registriert seit: 5. Mär 2014
165 Beiträge
 
Delphi 10.2 Tokyo Architect
 
#4

AW: EmbeddedWB für Seattle

  Alt 29. Okt 2015, 23:21
THX für den Link!
Ich poste hier die Änderungen.
Ich kann auf den ersten Blick feststellen, das das Absturzchaos endete.
Ausführliche Tests waren noch nicht möglich. Bisher ist alles wie es soll.
Gruß
SM

Delphi-Quellcode:
procedure TEmbeddedWB.SetUserAgentInt;
var
  Control: IOleControl;
begin
  if FUserAgent <> FUserAgentInt then
  begin
    RestoreUserAgentReg;
  if DefaultInterface.QueryInterface(IOleControl, Control) = 0 then
  with (Application as IOleControl) do
    begin
      FUserAgentInt := FUserAgent;
      Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERAGENT);
      //_Release; gelöscht Seattle fix
    end;
  end;
end;

procedure TCustomEmbeddedWB.SetDesignMode(const Value: Boolean);
var
  Control: IOleControl;
begin
  FDesignMode := Value;
  if DefaultInterface.QueryInterface(IOleControl, Control) = 0 then
    with (Application as IOleControl) do
    begin
      OnAmbientPropertyChange(DISPID_AMBIENT_USERMODE);
      //_Release; gelöscht Seattle fix
    end;
end;

procedure TCustomEmbeddedWB.SetDownloadOptions(const Value: TDownloadControlOptions);
begin
  FDownloadControlOptions := Value;
  UpdateDownloadControlValues;
  with (Application as IOleControl) do
  begin
    OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
    //_Release; gelöscht Seattle fix
  end;
end;

procedure TCustomEmbeddedWB.SetUserInterfaceOptions(const Value: TUserInterfaceOptions);
begin
  FUserInterfaceOptions := Value;
  UpdateUserInterfaceValues;
  with (Application as IOleControl) do
  begin
    OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
    //_Release; gelöscht Seattle fix
  end;
end;

function GetBmpFromBrowser(Document: IDispatch; Handle: THandle; Width, Height: Integer; FileName: string): Boolean;
var
  ViewObject: IViewObject;
  sourceDrawRect: TRect;
  ScreenImg: Graphics.TBitmap;
begin
  Result := False;
  if DocumentLoaded(Document) then
  try
    Document.QueryInterface(IViewObject, ViewObject);
    if Assigned(ViewObject) then
    try
      ScreenImg := TBitmap.Create;
      ScreenImg.Height := Height;
      ScreenImg.Width := Width;
      sourceDrawRect := Rect(0, 0, ScreenImg.Width, ScreenImg.Height);
      ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Handle,
        ScreenImg.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
      ScreenImg.SaveToFile(FileName);
      Result := True;
    finally
// ViewObject._Release; gelöscht Seattle fix
    end;
  except
    Result := False;
  end;
end;

function InvokeCMD(Document: IDispatch; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): HRESULT;
var
  CmdTarget: IOleCommandTarget;
  PtrGUID: PGUID;
begin
 // New(PtrGUID);
  Result := S_FALSE;
  if InvokeIE then
  begin
    New(PtrGUID);
    PtrGUID^ := CLSID_WebBrowser;
  end
  else
    PtrGuid := PGUID(nil);
  if DocumentLoaded(Document) then
  try
    Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    Result := CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut); // hinzugefügt Seattle fix
// try
// Result := CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
// finally
// CmdTarget._Release;
// end;
  except
  end;
  Dispose(PtrGUID);
end;
  Mit Zitat antworten Zitat