📄 ezdicomimpl1.pas
字号:
end else begin
lMin := 0;
lMax := 0;
end;
end else begin //lWid0ForSlope
lMin := gFastCen - (lWid0ForSlope shr 1);
lMax := lMin + lWid0ForSlope;
lSlopeReal := 255 / lWid0ForSlope;
gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.352059);
end;
if (gDicomData.Allocbits_per_pixel < 9) or (gDICOMdata.RLERedSz > 0) then begin
gWinCen := (gFastCen);
if ((lMax - lMin) >= maxint) or ((lMin=0) and (lMax=0)) then begin
gWInWid := maxint;
end else begin
gWInWid := (lMax - lMin);
end;
end;
if gBuff8Sz > 0 then begin
SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
DICOMImageRefreshAndSize;
end else if gBuff24Sz > 0 then begin
//fargo
SetDimension(g100pctImageHt,g100pctImageWid,24,gBuff24,true);
DICOMImageRefreshAndSize;
end;
end; //procedure UpdatePalette
procedure TezDICOMX.DetermineZoom;
//computes maximum zoom for a given client window size
var lHZoom: single;
lZoom,lZoomPct: integer;
begin
if (not gBestFitZoom) or (g100pctImageHt = 0)
or (g100pctImageWid = 0) then exit;
lHZoom := (ScrollBox1.ClientWidth)/g100pctImageWid;
if ((ScrollBox1.ClientHeight)/g100pctImageHt) < lHZoom then
lHZoom := ((ScrollBox1.ClientHeight)/g100pctImageHt);
lZoomPct := trunc(100*lHZoom);
if lZoomPct < 11 then
lZoom := 10 //.5 zoom
else if lZoomPct > 500 then
lZoom := 500
else lZoom := lZoomPct;
gZoomPct := lZoom;
end; //procedure DetermineZoom
procedure TezDICOMX.DisplayImage(lUpdateCon,lForceDraw: boolean;lSlice: integer; lInWinWid,lInWinCen: double);
//Another complicated procedure: this procedure extracts the raw/uncompressed image data from a DICOM file
//this is complicated as there are many types of compression methods and image formats, a few examples include:
// ->8,12,16,32 bit uncompressed * big or little-endian
// ->lossy 8 and 24bit JPEG
// ->lossless 8,12,16,24bit JPEG
// ->lossless 8bit RLE (runlength encoding)
// -> lossless 16bit Genesis Packed data
// 8bit images often include indexed palettes
{This procedure is made a bit more complicated because portions are looped to create
'mosaic' images, where several slices from the same image are shown simultaneously}
label
123,444;
var
lWinWid,lWinCen: double;
Stream: TMemoryStream;
Jpg: TJPEGImage;
Hd: Integer;
lLookup16,lCompressLine16: SmallIntP0;
lMultiBuff,CptBuff,lBuff,TmpBuff : bYTEp0;
lPtr: Pointer;
lRow: pRGBTripleArray;
lCptPos,lFullSz,lCompSz,lTmpPos,lTmpSz,lLastPixel: longint;
lMultiMultiFile: boolean;
lMultiSliceInc: single;
lMultiMaxSlice,lMultiFullRowSz,lMultiCol,lMultiRow,lMultiStart,lMultiLineSz,lMultiSliceSz,lMultiColSz,
lMultiColSzWOBorders,lnMultiRow,lMultiSlice,lnMultiCol,lnMultiSlice: integer;
lSmall: word;
l16Signed,l16Signed2 : smallint;
lExplicitImageStart : boolean;
lFileName: string;
infp: file;
max16 : LongInt;
min16 : LongInt;
lShort: ShortInt;
lCptVal,lRunVal,lByte2,lByte: integer;
lLineLen,lL,j,size,lScanLineSz,lBufEntries,lLine,lImgPos,lLineStart,lLineEnd,lPos,value,
lInc,lCol,lXdim,lStoreSliceVox,lImageStart,lAllocSLiceSz,lStoreSliceSz,I,I12 : Integer;
lY,lCb,lCr,lR,lG,lB: integer;
hBmp : HBITMAP;
BI : PBitmapInfo;
BIH : TBitmapInfoHeader;
Bmp : TBitmap;
ImagoDC : hDC;
pixmap : Pointer;
PPal: PLogPalette;
function swap16i(lPos: longint): smallint;
//nested function in DisplayImage: converts endianess of 16bit integer
var
s : SmallInt;
begin
seek(infp,lPos);
BlockRead(infp, s, 2{, n});
swap16i:=swap(s);
end; //nested function swap16i
function GetByte: byte;
//nested function in DisplayImage
begin
if lTmpPos >= lTmpSz then begin //whoops GE "compression" has made the file BIGGER!
{Worst case scenario filesize = 150% uncompressed, so this can only happen once}
lTmpSz := FileSize(inFp)-lImageStart;
if (lAllocSliceSz < lTmpSz) then
lTmpSz := lAllocSliceSz; {idea: for multi slice images, limit compression}
if lTmpSz < 1 then begin
Showmessage('Error with GE Genesis compression.');
GetByte := 0;
exit;
end;
FreeMem(TmpBuff);
GetMem( TmpBuff, lTmpSz);
BlockRead(inFp, TmpBuff^, lTmpSz);
lTmpPos := 0;
end;
if lTmpPos > 0 then GetByte := TmpBuff[lTmpPos]
else GetByte := 0;
inc(lTMpPos);
end; //nested function getbyte
//below: procedure DisplayImage begins
begin
lWinWid := lInWinWid;
lWinCen := lInWinCen;
if (lWinWid < 0) and (gUseRecommendedContrast) and (gDICOMData.WindowWidth <> 0) then begin //autocontrast
lWinWid := gDICOMData.WindowWidth;
lWinCen := gDICOMData.WindowCenter;
end;
if lUpdateCon then begin
gFastSlope := 128;
gFastCen := 128;
UpdatePalette(false,0);
if gDICOMdata.Allocbits_per_pixel > 8 then begin
gFastSlope := 512{256}; {CONTRAST change here}
gFastCen := 512{256}; {CONTRAST change here}
end;
end;
lFileName := gFilename;
if (not lUpdateCon) and (gSlice = lSlice) {and (gScheme = lScheme)} and (lWinCen = gWinCen) and (lWinWid = gWinWid) then
exit; {no change: delphi sends two on change commands each time a slider changes: this wastes a lot of display time}
gImgMin :=0;
gImgMax := 0;
if (gDICOMdata.SamplesPerPixel > 1) or (gDICOMdata.RLERedSz > 0) then
gImgMax := 255;
gImgCen := 0;
gImgWid := 0;
gWinMin := gImgMin;
gWinMax := gImgMax;
gWinCen := lWinCen;
gWinWid := lWinWid;
if (not gImgOK) or (gAbort) then exit;
if lSlice < 1 then {exit}lSlice := 1;
g100pctImageWid := gDICOMdata.XYZdim[1];
g100pctImageHt := gDICOMdata.XYZdim[2];
gSlice := lSlice;
lExplicitImageStart := false;
if (gMultiRow = 1) and (gMultiCol = 1) and (gOffsetListSize >= lSlice) and (gDICOMdata.XYZdim[3] < 2) then begin
lFilename := gFilePath + gStringList.Strings[lSlice-1];
lImageStart := gOffsetList[lSlice,kOffset];
lExplicitImageStart := true;
lSlice := 1;
if (lWinWid < 0) and (gUseRecommendedContrast) and (gDICOMData.WindowWidth <> 0) then begin //autocontrast
lWinWid := gOffsetList[lSlice,kWinWid];
lWinCen := gOffsetList[lSlice,kWinCen];
end;
end;
lnMultiRow := gMultiRow;
if lnMultiRow < 1 then lnMultiRow := 1;
lnMultiCol := gMultiCol;
if lnMultiCol < 1 then lnMultiCol := 1;
lnMultiSlice := lnMultiRow*lnMultiCol;
lMultiMultiFile := false;
lMultiMaxSlice := gDicomData.XYZdim[3];
if lnMultiSlice > 1 then begin //compute if single multiframe file or multiple files
if gDicomData.XYZdim[3] > 1 then begin
if (lnMultiSLice > gDicomData.XYZdim[3]) then begin
lnMultiSLice := gDicomData.XYZdim[3];
end;
end else if (gOffsetListSize>1) then begin
if lnMultiSLice > gOffsetListSize then
lnMultiSLice := gOffsetListSize;
if lnMultiSlice > 1 then
lMultiMultiFile := true;
lMultiMaxSlice := gOffsetListSize;
end else
lnMultiSlice := 1;
end;
if lnMultiSlice > 1 then begin
//Self.caption := 'Multislice';
g100pctImageWid := (g100pctImageWid * lnMultiCol)+((lnMultiCol+1)*kBorderSz);
g100pctImageHt := (g100pctImageHt * lnMultiRow) +((lnMultiRow+1)*kBorderSz);
if gDICOMdata.SamplesPerPixel > 1 then
lMultiColSzWOBorders := gDICOMdata.XYZdim[1]* gDICOMdata.SamplesPerPixel
else
lMultiColSzWOBorders := gDICOMdata.XYZdim[1];
if gDICOMdata.SamplesPerPixel > 1 then
lMultiColSz := (gDICOMdata.XYZdim[1]+kBorderSz)* gDICOMdata.SamplesPerPixel
else
lMultiColSz := gDICOMdata.XYZdim[1]+kBorderSz;
lMultiLineSz := (lMultiColSz * lnMultiCol)+kBorderSz;
lMultiFullRowSz := (lMultiLineSz * gDICOMdata.XYZdim[2])+kBorderSz;
lMultiSliceSz := lMultiLineSz * (((gDICOMdata.XYZdim[2]+kBorderSz)*lnMultiRow)+kBorderSz);
If (gDICOMdata.Allocbits_per_pixel > 8) then
getmem(lMultiBuff{lMultiBuff16},lMultiSliceSz*2)
else
getmem(lMultiBuff,lMultiSliceSz);
if gMultiFirst > lMultiMaxSlice then
gMultiFirst := 1;
lSlice := gMultiFirst;
if (gMultiLast > lMultiMaxSlice) or (gMultiLast < gMultiFirst) then
gMultiLast := lMultiMaxSlice;
lMultiSliceInc := (gMultiLast -gMultiFirst) / (lnMultiSlice-1);
if lMultiSliceInc < 1 then lMultiSliceInc := 1;
end else begin
Self.caption := extractfilename(gFilename);
end;
lMultiSlice := 1; //1stSlice
123: //return here for multislice view
lMultiCol := lMultiSlice mod lnMultiCol;
if (lMultiMultiFile) and (gDICOMdata.XYZdim[3] < 2) then begin
lSlice := gMultiFirst + round(lMultiSliceInc*(lMultiSlice-1));
lFilename := gFilePath + gStringList.Strings[lSlice-1];
lImageStart := gOffsetList[lSlice,kOffset];
lSlice := 1;
end;
if lMultiCol = 0 then lMultiCol := lnMultiCol;
lMultiCol := lMultiCol - 1; //index from 0
lMultiRow := (lMultiSlice-1) div lnMultiCol;
lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2] * gDICOMdata.Allocbits_per_pixel+7) div 8 ;
if (lAllocSLiceSz) < 1 then exit;
AssignFile(infp, lFilename);
FileMode := 0; //Read only
Reset(infp, 1);
if not lMultiMultiFile then begin
if not lExplicitImageStart then
lImageStart := gDicomData.ImageStart + ((lSlice-1) * (lAllocSliceSz*gDICOMdata.SamplesPerPixel));
end;
if (not gDicomData.ElscintCompress) and (not gDicomData.GenesisCpt) and (gDicomData.CompressSz=0) and (not gDicomData.RunLengthEncoding)and ((lImageStart + (lAllocSliceSz*gDICOMdata.SamplesPerPixel)) > (FileSize(infp))) then begin
showmessage('This file does not have enough data for the image size:'+lFilename+kCR+'Image start: '+inttostr(lImageStart)+kCR+'Image size: '+inttostr(lAllocSliceSz*gDICOMdata.SamplesPerPixel)
+kCR+'Slice: '+ inttostr(lSlice)
+kCR+'File size: '+inttostr(FileSize(infp)) );
closefile(infp);
FileMode := 2; //read/write
exit;
end;
Seek(infp, lImageStart);
if (gDICOMdata.RLERedOffset <>0) or ( (gDICOMdata.Allocbits_per_pixel = 8) and(gDICOMdata.SamplesPerPixel = 3)) then begin
lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2]); //24bits per pixel: number of voxels in each colour plane
size := lAllocSliceSz-1;
if gBuff24Sz <>(lAllocSliceSz*3) then begin //gDICOMdata.SamplesPerPixel
if gBuff24Sz <> 0 then
Freemem(gBuff24);
gBuff24Sz := lAllocSliceSz*3;
GetMem( gBuff24, lAllocSliceSz*3);
end;
if (gDICOMdata.JPEGLossyCpt) then begin
CloseFile(infp); //we will read this file directly
//decompressJPEG24 (lFilename,gBuff24,lAllocSliceSz,gECATposra[lSlice]);
decompressJPEG24 (lFilename,gBuff24,lAllocSliceSz,gECATposra[lSlice],Image);
exit;
//?? what if gDICOMdata.monochrome = 4 -> is YcBcR photometric interpretation dealt with by the JPEG comrpession or not? I have never seen such an image, so I guess this is an impossible combination
//Reset(infp, 1); //other routines expect this to be left open
end else if (gDICOMdata.JPEGLosslessCpt) then
DecodeJPEG(infp,gBuff16,gBuff24, gBuff24Sz,gECATposra[lSlice],gECATszra[lSlice],false)
else if (gDICOMdata.planarconfig = 0) and (gDICOMdata.RunLengthEncoding = false) then begin
BlockRead(infp, gBuff24^, lAllocSliceSz*gDICOMdata.SamplesPerPixel);
end else if (gDICOMdata.RLERedOffset <>0) then begin
DecompressRLE16toRGB(infp,gBuff24,lAllocSLiceSz,gDICOMdata.CompressOffset,gDICOMdata.CompressSz,gDICOMdata.RLERedOffset,gDICOMdata.RLEGreenOffset,gDICOMdata.RLEBlueOffset,gDICOMdata.RLERedSz ,gDICOMdata.RLEGreenSz,gDICOMdata.RLEBlueSz);
end else if gDICOMdata.CompressSz > 0 then begin
DecompressRLE8(infp, gBuff24,3{gDICOMdata.SamplesPerPixel},lAllocSliceSz,gDICOMdata.CompressOffset,gDICOMdata.CompressSz);
end else begin //not compressed
GetMem( TmpBuff, lAllocSliceSz);
BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
size := lAllocSliceSz-1;
j := 0;
for i := 0 to size do begin
gBuff24[j] := TmpBuff[i];
j := j + 3;
end;
BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
size := lAllocSliceSz-1;
j := 1;
for i := 0 to size do begin
gBuff24[j] := TmpBuff[i];
j := j + 3;
end;
BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
size := lAllocSliceSz-1;
j := 2;
for i := 0 to size do begin
gBuff24[j] := TmpBuff[i];
j := j + 3;
end;
FreeMem( TmpBuff);
end; //no compression, swap planar compression
CloseFile(infp);
FileMode := 2; //read/write
if gDICOMdata.monochrome = 4 then begin //xappa
j:= 0;
for i := 0 to size do begin //convert YcBcR to RGB
lY := gBuff24[j];
lCb := gBuff24[j+1]-128;
lCr := gBuff24[j+2]-128;
lR := round(lY+1.4022*lCr);
lG := lY+round(-0.3456*lCb -0.7145*lCr);
lB := round(lY+1.771 *lCb );
if lR < 0 then lR := 0;
if lR > 255 then lR := 255;
if lG < 0 then lG := 0;
if lG > 255 then lG := 255;
if lB < 0 then lB := 0;
if lB > 255 then lB := 255;
gBuff24[j] := lR;
gBuff24[j+1] := lG;
gBuff24[j+2] := lB; //red
j := j + 3;
end; //for loop
end; //convert YcBcR to RGB
DetermineZoom;
SetDimension(gDIcomData.XYZdim[2],gDIcomData.XYZdim[1] ,24, gBuff24,false);
DICOMImageRefreshAndSize;
Image.Refresh;
exit;
end; //24-bit RGB
case gDICOMdata.Allocbits_per_pixel of
8: begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -