所以，我在Delphi中有遗留代码，我想在Lazarus中尝试该代码。在进行一些更改后，在Lazarus编译的代码和我很好。但是我遇到了一个我无法理解的问题。
原始的delphi代码从当前目录加载DICOM图像，将其转换为位图并显示它。 Delphi IDE工作正常但是在Lazarus中图像完全是黑暗的。我确实将Scanline转换为＆＃34; GetDataLineStart＆＃34;和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是一个暗图像。
答案 0 :(得分：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();