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;
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;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With