Einzelnen Beitrag anzeigen

Benutzerbild von chaosben
chaosben

Registriert seit: 27. Apr 2005
Ort: Görlitz
1.358 Beiträge
 
Delphi XE2 Professional
 
#4

Re: TWebBrowser Image (PNG) auslesen + anzeigen

  Alt 23. Apr 2009, 14:22
Probiers mal so:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, OleCtrls, SHDocVw, mshtml, ActiveX, winInet,
  pngimage, gifimage, jpeg;

type
  TForm3 = class(TForm)
    WebBrowser1: TWebBrowser;
    ListBox1: TListBox;
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

function GetURLCacheFile(AURL : String; const AData : TMemoryStream) : Integer;
var
  ice : PInternetCacheEntryInfo;
  iceSize : Cardinal;
  CacheEntry : Cardinal;
  DataSize : Cardinal;
  Buffer : Pointer;
begin
  iceSize:=MAX_CACHE_ENTRY_INFO_SIZE;

  Result:=-1;

  GetMem(ice, iceSize);
  try
    CacheEntry:=RetrieveUrlCacheEntryStream(PChar(AUrl), ice^, iceSize, false, 0);
    try
      if CacheEntry>0 then
      begin
        DataSize:=ice.dwSizeLow;
        Adata.Clear;
        AData.SetSize(DataSize);
        Buffer := AData.Memory;
        if ReadUrlCacheEntryStream(CacheEntry, 0, Pointer(Buffer^), DataSize, 0) then
          Result:=DataSize
        else
          RaiseLastOSError;

      end;
    finally
      UnlockUrlCacheEntryStream(CacheEntry, 0);
    end;
  finally
    FreeMem(ice, iceSize);
  end;
end;

procedure TForm3.Button1Click(Sender: TObject);
var
  doc : IHTMLDocument2;
  img : OleVariant;
  images : IEnumVARIANT;
  Fetched : Cardinal;
begin
  ListBox1.Clear;

  if Supports(WebBrowser1.Document, IHTMLDocument2, doc) and
     Supports(doc.images._newEnum, IEnumVARIANT, images) then
  begin
    images.Reset;

    while images.Next(1, img, Fetched) = S_OK do
    begin
      ListBox1.Items.Add(img.src);
    end;
    
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  //WebBrowser1.Navigate('http://www.delphipraxis.net/topic156542_twebbrowser+image+png+auslesen+anzeigen.html');
  WebBrowser1.Navigate('http://commons.wikimedia.org/w/index.php?title=Special%3ASearch&search=png&go=Go');
end;

procedure TForm3.ListBox1Click(Sender: TObject);
var
  ms : TMemoryStream;
  FName : String;
begin
  if ListBox1.ItemIndex > -1 then
  begin
    ms := TMemoryStream.Create;
    GetURLCacheFile(ListBox1.Items[ListBox1.ItemIndex], ms);

    FName := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) +
             'test' + ExtractFileExt(ListBox1.Items[ListBox1.ItemIndex]);

    ms.SaveToFile(FName);

    ms.Free;

    Image1.Picture.LoadFromFile(FName);

    DeleteFile(FName);
  end;
end;

end.
Angehängte Dateien
Dateityp: zip demo_189.zip (357,6 KB, 77x aufgerufen)
Benjamin Schwarze
If I have seen further it is by standing on the shoulders of Giants. (Isaac Newton)
  Mit Zitat antworten Zitat