I have been trying to stream the contents of a TTabSheet, but WriteComponent just streams the TTabSheet object, but not the controls on it.
To get around this I thought I could stream all the controls on the tabsheet, using the following code, but this only streams the first control.
procedure TfrmMain.SaveComponentToFile(Component: TComponent; const FileName: TFileName);
var
FileStream : TFileStream;
MemStream : TMemoryStream;
i: integer;
begin
MemStream := nil;
if not Assigned(Component) then raise Exception.Create('Component is not assigned');
FileStream := TFileStream.Create(FileName,fmCreate);
try
MemStream := TMemoryStream.Create;
//ShowMessage(IntToStr(TTabSheet(Component).ControlCount));
for i := 0 to TTabSheet(Component).ControlCount - 1 do begin
Memstream.WriteComponent(TTabSheet(Component).Controls[i]);
end;
MemStream.Position := 0;
ObjectBinaryToText(MemStream, FileStream);
finally
MemStream.Free;
FileStream.Free;
end;
end;
The commented out ShowMessage does show the correct number of controls on the tabsheet, so why is the loop not streaming all 35 components?
Related
I'm using Delphi 5 Enterprise because that's what the program I'm working with was written in. I have written a procedure which saves bitmaps to an Access database quite happily. Now I want to be able to retrieve the bitmaps. Saving the bitmaps, I use SaveToStream. Retrieving them, I used LoadFromStream but the compiler tells me that it doesn't recognise that function. The code is below:
procedure TForm1.Button2Click(Sender: TObject);
var
Field : TBlobField;
Stream : TStream;
BMap : TBitMapImage;
begin
if BloBQuery.Active then
begin
Field := TBlobField(BlobQuery.FieldByName('Blob'));
Stream := BlobQuery.CreateBlobStream(Field, bmRead);
BMap := TBitMapImage.Create;
try
Image2.Picture.Graphic := BMap.LoadFromStream(Stream);
finally
BMap.Free;
Stream.Free;
end;
end;
end;
Can anyone tell me when LoadFromStream won't work? It seems odd! Thanks.
The code which wrote the bitmap was:
procedure TForm1.Button1Click(Sender: TObject);
var
Field : TBlobField;
Stream : TStream;
begin
if (BlobQuery.Active = True) and (Image1.Picture.Graphic <> nil) then begin
BlobQuery.Insert;
Field := TBlobField(BlobQuery.FieldByName('Blob'));
Stream := BlobQuery.CreateBlobStream(Field, bmWrite);
try
Image1.Picture.Graphic.SaveToStream(Stream);
finally
Stream.Free;
BlobQuery.Post;
end;
end;
end;
Assuming Image1.Picture.Graphic was pointing at a TBitmap object when you saved it to the DB, you need to use a TBitmap object instead of a TBitMapImage object when reading the image back out, eg:
procedure TForm1.Button2Click(Sender: TObject);
var
Field : TBlobField;
Stream : TStream;
BMap : TBitmap;
begin
if BlobQuery.Active then
begin
Field := TBlobField(BlobQuery.FieldByName('Blob'));
Stream := BlobQuery.CreateBlobStream(Field, bmRead);
try
BMap := TBitmap.Create;
try
BMap.LoadFromStream(Stream);
Image2.Picture.Graphic := BMap;
finally
BMap.Free;
end;
finally
Stream.Free;
end;
end;
end;
Alternatively:
procedure TForm1.Button2Click(Sender: TObject);
var
Field : TBlobField;
Stream : TStream;
begin
if BlobQuery.Active then
begin
Field := TBlobField(BlobQuery.FieldByName('Blob'));
Stream := BlobQuery.CreateBlobStream(Field, bmRead);
try
Image2.Picture.Bitmap.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
end;
I am using Delphi 2007 with Indy 10. I have a gzip file. I have verified it can be decompressed with this Online Decompression Tool.
I am trying to use the TIdCompressorZlib component to decompress using Delphi. Here is my code:
procedure TForm2.Button9Click(Sender: TObject);
var
lCompressor : TIdCompressorZLib;
FileStream : TFileStream;
memorystream: TMemoryStream;
begin
lCompressor := TIdCompressorZLib.create(self);
FileStream := TFileStream.Create('c:\temp\test.gz', fmOpenRead);
filestream.position := 0;
memorystream:= TMemoryStream.create;
memorystream.position := 0;
lcompressor.DecompressGZipStream(FileStream,MemoryStream);
filestream.free;
showmessage('done');
end;
I cannot get it to work. If I pass fmOpenReadWrite in the constructor I get a zlib error (-5) when DecompressGZipStream is called.
If I pass fmOpenRead in the constructor I get a OS System Error Code 5 Access Denied when DecompressGZipStream is called.
Update David Hefferan suggested it is a file reading issue. So I am zeroing in on that. I am able to copy the file using this procedure:
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
showmessage('done');
End;
UPD Per David Heffernan, I have verified I can Read the data. I successfully ran the file through the following function. It returns the proper number of characters (bytes):
function GetTextFromFile(AFile: string; var Returnstring: string): Boolean;
var
FileStream: TFileStream;
begin
Result := False;
if not FileExists(AFile) then Exit;
FileStream := TFileStream.Create(AFile, fmOpenRead);
try
if FileStream.Size <> 0 then
begin
SetLength(Returnstring, FileStream.Size);
FileStream.Read(Returnstring[1], FileStream.Size);
Result := True;
end;
finally
FileStream.Free;
end;
end;
You can try to use Delphi zlib unit to decompress gzip.
Sample code:
procedure TForm2.Button9Click(Sender: TObject);
var
DecompressionStream : TDecompressionStream;
FileStream : TFileStream;
dest: TFileStream;
byteCount: Integer;
buffer: array [0..65535] of Byte;
begin
FileStream := TFileStream.Create('c:\temp\test.gz', fmOpenRead);
try
//no need to set FileStream position to 0, it's there already
DecompressionStream:=TDecompressionStream.Create(FileStream, 15+16);
//16 is flag that gzip stream used, not zlib.
//15 is maximum memory usage, to speed-up decompression.
try
dest:=TFileStream.Create('c:\temp\test.txt', fmCreate);
try
dest.CopyFrom(DecompressionStream,0);
finally
dest.free;
end;
finally
DecompressionStream.free;
end;
finally
filestream.free;
end;
showmessage('done');
end;
UPD: this code doesn't work for D2007 or earlier versions, no overloaded constructor with WindowBits argument...
I have been making an application at Delphi XE3. I am trying to display values from database to the TAdvStringGrid component placed on the form. I am using dataset to display results at TAdvSTringGRid (code is given below). All other values are displaying perfectly except Image in database. Where it is expected to show image, it is showing junk characters. How to display image perfectly from DataBase at TAdvStringGrid.
SQLConnection1: TSQLConnection;
SQLMonitor1: TSQLMonitor;
DataSource1: TDataSource;
ADOConnection1: TADOConnection;
ClientDataSet1: TClientDataSet;
AdvStringGrid1: TAdvStringGrid;
procedure Button1Click(Sender: TObject);
procedure ShowSelectResults(results: TDataSet; sg: TAdvSTringGrid);
procedure FormCreate(Sender: TObject);
procedure TForm2.FormCreate(Sender: TObject);
var
results: TDataSet;
begin
SQLConnection1.Params.Add('Database=E:\playdb.s3db');
try
SQLConnection1.Connected := true;
SQLMonitor1.Active := True;
SQLConnection1.Execute('Select * from plays', nil, results);
except
on E: EDatabaseError do
ShowMessage('Exception raised with message' + E.Message);
end;
ShowSelectResults(results, advstringgrid1);
end;
Call to ShowSelectResult below
procedure TForm2.ShowSelectResults(results: TDataSet; sg: TAdvStringGrid);
var
names: TStringList;
i,j,k, rc: Integer;
resultsfield: variant;
Field: TblobField;
Stream: TStream;
Jpg: TJPEGImage;
Picture: TPicture;
begin
if not results.IsEmpty then
//Prints Data in the TAdvStringGrid
results.First;
j := 1;
while not results.EOF do
begin
if (j>sg.rowcount) then
sg.rowcount := sg.rowcount + 1;
for i := 0 to results.fields.Count - 1 do
begin
if i=0 then
else if i = 4 then
//Here I want to display image from db
Field := TBlobField(results.FieldByName(names[i]).AsString);
Stream := results.CreateBlobStream(Field, bmRead);
sg.CreatePicture(i, j, true, ShrinkWithAspectRatio, 20, haCenter, vaAboveText).Picture
else
sg.cells[i,j] := results.FieldByName(names[i]).AsString;
end;
results.Next;
inc(j);
end;
end;
Problem is at the else if i=4 loop in the above code at sg.CreatePicture (format of the CreatePicture procedure is given below), where I want to display image in that particular column.
In manual of TAdvStringGrid they have mentioned following methods for picture display at grid cells
Grid.CreatePicture(2,3,True,Shrink,0,haLeft,vaTop).LoadFromFile(‘TST.JPG’);
procedure AddPicture(ACol,ARow: Integer;APicture:TPicture;transparent: Boolean; stretchmode:TStretchMode; padding: Integer; hal:TCellHalign; val:TCellValign);
function GetPicture(ACol,ARow: Integer): TPicture;
Grid.CreateFilePicture(2,3,True,Shrink,0,haLeft,vaTop).Filename := ‘TST.JPG’;
But there is no mention about how to use it with DataSet.I am messing with CreatePicture procedure of TAdvStringGRid, not getting it worked out with DataSet.
Latest Development
Finally I find out way with the help of some scholars like Bummi to save the JPEG image into memorystream and then display same.
My latest code is as follows
procedure TForm2.ShowSelectResults(results: TDataSet; sg: TAdvStringGrid);
var
names: TStringList;
Field: TblobField;
//Stream: TStream;
Stream: TMemoryStream;
//blobType := TBlobType;
Jpg: TJPEGImage;
Picture: TPicture;
Image: TImage;
Graphic: TGraphic;
Begin
//k := results.FieldCount;
//sg.Rowcount := rc;
results.First;
j := 1;
while not results.EOF do
begin
if (j>sg.rowcount) then
sg.rowcount := sg.rowcount + 1;
for i := 0 to results.fields.Count - 1 do
begin
if i=0 then
else if i = 4 then // Column 5 for Image
begin
try
if ((results.FieldByName(names[i]).AsString) <> '') then
Begin
Stream := TMemoryStream.Create;
Image := Timage.Create(Self);
Jpg := TJPEGImage.Create;
Picture := TPicture.Create;
Field := TBlobField(results.FieldByName('image'));
Stream := results.CreateBlobStream(Field, bmReadWrite);
//Field.SaveToStream(Stream);
Stream.Position := 0;
Jpg.LoadFromStream(Stream);
Picture.Assign(Jpg);
//Jpg.LoadFromFile('C:\Sample Pictures\Cabo.jpg');
//Picture.Assign(Jpg);
sg.AddPicture(i,j,Picture,True,ShrinkWithAspectRatio,0,haLeft,vaTop);
end;
finally
Jpg.Free;
Stream.Free;
end;
end
else
//Prints data in other columns
sg.cells[i.j] := results.FieldByName(names[i]).AsString;
inc(j);
end;
end;
Now it's facing some memory issue according to me at the line Jpg.LoadFromStream(Stream);
It is error code JPEG Error #53 , I came to know that above such error code display only when image you are trying to access via memorystream is corrupted but I have made sure image is not corrupted and displaying properly with the help of other software extracted from similar database. I also have renewed the image in the database. Still why I am getting JPEG Error #53. Problem is mainly at Jpg.LoadFromStream(Stream)
Note that the with commented code
Jpg.LoadFromFile('C:\Sample Pictures\Cabo.jpg');
Picture.Assign(Jpg);
sg.AddPicture(i,j,Picture,True,ShrinkWithAspectRatio,0,haLeft,vaTop);
When it is extracted from static file it works perfectly. Problem is only with the MemoryStream. How to rectify this error?
CreateBlobStream is creating a TStream object, not a TMemoryStream.
Since you do not want to write the JPG to the database you should use bmRead instead of bmReadWrite.
I am not used to SQLite, but you will have to make sure that you are using a suitable binary datetype (BLOB).
JPG := TJpegImage.Create;
Picture:= TPicture.Create;
try
st := results.CreateBlobStream(TBlobField(results.FieldByName('image')), bmRead);
try
JPG.LoadFromStream(st);
Picture.Assign(JPG);
sg.AddPicture(i,j,Picture,True,ShrinkWithAspectRatio,0,haLeft,vaTop);
finally
st.Free;
end;
finally
JPG.Free;
Picture.Free;
end;
To ensure that the stored image is really a JPG you should write the JPG for testing with something like:
var
ms: TMemoryStream;
begin
ads.Open;
ads.Append;
ms := TMemoryStream.Create;
try
Image1.Picture.Graphic.SaveToStream(ms); // make sure having loaded a JPG
ms.Position := 0;
TBlobField(ads.FieldByName('image')).LoadFromStream(ms);
finally
ms.Free;
end;
ads.Post;
end;
I realize this is a tad late, but I wanted to contribute. I quite simply did the following, having not to worry about the image format (.jpg, .png etc.). I simply create a TStream object, load the BLOB stream into it, and then I load the Image from the stream. Short and sweet, and it works great for me.
var
Stream : TStream;
begin
try
Stream := TStream.Create;
Stream := Dataset.CreateBlobStream(Dataset.FieldByName('SIGNATURE'), bmRead);
Stream.Position := 0;
lblPicSize.Caption := 'Picture is ' + IntToStr(Stream.Size) + ' Bytes';
if Stream.Size <= 0 then
pnlPic.Caption := '<No Signature>'
else
pnlPic.Caption := '';
try
imgSignature.Picture.LoadFromStream(Stream);
except
on E:Exception do
begin
ShowMessage(E.Message);
end;
end;
finally
Stream.Free;
end;
end;
i'm using delphi xe4 with indy10 component and i want to send an image from an Tidudpclient to Tidudpserver. I already done this operation with tcp component,but the same code didn't work with udp. how i can do this?
Thanks in advance!
Timage(client)--->streamUDP-->Timage(server)
CLIENT SIDE----------------------------------------------- SEND IMAGE
var
pic: tbitmap;
Strm : TMemoryStream;
img2:Timage;
buffer:TIdBytes;
begin
try
img2:=Timage.Create(nil);
pic:=Tbitmap.Create;
Takekpic(pic);
BMPtoJPG(pic,img2);
Strm := TMemoryStream.Create;
img2.Picture.bitmap.SaveToStream(strm);
Strm.Position:=0;
ReadTIdBytesFromStream(Strm,buffer,SizeOf(Strm),0);
IdTrivialFTPServer1.SendBuffer('192.168.17.128',1234,buffer);
finally
strm.Free;
end;
end;
SERVER SIDE---------------------------------------------------- READ IMAGE
procedure TForm6.IdTrivialFTP1UDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
var
Strm : TMemoryStream;
Jpg: TJpegImage;
begin
Strm := TMemoryStream.Create;
try
WriteTIdBytesToStream(Strm,AData,SizeOf(AData),0);
strm.Position:=0;
Jpg := TJpegImage.Create;
jpg.LoadFromStream(Strm); <---- error while reading (JPEG Error #53)
img1.Picture.assign(jpg);
finally
strm.Free;
Jpg.Free;
end;
end;
what can be wrong in this code?
TIdUDPClient and TIdUDPServer do not support sending/receiving TStream data. You can save your image data into a TStream, but you will have to send/receive it using TIdBytes chunks.
Alternatively, use TIdTrivialFTP and TIdTrivialFTPServer instead, which implement TFTP, a UDP-based file transfer protocol. They operate using TStream objects
Update: for example:
Client:
var
bmp: TBitmap;
jpg: TJPEGImage;
Strm : TMemoryStream;
begin
Strm := TMemoryStream.Create;
try
jpg := TJPEGImage.Create;
try
bmp := TBitmap.Create;
try
Takekpic(bmp);
jpg.Assign(bmp);
finally
bmp.Free;
end;
jpg.SaveToStream(Strm);
finally
jpg.Free;
end;
Strm.Position := 0;
{
These can be assigned ahead of time...
IdTrivialFTP1.Host := '192.168.17.128';
IdTrivialFTP1.Port := 1234;
}
IdTrivialFTP1.Put(Strm, 'image.jpg');
finally
Strm.Free;
end;
end;
Server:
procedure TForm6.IdTrivialFTPServer1WriteFile(Sender: TObject; var FileName: String; const PeerInfo: TPeerInfo; var GrantAccess: Boolean; var AStream: TStream; var FreeStreamOnComplete: Boolean) of object;
begin
if FileName = 'image.jpg' then
begin
GrantAccess := True;
AStream := TMemoryStream.Create;
FreeStreamOnComplete := True;
end else
GrantAccess := False;
end;
{
If you set TIdTrivialFTPServer.ThreadedEvent to False, this event handler
runs in the context of the main thread, so the UI can be accessed safely.
If you set IdTrivialFTPServer.ThreadedEvent to True, this event handler
runs in the context of a worker thread, so you will have to manually
synchronize with the main thread when updating the UI...
}
procedure TForm6.IdTrivialFTPServer1TransferComplete(Sender: TObject; const Success: Boolean; const PeerInfo: TPeerInfo; var AStream: TStream; const WriteOperation: Boolean);
var
jpg: TJPEGImage;
begin
if WriteOperation and Success then
begin
jpg := TJPEGImage.Create;
try
AStream.Position := 0;
jpg.LoadFromStream(AStream);
img1.Picture.Assign(jpg);
finally
jpg.Free;
end;
end;
end;
Why does this code not work?
I am writing an application that has ability to save and load its own files and need to know how to stream objects to a file using FileStream.
procedure TForm1.btnSaveClick(Sender: TObject);
var
fs: TFileStream;
begin
fs := TFileStream.Create('c:\temp\a.my', fmCreate);
try
fs.WriteBuffer(Image1.Picture.Graphic, SizeOf(TGraphic));
finally
fs.Free;
end;
ShowMessage('ok');
Image1.Picture.Graphic := nil;
end;
procedure TForm1.btnLoadClick(Sender: TObject);
var
fs: TFileStream;
g: TGraphic;
begin
fs := TFileStream.Create('c:\temp\a.my', fmOpenRead);
try
fs.ReadBuffer(g, SizeOf(TGraphic));
Image1.Picture.Graphic := g;
finally
fs.Free;
end;
ShowMessage('ok');
end;
EDIT 1:
Found the way to do it, but need some more help:
procedure TForm1.btnSaveClick(Sender: TObject);
var
fs: TFileStream;
s: TMemoryStream;
buf: TBytes;
begin
fs := TFileStream.Create('c:\temp\a.my', fmCreate);
s := TMemoryStream.Create;
try
Image1.Picture.Graphic.SaveToStream(s);
SetLength(buf, s.Size);
s.Position := 0;
s.ReadBuffer(buf[0], s.Size);
//fs.WriteBuffer(, SizeOf(Integer)); <-here how do I save an integer which represents the size of the buffer? (so that when reading back i read this first.)
fs.WriteBuffer(buf[0], s.Size);
finally
s.Free;
fs.Free;
end;
ShowMessage('ok');
Image1.Picture.Graphic := nil;
end;
What you have done there is stream the reference, i.e. a pointer. What you need to stream is the contents. You can that with SaveToFile and LoadFromFile.
Regarding your update, assign s.Size to a local variable of type Integer and then use WriteBuffer to save it. In reverse, use ReadBuffer to read into a local variable.
If I were you I would write direct to the file and avoid the memory streak. Use the Position property of TStream to seek around the file. So write 0 for then length, write the graphic, seek back to the beginning and write the true length accounting for the 4 bytes of the length.