I have a function that returns a pointer to the memory where the image is stored as Bitmap32.Bits:
function FileToMemoryAsBitmap32Bits: pointer;
var
bmp32: TBitmap32;
wic: TWICImage;
begin
Result := nil;
bmp32 := TBitmap32.Create();
try
wic := TWICImage.Create;
try
wic.LoadFromFile('256x256.jpg');
bmp32.Assign(wic);
GetMem(Result, 256*256*4);
Move(bmp32.Bits^, Result^, 256*256*4);
finally
FreeAndNil(wic);
end;
finally
FreeAndNil(bmp32);
end;
end;
Somewhere further in the code I need to create a new Bitmap32 from this Bits in memory. How to do it correctly?
I tried to do the following:
var
p: Pointer;
NewBitmap32: TBitmap32;
// ...
p := FileToMemoryAsBitmap32Bits;
// ... do something with Bits in memory
NewBitmap32 := TBitmap32.Create(256, 256);
NewBitmap32.Bits := p;
but I get an error:
E2129 Cannot assign to a read-only property
ADDED for #RudyVelthuis:
procedure RenderMemoryToBitmap32(Output: TBitmap32; p: pointer; const x, y: integer);
var
d, i,j: integer;
OutputRowRGBA, RowRGBA: PColor32Array;
begin
RowRGBA := PColor32Array(p);
for j := 0 to 255 do begin
OutputRowRGBA := Output.Scanline[y+j]; // row in large bitmap
for i := 0 to 255 do begin
d := i + x; // offset
TColor32Entry(OutputRowRGBA[d]).B := TColor32Entry(RowRGBA[i]).B;
TColor32Entry(OutputRowRGBA[d]).G := TColor32Entry(RowRGBA[i]).G;
TColor32Entry(OutputRowRGBA[d]).R := TColor32Entry(RowRGBA[i]).R;
TColor32Entry(OutputRowRGBA[d]).A := TColor32Entry(RowRGBA[i]).A;
end;
inc(longword(RowRGBA), 256*4); // next row
end;
end;
You cannot change address of data using this way, memory is already allocated and bitmap32 doesn't allow to replace its address.
But you can move stored data in this location like (but in reverse direction) you already did for storing, but in reverse direction:
Move(p^, NewBitmap32.Bits^, 256*256*4);
While I don't want to question your needs in regards of storing the bitmap as bitstream,
it should also be possible to clone the original bitmap like this:
NewBitmap32 := TBitmap32.Create;
NewBitmap32.Assign(OriginalBitmap);
This will clone the bitmap perfectly in terms of preserving the width and height of the bitmap (which otherwise gets lost). The overhead of having a TBitmap32 in memory instead of a pure bitstream is minimal.
Related
I'm creating a package in which a custom image list reads and writes its content inside a DFM file.
The code I wrote works globally well in all compilers between XE7 and 10.3 Rio. However I have a strange issue in XE2. With this particular compiler, I sometimes receives an empty stream content while the DFM is read, and sometimes a corrupted content.
My custom image list is built above a standard TImageList. I register my read callback this way:
procedure TMyImageList.DefineProperties(pFiler: TFiler);
function DoWritePictures: Boolean;
begin
if (Assigned(pFiler.Ancestor)) then
Result := not (pFiler.Ancestor is TMyImageList)
else
Result := Count > 0;
end;
begin
inherited DefineProperties(pFiler);
// register the properties that will load and save the pictures binary data in DFM files
pFiler.DefineBinaryProperty('Pictures', ReadPictures, WritePictures, DoWritePictures);
end;
Here is the ReadPictures function:
procedure TMyImageList.ReadPictures(pStream: TStream);
begin
LoadPictureListFromStream(m_pPictures, pStream);
end;
Here is the LoadPictureListFromStream function:
procedure TMyImageList.LoadPictureListFromStream(pList: IWPictureList; pStream: TStream);
var
{$if CompilerVersion <= 23}
pImgNameBytes: Pointer;
pData: Pointer;
{$else}
imgNameBytes: TBytes;
{$ifend}
count, i: Integer;
color: Cardinal;
imgClassName: string;
pMemStr: TMemoryStream;
size: Int64;
pItem: IWPictureItem;
pGraphicClass: TGraphicClass;
pGraphic: TGraphic;
begin
// read the list count
pStream.ReadBuffer(count, SizeOf(count));
// is list empty?
if (count <= 0) then
Exit;
pMemStr := TMemoryStream.Create;
// enable the code below to log the received stream content
{$ifdef _DEBUG}
size := pStream.Position;
pStream.Position := 0;
pMemStr.CopyFrom(pStream, pStream.Size);
pMemStr.Position := 0;
pMemStr.SaveToFile('__DfmStreamContent.bin');
pMemStr.Clear;
pStream.Position := size;
{$endif}
try
for i := 0 to count - 1 do
begin
pItem := IWPictureItem.Create;
try
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image type from stream
if (size > 0) then
begin
{$if CompilerVersion <= 23}
pImgNameBytes := nil;
try
GetMem(pImgNameBytes, size + 1);
pStream.ReadBuffer(pImgNameBytes^, size);
pData := Pointer(NativeUInt(pImgNameBytes) + NativeUInt(size));
(PByte(pData))^ := 0;
imgClassName := UTF8ToString(pImgNameBytes);
finally
if (Assigned(pImgNameBytes)) then
FreeMem(pImgNameBytes);
end;
{$else}
SetLength(imgNameBytes, size);
pStream.Read(imgNameBytes, size);
imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
{$ifend}
end;
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image from stream
if (size > 0) then
begin
// read the image in a temporary memory stream
pMemStr.CopyFrom(pStream, size);
pMemStr.Position := 0;
// get the graphic class to create
if (imgClassName = 'TWSVGGraphic') then
pGraphicClass := TWSVGGraphic
else
begin
TWLogHelper.LogToCompiler('Internal error - unknown graphic class - '
+ imgClassName + ' - name - ' + Name);
pGraphicClass := nil;
end;
// found it?
if (Assigned(pGraphicClass)) then
begin
pGraphic := nil;
try
// create a matching graphic to receive the image data
pGraphic := pGraphicClass.Create;
pGraphic.LoadFromStream(pMemStr);
pItem.m_pPicture.Assign(pGraphic);
finally
pGraphic.Free;
end;
end;
pMemStr.Clear;
end;
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the color key from stream
if (size > 0) then
begin
Assert(size = SizeOf(color));
pStream.ReadBuffer(color, size);
// get the color key
pItem.m_ColorKey := TWColor.Create((color shr 16) and $FF,
(color shr 8) and $FF,
color and $FF,
(color shr 24) and $FF);
end;
// add item to list
pList.Add(pItem);
except
pItem.Free;
raise;
end;
end;
finally
pMemStr.Free;
end;
end;
Here is the WritePictures function:
procedure TMyImageList.WritePictures(pStream: TStream);
begin
SavePictureListToStream(m_pPictures, pStream);
end;
And finally, here is the SavePictureListToStream function:
procedure TMyImageList.SavePictureListToStream(pList: IWPictureList; pStream: TStream);
var
count, i: Integer;
color: Cardinal;
imgClassName: string;
imgNameBytes: TBytes;
pMemStr: TMemoryStream;
size: Int64;
begin
// write the list count
count := pList.Count;
pStream.WriteBuffer(count, SizeOf(count));
if (count = 0) then
Exit;
pMemStr := TMemoryStream.Create;
try
for i := 0 to count - 1 do
begin
// a picture should always be assigned in the list so this should never happen
if (not Assigned(pList[i].m_pPicture.Graphic)) then
begin
TWLogHelper.LogToCompiler('Internal error - picture list is corrupted - ' + Name);
// write empty size to prevent to corrupt the stream
size := 0;
pStream.WriteBuffer(size, SizeOf(size));
pStream.WriteBuffer(size, SizeOf(size));
end
else
begin
// save the image type in the stream
imgClassName := pList[i].m_pPicture.Graphic.ClassName;
imgNameBytes := TEncoding.UTF8.GetBytes(imgClassName);
size := Length(imgNameBytes);
pStream.WriteBuffer(size, SizeOf(size));
pStream.Write(imgNameBytes, size);
// save the image in the stream
pList[i].m_pPicture.Graphic.SaveToStream(pMemStr);
size := pMemStr.Size;
pStream.WriteBuffer(size, SizeOf(size));
pStream.CopyFrom(pMemStr, 0);
pMemStr.Clear;
end;
// build the key color to save
color := (pList[i].m_ColorKey.GetBlue +
(pList[i].m_ColorKey.GetGreen shl 8) +
(pList[i].m_ColorKey.GetRed shl 16) +
(pList[i].m_ColorKey.GetAlpha shl 24));
// save the key color in the stream
size := SizeOf(color);
pStream.WriteBuffer(size, SizeOf(size));
pStream.WriteBuffer(color, size);
end;
finally
pMemStr.Free;
end;
end;
When the issue occurs, the content get in imgClassName become incoherent, or sometimes the image count read on the LoadPictureListFromStream() function first line is equals to 0.
Writing the DFM stream content in a file, I also noticed that only the class name value is corrupted, other data seems OK.
This issue happens randomly, sometimes all works fine, especially if I start the app in runtime time without previously opening the form in design time, but it may also happen whereas I just open the form in design time, without changing nor saving nothing. On the other hand, this issue happen only with XE2. I never noticed it on any other compiler.
As I'm a c++ developer writing a Delphi code, and as I needed to adapt a part of the code to be able to compile it under XE2 (see the {$if CompilerVersion <= 23} statements), I probably doing something very bad with the memory, but I cannot figure out what exactly.
Can someone analyse this code and point me what is(are) my mistake(s)?
In your SavePictureListToStream() method, the statement
pStream.Write(imgNameBytes, size);
does not work the way you expect in XE2 and earlier. TStream did not gain support for reading/writing TBytes arrays until XE3. As such, the above statement ends up writing to the memory address where the imgNameBytes variable itself is declared on the stack, not to the address where the variable is pointing to, where the array is allocated on the heap.
For XE2 and earlier, you need to use this statement instead:
pStream.WriteBuffer(PByte(imgNameBytes)^, size);
What you have in your LoadPictureListFromStream() method is technically OK, but your UTF-8 handling is more complicated then it needs to be. TEncoding exists in XE2, as it was first introduced in D2009. But even in older versions, you can and should use a dynamic array instead of GetMem() to simplify your memory management and keep it consistent across multiple versions, eg:
{$if CompilerVersion < 18.5}
type
TBytes = array of byte;
{$ifend}
var
imgNameBytes: TBytes;
...
begin
...
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image type from stream
if (size > 0) then
begin
SetLength(imgNameBytes, size{$if CompilerVersion < 20}+1{$ifend});
pStream.ReadBuffer(PByte(imgNameBytes)^, size);
{$if CompilerVersion < 20}
imgNameBytes[High(imgNameBytes)] := $0;
imgClassName := UTF8ToString(PAnsiChar(pImgNameBytes));
{$else}
imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
{$ifend}
end;
...
end;
I have a weird problem and am not able to solve it. I have a lot of images and I want to create thumbnails of them. I point my application to a directory and it creates thumbnails (64 * 64) of each of them. The trouble is that the previous bitmap persists in a new bitmap which I don't understand. Here is the code of the procedure causing the error:
procedure TMain.import_image_resize (source, destination: string);
var
Input_Bitmap: TBitmap;
begin
Input_Bitmap := TBitmap.CreateFromFile (source);
Input_Bitmap.ReSize (iSize, iSize); // iSize = 64
Input_Bitmap.SaveToFile (destination);
Input_Bitmap.Free;
end; // import_image_resize //
It is called as an argument by import_process_images, below.
procedure TMain.import_process_images (sub: string; process: TConverter);
var
i, n: int32;
dir_input: string;
dir_new: string;
temp: string;
file_path: string;
file_name: string;
file_ext: string;
new_file: string;
source_dirs: TStringDynArray;
destination_dirs: TStringDynArray;
files: TStringDynArray;
begin
// get list of directories from selected directory
source_dirs := TDirectory.GetDirectories (Dir_Selected);
SetLength (destination_dirs, Length (source_dirs));
// create these directories in the destination directory
n := 0;
for dir_input in source_dirs do
begin
i := LastDelimiter ('\', dir_input) - 1;
temp := dir_input.Substring (i + 1);
dir_new := TPath.Combine (Project_Root, Project_Selected);
dir_new := TPath.Combine (dir_new, sub);
dir_new := TPath.Combine (dir_new, temp);
TDirectory.CreateDirectory (dir_new);
destination_dirs [n] := dir_new;
n := n + 1;
end; // for
// for each directory in the selected directory
// - get each image
// - convert it
// - and copy it to the destination directory
n := 0;
Stop_Conversion := False;
for dir_new in source_dirs do
begin
files := TDirectory.GetFiles (dir_new);
for file_path in files do
begin
file_name := TPath.GetFileName (file_path);
file_ext := LowerCase (TPath.GetExtension (file_name));
if (file_ext = '.bmp') or (file_ext = '.jpg') or
(file_ext = '.png') or (file_ext = '.jpeg') then
begin
new_file := TPath.Combine (destination_dirs [n], file_name);
process (file_path, new_file);
Label_Progress.Text := new_file;
Application.ProcessMessages;
if Stop_Conversion then Exit;
end; // if
end; // for
n := n + 1;
end; // for
Label_Progress.Text := 'Ready';
end; (*** import_process_images ***)
Both functions are called from the event handler as follows:
procedure TMain.Button_SelectClick (Sender: TObject);
var
tree_item: TTreeViewItem;
begin
iSize := StrToInt (edit_XSize.Text);
tree_item := Directory_Tree.Selected;
Dir_Selected := tree_item.Text;
import_process_images ('rs', import_image_resize);
end; // Button_SelectClick //
One would expect that the new Input_Bitmap should be only filled with the bitmap loaded from file. However, the resized bitmap shows all images of previous bitmaps (loaded by previous calls from import_image_resize) overlayed with the current one. I don't understand this behavior, anybody got an explanation and, preferrably, a workaround?
Thanks you for your time.
Edit 1
I'll show an example of two photo's successively converted: the first is a landscape photo, the second in portrait. You see the first photo at the edges of the second photo. The second photo just overlayed the first one (the third overlayes the combination of the first two, etc.)
Edit 2
There was a suggestion that some code not shown might have impact on the procedure import_image_resize. As for completeness I added this code but I cannot see my self what exactly I am doing wrong.
I am using delphi XE-5 and I am loading button information from a JSON file, in order to create buttons on a TMS ADVToolBar control. Each button is 50X35 and in png format with transparency.
I am getting each url, using the idHTTP component to retrieve it to a stream and then load it into a png. I then draw it onto a transparent BMP. However, I dont think this is the correct way. Anyway, the bmp is then added to a TImageList where it is assigned to a button using the index. The Image shows up on the button, but with no transparency.
see my code below:
imgUrl:= //code to get img url from JSON file;
MS := TMemoryStream.Create;
png := TPngImage.Create;
png.Transparent:= True;
try
idHTTP1.get(imgUrl,MS);
Ms.Seek(0,soFromBeginning);
png.LoadFromStream(MS);
bmp:= TBitmap.Create;
bmp.Transparent:= True;
bmp.Width:= 50;
bmp.Height:= 50;
png.Draw(bmp.Canvas, Rect(7, 7, png.Width, png.Height));
ImageList1.Add(bmp, nil);
AdvGlowBtn.Images:= ImageList1;
AdvGlowBtn.Layout:= blGlyphTop;
AdvGlowBtn.WordWrap:= False;
AdvGlowBtn.AutoSize:= True;
AdvGlowBtn.ImageIndex:= ImageList1.Count-1;
bmp.Free;
finally
FreeAndNil(png);
FreeAndNil(MS);
end;
At first you have to enable the runtime themes (Project Manager) otherwise you will have no transparency of your images.
And this is the code to load the PNG image into your ImageList1
bmp := TBitmap.Create;
try
// everything done before to bmp has no effect
bmp.Assign( png );
// if for some reason the loaded image is smaller
// set the size to avoid the invalid image size error
bmp.Width := ImageList1.Width;
bmp.Height := ImageList1.Height;
AdvGlowBtn.Images:= ImageList1;
...
// now add the Bitmap to the ImageList
AdvGlowBtn.ImageIndex := ImageList1.Add( bmp, nil );
finally
bmp.Free;
end;
I have an old project in Delphi 5 and I still using it sometimes.
This is my solution using the png object.
procedure ImageList2Alpha(const ImageList: TImageList);
const
Mask: array[Boolean] of Longint = (0, ILC_MASK);
var
TempList: TImageList;
begin
if Assigned(ImageList) then
begin
TempList := TImageList.Create(nil);
try
TempList.Assign(ImageList);
with ImageList do
begin
Handle := ImageList_Create(Width, Height, ILC_COLOR32 or Mask[Masked], 0, AllocBy);
if not HandleAllocated then
raise EInvalidOperation.Create(SInvalidImageList);
end;
Imagelist.AddImages(TempList);
finally
FreeAndNil(TempList);
end;
end;
end;
procedure LoadPngToBmp(var Dest: TBitmap; AFilename: TFilename);
type
TRGB32 = packed record
B, G, R, A : Byte;
end;
PRGBArray32 = ^TRGBArray32;
TRGBArray32 = array[0..0] of TRGB32;
type
TRG24 = packed record
rgbtBlue, rgbtGreen, rgbtRed : Byte;
end;
PRGBArray24 = ^TPRGBArray24;
TPRGBArray24 = array[0..0] of TRG24;
type
TByteArray = Array[Word] of Byte;
PByteArray = ^TByteArray;
TPByteArray = array[0..0] of TByteArray;
var
BMP : TBitmap;
PNG: TPNGObject;
x, y: Integer;
BmpRow: PRGBArray32;
PngRow : PRGBArray24;
AlphaRow: PByteArray;
begin
Bmp := TBitmap.Create;
PNG := TPNGObject.Create;
try
if AFilename <> '' then
begin
PNG.LoadFromFile(AFilename);
BMP.PixelFormat := pf32bit;
BMP.Height := PNG.Height;
BMP.Width := PNG.Width;
if ( PNG.TransparencyMode = ptmPartial ) then
begin
for Y := 0 to BMP.Height-1 do
begin
BmpRow := PRGBArray32(BMP.ScanLine[Y]);
PngRow := PRGBArray24(PNG.ScanLine[Y]);
AlphaRow := PByteArray(PNG.AlphaScanline[Y]);
for X := 0 to BMP.Width - 1 do
begin
with BmpRow[X] do
begin
with PngRow[X] do
begin
R := rgbtRed; G := rgbtGreen; B := rgbtBlue;
end;
A := Byte(AlphaRow[X]);
end;
end;
end;
end else
begin
for Y := 0 to BMP.Height-1 do
begin
BmpRow := PRGBArray32(BMP.ScanLine[Y]);
PngRow := PRGBArray24(PNG.ScanLine[Y]);
for X := 0 to BMP.Width - 1 do
begin
with BmpRow[X] do
begin
with PngRow[X] do
begin
R := rgbtRed; G := rgbtGreen; B := rgbtBlue;
end;
A := 255;
end;
end;
end;
end;
Dest.Assign(BMP);
end;
finally
Bmp.Free;
PNG.Free;
end;
end;
Call ImageList2Alpha(YourImageList) on the OnCreate of the Form (FormCreate), and the ImageList will be ready to store your Bitmaps32 keeping the transparency.
Call the LoadPngToBmp procedure to convert a PNG to Bitmap32 and then, store it on your ImageList.
The TBitmap class uses Windows own libraries to manipulate Bitmaps. Depending on you Windows version, the underlying Operating System libraries does not support 32 bits BMPs, despite the libraries header files declares a BITMAPQUAD struct.
For newer versions of Windows (Vista and above afaik), the field BITMAPQUAD.reserved is used to store the alpha channel. For older versions, this field must remain zero (0x00).
If you are using a "recent" version of Windows, the only possible explanation I see is that the TBitmap class were not updated to support the alpha channel.
Using the class TPNGImage should not be an issue instead of converting it to BMP before using, unless you have some more specific needs.
Use it like that:
ABitmap.SetSize(png.Width, png.Height);
png.AssignTo(ABitmap);
When I search the words "JPEG" and "metadata", I have many answers to manipulate the metadata... and this is the opposite I want... ;o)
I have written a function which exactly works like I want... (if images are similar, and only the metadata change or not, the function returns True ; if at least one pixel changes, it returns False) but, I'd like to improve the performance...
The bottleneck is the bmp.Assign(jpg);
function CompareImages(fnFrom, fnTo: TFileName): Boolean;
var
j1, j2: TJpegImage;
b1, b2: TBitmap;
s1, s2: TMemoryStream;
begin
Result := False;
sw1.Start;
j1 := TJpegImage.Create;
j2 := TJpegImage.Create;
sw1.Stop;
sw2.Start;
s1 := TMemoryStream.Create;
s2 := TMemoryStream.Create;
sw2.Stop;
//sw3.Start;
b1 := TBitmap.Create;
b2 := TBitmap.Create;
//sw3.Stop;
try
sw1.Start;
j1.LoadFromFile(fnFrom);
j2.LoadFromFile(fnTo);
sw1.Stop;
// the very long part...
sw3.Start;
b1.Assign(j1);
b2.Assign(j2);
sw3.Stop;
sw4.Start;
b1.SaveToStream(s1);
b2.SaveToStream(s2);
sw4.Stop;
sw2.Start;
s1.Position := 0;
s2.Position := 0;
sw2.Stop;
sw5.Start;
Result := IsIdenticalStreams(s1, s2);
sw5.Stop;
finally
// sw3.Start;
b1.Free;
b2.Free;
// sw3.Stop;
sw2.Start;
s1.Free;
s2.Free;
sw2.Stop;
sw1.Start;
j1.Free;
j2.Free;
sw1.Stop;
end;
end;
sw1, ..., sw5 are TStopWatch, I used to identify the time spent.
IsIdenticalStreams comes from here.
If I directly compare the TJpegImage, the streams are different...
Any better way to code that?
Regards,
W.
Update:
Testing some solutions extract from the comments, I have the same performance with this code:
type
TMyJpeg = class(TJPEGImage)
public
function Equals(Graphic: TGraphic): Boolean; override;
end;
...
function CompareImages(fnFrom, fnTo: TFileName): Boolean;
var
j1, j2: TMyJpeg;
begin
sw1.Start;
Result := False;
j1 := TMyJpeg.Create;
j2 := TMyJpeg.Create;
try
j1.LoadFromFile(fnFrom);
j2.LoadFromFile(fnTo);
Result := j1.Bitmap.Equals(j2.Bitmap);
finally
j1.Free;
j2.Free;
end;
sw1.Stop;
end;
Any way to directly access the pixel data bytes from the file (skipping the metadata bytes) without bitmap conversion?
JPEG file consists of chunks, which types are identified by markers. The structure of chunks (except for stand-alone SOI, EOI, RSTn):
chunk type marker (big-endian FFxx)
chunk length (big-endian word)
data (length-2 bytes)
Edit: SOS chunk is limited by another marker, not by length.
Metadata chunks start with APPn marker (FFEn), except for APP0 (FFE0) marker with JFIF title.
So we can read and compare only significant chunks and ignore APPn chunks and COM chunk (as TLama noticed).
Example: hex view of some jpeg file:
It starts with SOI (Start Of Image) marker FFD8 (stand-alone, without length),
then APP0 chunk (FFE0) with length = 16 bytes,
then APP1 chunk (FFE1), which contains metadata (EXIF data, NIKON COOLPIX name etc), so we can ignore 9053 bytes (23 5D) and check next chunk marker at address 2373, and so on...
Edit: Simple parsing example:
var
jp: TMemoryStream;
Marker, Len: Word;
Position: Integer;
PBA: PByteArray;
procedure ReadLenAndMovePosition;
begin
Inc(Position, 2);
Len := Swap(PWord(#PBA[Position])^);
Inc(Position, Len);
end;
begin
jp := TMemoryStream.Create;
jp.LoadFromFile('D:\3.jpg');
Position := 0;
PBA := jp.Memory;
while (Position < jp.Size - 1) do begin
Marker := Swap(PWord(#PBA[Position])^);
case Marker of
$FFD8: begin
Memo1.Lines.Add('Start Of Image');
Inc(Position, 2);
end;
$FFD9: begin
Memo1.Lines.Add('End Of Image');
Inc(Position, 2);
end;
$FFE0: begin
ReadLenAndMovePosition;
Memo1.Lines.Add(Format('JFIF Header Len: %d', [Len]));
end;
$FFE1..$FFEF, $FFFE: begin
ReadLenAndMovePosition;
Memo1.Lines.Add(Format('APPn or COM Len: %d Ignored', [Len]));
end;
$FFDA: begin
//SOS marker, data stream, ended by another marker except for RSTn
Memo1.Lines.Add(Format('SOS data stream started at %d', [Position]));
Inc(Position, 2);
while Position < jp.Size - 1 do begin
if PBA[Position] = $FF then
if not (PBA[Position + 1] in [0, $D0..$D7]) then begin
Inc(Position, 2);
Memo1.Lines.Add(Format('SOS data stream ended at %d',
[Position]));
Break;
end;
Inc(Position);
end;
end;
else begin
ReadLenAndMovePosition;
Memo1.Lines.Add(Format('Marker %x Len: %d Significant', [Marker, Len]));
end;
end;
end;
jp.Free;
end;
I am using a TStringBuilder class ported from .Net to Delphi 7.
And here is my code snippet:
procedure TForm1.btn1Click(Sender: TObject);
const
FILE_NAME = 'PATH TO A TEXT FILE';
var
sBuilder: TStringBuilder;
I: Integer;
fil: TStringList;
sResult: string;
randInt: Integer;
begin
randomize;
sResult := '';
for I := 1 to 100 do
begin
fil := TStringList.Create;
try
fil.LoadFromFile(FILE_NAME);
randInt := Random(1024);
sBuilder := TStringBuilder.Create(randInt);
try
sBuilder.Append(fil.Text);
sResult := sBuilder.AsString;
finally
sBuilder.free;
end;
mmo1.Text := sResult;
finally
FreeAndNil(fil);
end;
end;
showmessage ('DOne');
end;
I am experiencing AV errors. I can alleviate the problem when I create memory with the size multiple by 1024, however sometimes it still occurs.
Am I doing something wrong?
Your code is fine. The TStringBuilder code you're using is faulty. Consider this method:
procedure TStringBuilder.Append(const AString : string);
var iLen : integer;
begin
iLen := length(AString);
if iLen + FIndex > FBuffMax then _ExpandBuffer;
move(AString[1],FBuffer[FIndex],iLen);
inc(FIndex,iLen);
end;
If the future length is too long for the current buffer size, the buffer is expanded. _ExpandBuffer doubles the size of the buffer, but once that's done, it never checks whether the new buffer size is sufficient. If the original buffer size is 1024, and the file you're loading is 3 KB, then doubling the buffer size to 2048 will still leave the buffer too small in Append, and you'll end up overwriting 1024 bytes beyond the end of the buffer.
Change the if to a while in Append.