webForumDet fria alternativet

Gif och LoadFromStream

3 svar · 273 visningar · startad av AG

AGMedlem sedan mars 20001 266 inlägg
#1

Kanske en konstig fråga, men jag gör ett försök
Hur laddar man en gif-bild med LoadFromStream?
Jag använder GifImage av någon Melander. Ifall jag vill ladda in den med vanlig LoadFromFile fungerar det som följer. Ex.
Image1.Picture.LoadFromFile('c:\windows\skrivbord\bild.gif');

Dock är det så att LoadFromStream inte verkar fungera, vad kan jag tänkas göra för fel. Jag använder Delphi 3.

Andreas

TigermannenMedlem sedan juli 200124 inlägg
#2

gif.loadfromstream

så här kan man göra:

procedure TForm1.Button1Click(Sender: TObject);
var
stream : TMemoryStream;
gif : TGIFImage;
begin
try
//
// stream med bild
//
stream := TMemoryStream.Create;
stream.LoadFromFile('mingifbild.gif');

GIF := TGIFImage.create;
//
// ladda filen från memorystream
//
GIF.LoadFromStream(stream);

//
// visa bilden i image1
//
Image1.Picture.Assign(GIF);

finally
stream.Free;
GIF.Free;
end;
end;

mvh Tony

AGMedlem sedan mars 20001 266 inlägg
#3

Tack Tony, men tyvärr får jag det ej att fungera, man ser att programmet hämtar hem filen, men den klarar ej att presentera det, får felet "Project Project1.exe raised exception class EConvertError with message 'Cannot assign TForm1 to a TPicture' Process stopped. Use Step or Run to continue.", raden "GetURL(self);" markeras sen.

Nedan är komplett kod:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  HttpProt, ExtCtrls, StdCtrls, ShellAPI, GifImage;

type
  TForm1 = class(TForm)
    Image1: TImage;
    InfoLabel: TLabel;
    Timer1: TTimer;
    HttpCli1: THttpCli;
    Image2: TImage;
    procedure HttpCli1DocData(Sender: TObject; Buffer: Pointer;
      Len: Integer);
    procedure HttpCli1HeaderData(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure GetData(Sender: TObject);
    procedure GetURL(Sender: TObject);
  end;

var
  Form1: TForm1;
  URL : string;

implementation

{$R *.DFM}

procedure ExploreWeb(handle:HWND ; page:PChar);
var
  Returnvalue   : integer;
begin
  ReturnValue := ShellExecute(handle, 'open', page, nil, nil, SW_SHOWNORMAL);
  if ReturnValue <= 32 then
    case Returnvalue of
      0                   : MessageBox(handle,'Error: Out of Memory','Error',0);
      ERROR_FILE_NOT_FOUND: MessageBox(handle,'Error: File not found','Error',0);
      ERROR_PATH_NOT_FOUND: MessageBox(handle,'Error: Directory not','Error',0);
      ERROR_BAD_FORMAT    : MessageBox(handle,'Error: Wrong format in EXE','Error',0);
      // All other errors . See help for more ReturnValues of ShellExecute
    else
      MessageBox(handle,PChar('Error Nr: '+IntToStr(Returnvalue)+' in ShellExecute'),'Error',0)
    end //case
end;

procedure TForm1.GetURL(Sender: TObject);
begin
  HttpCli1.URL        := 'http://www.mindomän.com/servlet/MittServlet';
  HttpCli1.RcvdStream := TMemoryStream.Create;
  InfoLabel.Caption   := 'Loading';
  try
    try
      HttpCli1.Get;
      InfoLabel.Caption := 'Received ' +
                           IntToStr(HttpCli1.RcvdStream.Size) + ' bytes';
      SetLength(URL, HttpCli1.RcvdStream.Size);
      HttpCli1.RcvdStream.Position := 0;
      HttpCli1.RcvdStream.Read(URL[1],HttpCli1.RcvdStream.Size);
    except
      on E: EHttpException do
      begin
        InfoLabel.Caption := 'Failed : ' +
                             IntToStr(HttpCli1.StatusCode) + ' ' +
                             HttpCli1.ReasonPhrase;;
      end
      else
        raise;
      end;
  finally
    HttpCli1.RcvdStream.Destroy;
    HttpCli1.RcvdStream := nil;
  end;
end;

procedure TForm1.GetData(Sender: TObject);
var
GIF : TGIFImage;

begin
  HttpCli1.URL        := 'http://www.mindomän.com/images/banner.gif';
  HttpCli1.RcvdStream := TMemoryStream.Create;
  InfoLabel.Caption   := 'Loading';

  try
    try
      HttpCli1.Get;
      InfoLabel.Caption := 'Received ' +
                           IntToStr(HttpCli1.RcvdStream.Size) + ' bytes';
      HttpCli1.RcvdStream.Position := 0;
      try
        //Image1.Picture.Bitmap.LoadFromStream(HttpCli1.RcvdStream);
        GIF.LoadFromStream(HttpCli1.RcvdStream);

//
// visa bilden i image1
//
Image1.Picture.Assign(GIF);
      except
          InfoLabel.Caption := 'Failed : Can''t load banner'
      end;
    except
      on E: EHttpException do
      begin
        InfoLabel.Caption := 'Failed : ' +
                             IntToStr(HttpCli1.StatusCode) + ' ' +
                             HttpCli1.ReasonPhrase;;
      end
      else
        raise;
    end;
  finally
    HttpCli1.RcvdStream.Destroy;
    HttpCli1.RcvdStream := nil;
  end;
end;

procedure TForm1.HttpCli1DocData(Sender: TObject; Buffer: Pointer;
  Len: Integer);
begin
  InfoLabel.Caption := IntToStr(HttpCli1.RcvdCount);
end;

procedure TForm1.HttpCli1HeaderData(Sender: TObject);
begin
  InfoLabel.Caption := InfoLabel.Caption + '.';
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
  if URL <> '' then
    ExploreWeb(handle,PChar(URL));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Interval := 60000;
  GetData(self);
  GetURL(self);
  InfoLabel.Caption := 'Done (click it!)';
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Timer1.Enabled := true;
end;
end.

DU ser att gammal rad, som fungerar med en .bmp-bild är bortkommenterad.

tack
Andreas

TigermannenMedlem sedan juli 200124 inlägg
#4

Mycket konstigt, du ska kunna göra image1.picture.assign(gif)....
Kan du visa gifbilder i image-komponenter?
Du kan ju prova att mellanlagra filen på disken och använda den på följande sätt:

.
.
HttpCli1.RcvdStream.Position := 0;
try
//Image1.Picture.Bitmap.LoadFromStream(HttpCli1.RcvdStream);
GIF.LoadFromStream(HttpCli1.RcvdStream);
gif.SaveToFile('temp.gif');
image1.Picture.LoadFromFile('temp.gif');

Om inte detta fungerar så är det nog fel på din TGifimage-installation. Kontrollera även att den fysika filen (temp.gif) är ok.

mvh Tony

128 ms totalt · 3 externa anrop · v20260731065814-full.30151723
0 ms — hämta forumlista (cache)
0 ms — hämta statistik (cache)
125 ms — hämta tråd, inlägg och bilagor (db)