📄 decompress.pas
字号:
repeat
lCptVal := lCptBuff[lCptPos];
inc(lCptPos);
lShort := shortint(lCptVal);
case lShort{lCptVal} of
-128: ;
0..127 : begin
for i := 0 {0->n+1 bytes} to lShort do begin
if J < lUncompressedSegmentEnd then
lTmpBuff[J] := lCptBuff[lCptPos];
inc(J);
inc(lCptPos);
end;
end;
else begin
lCptVal := (-lShort);
lRunVal := lCptBuff[lCptPos];
inc(lCptPos);
for i := 0 {0->n+1 bytes} to lCptVal do begin
if J < lUncompressedSegmentEnd then
lTmpBuff[J] := lRunVal;
inc(J);
end;
end;
end;
until (lCptPos >= lCompressSz) or (J > lUncompressedSegmentEnd);
end;// for each segment lUncompressedSegmentSize
FreeMem(lCptBuff);
if lSamples = 3 then begin //Samples=3, swizzle RRRGGGBBB to triplets RGBRGBRGB
j:= 0;
lUncompressedSegmentSz0 := lAllocSliceSz-1;
for i := 0 to lUncompressedSegmentSz0 do begin
lOutputBuff[j] := lTmpBuff[i]; //red
lOutputBuff[j+1] := lTmpBuff[i+lAllocSliceSz];
lOutputBuff[j+2] := lTmpBuff[i+lAllocSliceSz+lAllocSliceSz]; //blue
j := j + 3;
end; //for loop
FreeMem( lTmpBuff);
end; //Samples=3, swizzle RRRGGGBBB to triplets RGBRGBRGB
end;
procedure DecompressRLE16(var infp: file; var lOutputBuff: SmallIntP0;lImageVoxels,lCompressOffset,lCompressSz: integer);
//NOTE: output as 15-bit integer: fine for SIGNED and UNSIGNED data, loss fo LeastSignificantBit
var
lHiLoSegmentOffset: array [1..2] of longint;
lShort: ShortInt;
J,i,lCompSz,lCptPos,lCptVal,lRunVal: integer;
lCptBuff: ByteP0;
begin
Seek(infp,lCompressOffset+4);
BlockRead(infp, lHiLoSegmentOffset[1], 4); //1st Offset: LO
BlockRead(infp, lHiLoSegmentOffset[2], 4); //2nd Offset: HI
lCompSz := FileSize(infp) - (lCompressOffset);
if lCompSz >lCompressSz then
lCompSz := lCompressSz;
Seek(infp, lCompressOffset);
GetMem( lCptBuff, lCompSz);
BlockRead(infp, lCptBuff^, lCompSz{, n});
//First Pass: read LO bits
J := 0;
lCptPos := lHiLosegmentOffset[2];
repeat
lCptVal := lCptBuff[lCptPos];
inc(lCptPos);
lShort := shortint(lCptVal);
case lShort of
-128: ;
0..127 : begin
for i := 0 to lShort do begin //0->n+1 bytes
if J < lImageVoxels then
lOutputBuff[J] := lCptBuff[lCptPos];
inc(J);
inc(lCptPos);
end;
end;
else begin
lCptVal := (-lShort);
lRunVal := lCptBuff[lCptPos];
inc(lCptPos);
for i := 0 to lCptVal do begin //0->n+1 bytes
if J < lImageVoxels then
lOutputBuff[J] := lRunVal;
inc(J);
end;
end;
end;
until (lCptPos >= lCompressSz) or (J >= lImageVoxels);
lCompSz := lImageVoxels -1;
for J := 0 to lCompSz do
lOutputBuff[J] := lOutputBuff[J] shr 1; //divide each value by 2: we will generate a 15-bit image instead of 16-bit
//because we want a SIGNED 16-bit int, not an UNSIGNED value
//Second Pass: read HI bits
lCptPos := lHiLosegmentOffset[1];
J := 0;
repeat
lCptVal := lCptBuff[lCptPos];
inc(lCptPos);
lShort := shortint(lCptVal);
case lShort of
-128: ;
0..127 : begin
for i := 0 to lShort do begin
if J < lImageVoxels then
lOutputBuff[J] := (lCptBuff[lCptPos] shl 7)+lOutputBuff[J];
inc(J);
inc(lCptPos);
end;
end;
else begin
lCptVal := (-lShort);
lRunVal := lCptBuff[lCptPos];
inc(lCptPos);
for i := 0 to lCptVal do begin
if J < lImageVoxels then
lOutputBuff[J] :=(lRunVal shl 7)+lOutputBuff[J];
inc(J);
end;
end;
end;
until (lCptPos >= lCompressSz) or (J >= lImageVoxels);
FreeMem(lCptBuff);
end;
procedure DecompressRLE16toRGB(var infp: file; var lOutputBuffRGB: ByteP0;lImageVoxels,lCompressOffset,lCompressSz,lRedLUTOffset,lGreenLUTOffset,lBlueLUTOffset,lRedLUTSz,lGreenLUTSz,lBlueLUTSz: integer);
//This is for paletted run-length-encoded (RLE) 16-bit images see C.7.9.2 of DICOM standard
var
lHiLoSegmentOffset: array [1..2] of longint;
lwordLUTra: array [0..65535] of word; //16-bit LUT value
lrgbLUTra: array [1..3,0..65536] of byte;//24-bit RGB code for each indexed value
lShort: ShortInt;
lCptLUTWordRA,lDecodedRA: WordP0;
lSlope: double;
lSz,lJumpPosAfterIndirect,lnIndirectSegments,lIndex,lStartVal,lRunLen,lEndVal,lOpCode,lSegmentsRead,lColor, J,i,lCptSz,lCptPos,lCptVal,lRunVal: integer;
lCptBuff: ByteP0;
begin
//first: decode red/green/blue lookup tables
//for details of this stage, see C.7.9.2 of DICOM standard
for I := 1 to 3 do
for J := 0 to 65535 do
lrgbLUTra[I,J] := 0;
for lColor := 1 to 3 do begin //Read LUT for each color: red/green/blue
case lColor of //set offsets
1: lCptPos := lRedLUTOffset;
2: lCptPos := lGreenLUTOffset;
else lCptPos := lBlueLUTOffset;
end; //case lColor
case lColor of //set offsets
1: lCptSz := lRedLUTSz;
2: lCptSz := lGreenLUTSz;
else lCptSz := lBlueLUTSz;
end; //case lColor
if odd(lCptSz) then lCptSz := lCptSz -1; //should be impossible: all 16-bit values, all DICOM entries must be even number of bytes
getmem(lCptLUTWordRA,lCptSz);
Seek(infp,lCptPos); //start of LUT
BlockRead(infp, lCptLUTWordRA[0], lCptSz); //1st Offset: start of segment with LO bytes
lCptSz := (lCptSz shr 1) -1; //div 2: 16bit uints, -1: overflow check is incremented from 0
lCptPos := 0; //start with first index
lIndex := 0;
lnIndirectSegments := 0;
lSegmentsRead := 0; //used by indirect segments
repeat //read all LUT
//read a single segment
lSegmentsRead := lSegmentsRead +1;
lOpCode := lCptLUTWordRA[lCptPos];
inc(lCptPos);
case lOpCode of //opcode specifies discrete, linear or indirect segment
0: begin //0=DISCRETE: read n sequential values uncompressed
J:= lCptLUTWordRA[lCptPos]; //number of indexes to read
inc(lCptPos);
for I := 1 to J do begin
lwordLUTra[lIndex] := lCptLUTWordRA[lCptPos]; //number of indexes to read
inc(lCptPos);
inc(lIndex);
end;
end;//Opcode = 0 xxx
1: begin //1=LINEAR: linearly interpolate values
lStartVal := lwordLUTra[lIndex-1];//read previous sample
lRunLen := lCptLUTWordRA[lCptPos]; //number of indexes to read
//showmessage(inttostr(lRunLen));
inc(lCptPos);
lEndVal := lCptLUTWordRA[lCptPos]; //number of indexes to read
inc(lCptPos);
lSlope := (lEndVal - lStartVal) / lRunLen;
for I := 1 to lRunLen do begin
lwordLUTra[lIndex] := lStartVal + round(lSlope*I);
inc(lIndex);
end;
end;//Opcode = 1
2: begin//2=INDIRECT, e.g. jump back for n previous tables
lnIndirectSegments := lCptLUTWordRA[lCptPos]; //number of indexes to read
lJumpPosAfterIndirect := lCptPos + 3;//3=length of this segment
lCptPos := lCptLUTWordRA[lCptPos+1] + (256*lCptLUTWordRA[lCptPos+2]);
lSegmentsRead := 0;
end;//Opcode=2
else begin
showmessage('File corrupted: Invalid segemented palette color opcode: '+inttostr(lOpCode));
freemem(lCptLUTWordRA);
exit;
end;
if (lnIndirectSegments>0) and (lnIndirectSegments=lSegmentsRead) then begin //IndirectSegments completed
lnIndirectSegments := 0;
//showmessage('indy');
lCptPos := lJumpPosAfterIndirect
end; //IndirectSegments completed
end; //Case of OpCode
until (lIndex > 65535) or (lCptPos >= lCptSz);//read LUT
//showmessage(inttostr(lIndex));
//freemem(lCptLUTWordRA);
for J := 0 to 65535 do
lrgbLUTra[lColor,J] := lwordLUTra[J] shr 8; //Convert16bit uint to 8bit int
end; //for color := 1 to 3 RGB
//done reading LUTs
//next, decode index
getmem(lDecodedRA,lImageVoxels * sizeof(word));
Seek(infp,lCompressOffset+4); //ignore 1st 4 bytes: describes number of segments: Assume value is 2
BlockRead(infp, lHiLoSegmentOffset[1], 4); //1st Offset: start of segment with LO bytes
BlockRead(infp, lHiLoSegmentOffset[2], 4); //2nd Offset: start of segment with HI bytes
lCptSz := FileSize(infp) - (lCompressOffset);
if lCptSz >lCompressSz then
lCptSz := lCompressSz;
Seek(infp, lCompressOffset);
GetMem( lCptBuff, lCptSz);
BlockRead(infp, lCptBuff^, lCptSz{, n});
//First Pass: read LO bits
J := 0;
lCptPos := lHiLosegmentOffset[2];
repeat
lCptVal := lCptBuff[lCptPos];
inc(lCptPos);
lShort := shortint(lCptVal);
case lShort of
-128: ;
0..127 : begin
for i := 0 to lShort do begin //0->n+1 bytes
if J < lImageVoxels then
lDecodedRA[J] := lCptBuff[lCptPos];
inc(J);
inc(lCptPos);
end;
end;
else begin
lCptVal := (-lShort);
lRunVal := lCptBuff[lCptPos];
inc(lCptPos);
for i := 0 to lCptVal do begin //0->n+1 bytes
if J < lImageVoxels then
lDecodedRA[J] := lRunVal;
inc(J);
end;
end;
end;
until (lCptPos >= lCompressSz) or (J >= lImageVoxels);
//Second Pass: read HI bits
lCptPos := lHiLosegmentOffset[1];
J := 0;
repeat
lCptVal := lCptBuff[lCptPos];
inc(lCptPos);
lShort := shortint(lCptVal);
case lShort of
-128: ;
0..127 : begin
for i := 0 to lShort do begin
if J < lImageVoxels then begin
lRunVal := lCptBuff[lCptPos];
lRunVal := lRunVal shl 8;
lDecodedRA[J] := lRunVal+lDecodedRA[J];
end;
inc(J);
inc(lCptPos);
end;
end;
else begin
lCptVal := (-lShort);
lRunVal := lCptBuff[lCptPos];
lRunVal := lRunVal shl 8;
inc(lCptPos);
for i := 0 to lCptVal do begin
if J < lImageVoxels then
lDecodedRA[J] :=(lRunVal)+lDecodedRA[J];
inc(J);
end;
end;
end;
until (lCptPos >= lCompressSz) or (J >= lImageVoxels);
FreeMem(lCptBuff);
lSz := lImageVoxels -1; //lDecodedRA indexed from 0
I := 0;
for J := 0 to lSz do begin
lOutputBuffRGB[I] := lrgbLUTra[1,lDecodedRA[J]];
lOutputBuffRGB[I+1] := lrgbLUTra[2,lDecodedRA[J]];
lOutputBuffRGB[I+2] := lrgbLUTra[3,lDecodedRA[J]];
I := I + 3;
end;
FreeMem(lDecodedRA);
end; //DecompressRLE16toRGB
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -