От Дельфи до Лазаря - сканлайн
Итак, у меня есть устаревший код в Delphi, и я хотел опробовать этот код в Lazarus. После внесения некоторых изменений код был скомпилирован в Lazarus, и я был в порядке. Однако я столкнулся с проблемой, которую я не мог понять.
Исходный код Delphi загружает изображение DICOM из текущего каталога, преобразует его в растровое изображение и отображает его. Delphi IDE работает нормально, однако в Lazarus изображение полностью темное. Я конвертировал Scanline в "GetDataLineStart" и TLazIntfImage. Но до сих пор нет изображения. Ниже приведены Delphi и Lazarus для сравнения. Код Лазаря:
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;
Я думаю, что я вставил стену кода, но если кто-то заинтересован, я думаю, что основной блок, который может быть ответственным
iByteArrayInt := Integer(BuffArray);
for i4 := 0 to iHeight1 do
begin
Row := bitmap.ScanLine[i4];
CopyMemory(Row, Pointer(iByteArrayInt + i4 * iWidth), iWidth);
end;'
Также я пытаюсь создать какой-нибудь файл во время отладки в Lazarus: TempFile.bin и TempFile.bmp. Здесь, похоже, заполнен TempFile.bin, но TempFile.bmp - темное изображение.
1 ответ
Вам нужно обернуть код, который мутирует растровое изображение с bitmap.BeginUpdate()/bitmap.EndUpdate()
Например:
bitmap.BeginUpdate();
for i4 := 0 to iHeight1 do
begin
Row := bitmap.ScanLine[i4];
CopyMemory(Row, Pointer(iByteArrayInt + i4 * iWidth), iWidth);
end;
bitmap.EndUpdate();