Search code examples
delphibitmaptfilestream

writing/reading bitmaps to a tfilestream


i've searched and searched and can't seem to find anything that describes what i'm look to do in delphi code. the solutins are sometimes close but not close enough for me to figure out. so here i am asking..

i have many bitmaps that i am retreaving from screenshots. what i have been doing is saving to bitmaps_001.bmp, but it takes a lot a storage space, so i upgraded the routine to save as bitmaps_001.png, and this saves even greater space, but now i want to save to one file, a tfilestream, and read from it using a tprogressbar that i can drag left/right as the images show on screen.

basically, i am trying to acomplish the following:

procedure SaveBMPtoStream(st: tfilestream; bmp: tbitmap);
procedure ReadBMPfrStream(st: tfilestream; bmp: tbitmap; bnum: integer);

so far the code (below)works as is, (it writes and reads in one bitmap image at the press of a tbutton) but i can only write one bitmap image. i need to write as many images as necessary per session to the tfilestream in realtime, possibly using a ttimer control and let it write as many images until i press the stop tbutton. what can i do to modify the code below to solve this? thank you.

i am running windows xp, attached to external usb3.0 1tb drive with NTFS file system.

type
  TMS = TFileStream; 
var
  MS:  TMS; 
  pos: int64;   // bnum for 0-99,999 images.
  sz:  integer; // size of the image/stream ?

//write bitmaps to stream
procedure SaveBMPtoStream(ms: TMS; Bmp: TBitmap; bnum: integer);
begin
  // create (or append to) stream
  if fileexists('d:\streams\s.stm') then MS := TFileStream.Create('d:\streams\s.stm', fmOpenReadWrite)
    else MS := TFileStream.Create('d:\streams\s.stm', fmCreate);
  //sz:=MS.Size; pos:=ms.Position;
  bmp.SaveToStream(MS); 
  // free stream
  ms.free;
end;

//read bitmaps from stream
procedure ReadBMPfrStream(ms: TMS; Bmp: TBitmap; bnum: integer);
begin
  // open stream.
  MS := TFileStream.Create ('d:\streams\s.stm', fmOpenReadWrite); 
  // read in bitmap from stream
  //sz:=MS.Size; pos:=ms.Position;
  bmp.LoadFromStream(MS);
  // free stream
  ms.free;
end;

Solution

  • Function LoadBMPFromStream(const fn: String; Bmp: TBitmap; Nr: Integer):Boolean;
    var // Nr is 0 based first Bitmap=0
      fs: TFileStream;
      ms: TMemoryStream;
      intNr: Integer;
      pos: Cardinal;
      size: DWord;
    begin
      intNr := 0;
      if fileexists(fn) then
      begin
        Result := true;
        fs := TFileStream.Create(fn, fmOpenRead or fmShareDenyNone);
        try
          fs.Read(size, SizeOf(DWord)); // Read Size of first Bitmap
          while (Nr > intNr) and (fs.Position < fs.size) do
          begin
            fs.Seek(size, soFromCurrent);
            fs.Read(size, SizeOf(DWord)); // Read Size of  Bitmap with intNr
            inc(intNr);
          end;
          if fs.Position < fs.size then
          begin
            ms := TMemoryStream.Create;
            try
              ms.CopyFrom(fs, size);
              ms.Position := 0;
              Bmp.LoadFromStream(ms);
            finally
              ms.Free;
            end;
          end
          else Result := false;
        finally
          fs.Free;
        end;
    
      end;
    end;
    
    
    procedure SaveBMPtoStream(const fn: String; Bmp: TBitmap);
    var
      fs: TFileStream;
      ms: TMemoryStream;
      pos: Cardinal;
      size: DWord;
    begin
      if fileexists(fn) then
      begin
        fs := TFileStream.Create(fn, fmOpenReadWrite or fmShareDenyNone);
        fs.Seek(0, soEnd);
      end
      else
      begin
        fs := TFileStream.Create(fn, fmCreate or fmShareDenyNone);
      end;
      try
        ms := TMemoryStream.Create;
        try
          Bmp.SaveToStream(ms);
          size := ms.size;
          ms.Position := 0;
          fs.Write(size, SizeOf(DWord)); // Write Size of next Bitmap first
          fs.CopyFrom(ms, size);
        finally
          ms.Free;
        end;
      finally
        fs.Free;
      end;
    
    end;
    
    procedure TForm6.Button2Click(Sender: TObject);
    begin
      // load first Picture
      LoadBMPFromStream('C:\temp\test.str', Image3.picture.bitmap, 0);
      // load third picture
      // LoadBMPFromStream('C:\temp\test.str', Image3.picture.bitmap, 2);
    end;
    
    procedure TForm6.Button1Click(Sender: TObject);
    begin
      SaveBMPtoStream('C:\temp\test.str', Image1.picture.bitmap);
      SaveBMPtoStream('C:\temp\test.str', Image2.picture.bitmap);
      SaveBMPtoStream('C:\temp\test.str', Image1.picture.bitmap);
    end;