So, I have legacy code in Delphi and I wanted to try out that code in Lazarus. After making some changes the code compiled in Lazarus and I was good to go. However I have hit a problem that I could not get my head around.
The original delphi code loads DICOM image from current directory, converts it into bitmap and displays it. The Delphi IDE works fine however in Lazarus the image is completely dark. I did convert Scanline to "GetDataLineStart" and TLazIntfImage. But still no image. Below is the Delphi and Lazarus for comparison. Lazarus code:
procedure TForm1.GetThumbnail(index : integer; thumb:TImage);
var
tr : TRect;
newwidth : Integer;
newheight : Integer;
orgwidth : Integer;
orgheight : Integer;
fname : string;
bitmap : TBitmap;
t : TLazIntfImage;
iByteArrayInt : integer;
i4 : integer;
Row : PByteArray;
iwidth : Integer;
iheight1 : Integer;
lAllocSliceSz : Integer;
fileBm : File;
f : text;
tempFile : Longint;
begin
fname := dicomDirArr[index].imageName;
if FileExistsUTF8(fname) { *Converted from FileExists* } then
begin
read_dicom_data(true,true,true,true,true,true,true,
DicomData, HdrOK, ImgOK, DynStr, FName );
if ( HdrOk and ImgOk ) then
begin
lAllocSliceSz := (DicomData.XYZdim[1]*DicomData.XYZdim[2] *
DicomData.Allocbits_per_pixel+7) div 8 ;
if DicomData.Allocbits_per_pixel = 16 then // 16 bit image
begin
FreeMem( Buffer16 );
GetMem( Buffer16, lAllocSliceSz);
AssignFile( Filebm, FName);
FileMode := 0;
Reset(Filebm, 1);
Seek( Filebm, DicomData.ImageStart);
if Buffer16 <> nil then BlockRead(Filebm, Buffer16^, lAllocSliceSz);
orgwidth := DicomData.XYZdim[1];
orgheight := DicomData.XYZdim[2];
ComputeMinMax(orgwidth, orgheight);
SetLength(BuffArray, BufferSizeImg);
ComputeLbuffArray;
CloseFile( Filebm );
bitmap := TBitmap.Create;
bitmap.Width := orgwidth;
bitmap.Height := orgheight;
bitmap.PixelFormat := pf8bit;
bitmap.Palette := MaxGradientPalette;
iWidth := orgwidth;
iHeight1 := orgheight - 1;
iByteArrayInt := Integer(BuffArray);
t := TLazIntfImage.Create(0,0);
t.LoadFromBitmap(bitmap.Handle, bitmap.MaskHandle);
tempFile := FileCreate('TempFile.bin');
//I think this block of code is causing problem; this is different in / //delphi
for i4 := 0 to iHeight1 do
begin
Row := t.GetDataLineStart(i4);
CopyMemory(Row, Pointer(iByteArrayInt + i4 * iWidth), iWidth);
FileSeek(tempFile, i4 * iWidth, fsFromBeginning);
FileWrite(tempFile, Row, iWidth);
end;
FileClose(tempFile);
bitmap.SaveToFile('TempFile.bmp');
thumb.Width := 100;
thumb.Height := 100;
if (orgheight/orgwidth > 1) then
begin // portrait
newheight:=100;
newwidth:=round(orgwidth*(newheight/orgheight));
end
else
begin // landscape
newwidth:=100;
newheight:=round(orgheight*(newwidth/orgwidth));
end;
thumb.AutoSize := false;
thumb.Stretch := false;
thumb.Canvas.Pen.Color := clgray;//clSkyBlue;
thumb.Canvas.Brush.Color := clgray;//clSkyBlue;
tr.left := 0;
tr.right := 100;
tr.top := 0;
tr.bottom := 100;
if (newwidth < 100) then begin // portrait
tr.left := (100-newwidth)div 2;
tr.right := tr.left+newwidth;
tr.top := 0;
tr.bottom := 100;
thumb.canvas.rectangle(0,0,tr.left,100); // fill gray at left
thumb.canvas.rectangle(tr.right,0,100,100);// fill gray at right
end;
if (newheight < 100) then begin // landscape
tr.left := 0;
tr.right := 100;
tr.top := (100-newheight)div 2;
tr.bottom := tr.top+newheight;
thumb.canvas.rectangle(0,0,100,tr.top); // fill gray above
thumb.canvas.rectangle(0,tr.bottom,100,100);// fill gray below
end;
thumb.canvas.stretchdraw(tr, bitmap);
bitmap.Destroy;
bitmap := nil;
t.Destroy ;
t := nil;
end;
end;
end;
end;
Delphi Code:
procedure TForm1.GetThumbnail(index : integer; thumb:TImage);
var
tr : TRect;
newwidth : Integer;
newheight : Integer;
orgwidth : Integer;
orgheight : Integer;
fname : string;
bitmap : TBitmap;
iByteArrayInt : integer;
i4 : integer;
Row : PByteArray;
iwidth : Integer;
iheight1 : Integer;
lAllocSliceSz : Integer;
fileBm : File;
begin
fname := dicomDirArr[index].imageName;
if FileExists(fname) then
begin
read_dicom_data(true,true,true,true,true,true,true,
DicomData, HdrOK, ImgOK, DynStr, FName );
if ( HdrOk and ImgOk ) then
begin
lAllocSliceSz := (DicomData.XYZdim[1]*DicomData.XYZdim[2] *
DicomData.Allocbits_per_pixel+7) div 8 ;
if DicomData.Allocbits_per_pixel = 16 then // 16 bit image
begin
FreeMem( Buffer16 );
GetMem( Buffer16, lAllocSliceSz);
AssignFile( Filebm, FName);
FileMode := 0;
Reset(Filebm, 1);
Seek( Filebm, DicomData.ImageStart);
if Buffer16 <> nil then BlockRead(Filebm, Buffer16^, lAllocSliceSz);
orgwidth := DicomData.XYZdim[1];
orgheight := DicomData.XYZdim[2];
ComputeMinMax(orgwidth, orgheight);
SetLength(BuffArray, BufferSizeImg);
ComputeLbuffArray;
CloseFile( Filebm );
bitmap := TBitmap.Create;
bitmap.Width := orgwidth;
bitmap.Height := orgheight;
bitmap.PixelFormat := pf8bit;
bitmap.Palette := MaxGradientPalette;
iWidth := orgwidth;
iHeight1 := orgheight - 1;
iByteArrayInt := Integer(BuffArray);
for i4 := 0 to iHeight1 do
begin
Row := bitmap.ScanLine[i4];
CopyMemory(Row, Pointer(iByteArrayInt + i4 * iWidth), iWidth);
end;
thumb.Width := 100;
thumb.Height := 100;
if (orgheight/orgwidth > 1) then
begin // portrait
newheight:=100;
newwidth:=round(orgwidth*(newheight/orgheight));
end
else
begin // landscape
newwidth:=100;
newheight:=round(orgheight*(newwidth/orgwidth));
end;
thumb.AutoSize := false;
thumb.Stretch := false;
thumb.Canvas.Pen.Color := clgray;//clSkyBlue;
thumb.Canvas.Brush.Color := clgray;//clSkyBlue;
tr.left := 0;
tr.right := 100;
tr.top := 0;
tr.bottom := 100;
if (newwidth < 100) then begin // portrait
tr.left := (100-newwidth)div 2;
tr.right := tr.left+newwidth;
tr.top := 0;
tr.bottom := 100;
thumb.canvas.rectangle(0,0,tr.left,100); // fill gray at left
thumb.canvas.rectangle(tr.right,0,100,100);// fill gray at right
end;
if (newheight < 100) then begin // landscape
tr.left := 0;
tr.right := 100;
tr.top := (100-newheight)div 2;
tr.bottom := tr.top+newheight;
thumb.canvas.rectangle(0,0,100,tr.top); // fill gray above
thumb.canvas.rectangle(0,tr.bottom,100,100);// fill gray below
end;
thumb.canvas.stretchdraw(tr, bitmap);
bitmap.Destroy;
bitmap := nil;
end;
end;
end;
end;
I think I have pasted wall of code but if somebody is interested I think the main block that might be responsible is
iByteArrayInt := Integer(BuffArray);
for i4 := 0 to iHeight1 do
begin
Row := bitmap.ScanLine[i4];
CopyMemory(Row, Pointer(iByteArrayInt + i4 * iWidth), iWidth);
end;'
Also, I am trying to create to some file during debugging in Lazarus: TempFile.bin and TempFile.bmp. Over here TempFile.bin seems to be populated however TempFile.bmp is a dark image.
You need to wrap the code that mutates the bitmap with
bitmap.BeginUpdate()/bitmap.EndUpdate()For example: