CODEWITHSUNDEEP
delphilazarusscanline
Dwight Schrute
Dwight Schrute

Reputation: 369

delphi to lazarus - scanline

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.

Upvotes: 2

Views: 1921

Answers (1)

Pidhorskyi
Pidhorskyi

Reputation: 1579

You need to wrap the code that mutates the bitmap with bitmap.BeginUpdate()/bitmap.EndUpdate()

For example:

bitmap.BeginUpdate();
for i4 := 0 to iHeight1 do
begin
    Row := bitmap.ScanLine[i4];
    CopyMemory(Row, Pointer(iByteArrayInt + i4 * iWidth), iWidth);
end;
bitmap.EndUpdate();

Upvotes: 2

Related Questions