因此,我在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;
德尔福代码:
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是深色图像。
最佳答案
您需要使用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();