📄 qdcmimage.pas
字号:
lRB := lInBuff[lBotPos+t+1];
end;
z:=xP and $7FFF;
w2:=(z*iz2)shr 15;
w1:=iz2-w2;
w4:=(z*z2)shr 15;
w3:=z2-w4;
lBuff[lPos] :=(lrRA[lLT]*w1+lrRA[lRT]*w2
+lrRA[lLB]*w3+lrRA[lRB]*w4)shr 15;
inc(lPos);
lBuff[lPos] :=(lgRA[lLT]*w1+lgRA[lRT]*w2
+lgRA[lLB]*w3+lgRA[lRB]*w4)shr 15;
inc(lPos);
lBuff[lPos] :=(lbRA[lLT]*w1+lbRA[lRT]*w2
+lbRA[lLB]*w3+lbRA[lRB]*w4)shr 15;
inc(lPos);
Inc(xP,xP2);
inc(x);
end; //inner loop
Inc(yP,yP2);
end;
end else begin //<>24bits,custompal
getmem(lBuff, lPGHt*lPGWid{*3});
for y:=0 to lPGHt-1 do begin
xP:= 0;
lTopPos:=lSrcWid *(yP shr 15); //Line1
if yP shr 16<lSrcHt-1 then
lBotPos:=lSrcWid *(yP shr 15+1) //Line2
else
lBotPos:=lTopPos;//lSrcWid *(yP shr 15);
//pc:=Dst.Scanlines[y];
z2:=yP and $7FFF;
iz2:=$8000-z2;
// for x:=0 to lDstWid-1 do begin
x := 0;
while x < lPGWid do begin
t:=xP shr 15;
if ((lBotPos+t+2) > lInSz) or ((lTopPos+t{-1}) < 0) then begin
lLT := 0;
lRT := 0;
lLB := 0;
lRB := 0;
end else begin
lLT := lInBuff[lTopPos+t{+1}];
lRT := lInBuff[lTopPos+t{+2}+1];
lLB := lInBuff[lBotPos+t{+1}];
lRB := lInBuff[lBotPos+t{+2}+1];
end;
z:=xP and $7FFF;
w2:=(z*iz2)shr 15;
w1:=iz2-w2;
w4:=(z*z2)shr 15;
w3:=z2-w4;
lBuff[lPos] :=(lLT*w1+lRT*w2
+lLB*w3+lRB*w4)shr 15;
inc(lPos);
Inc(xP,xP2);
inc(x);
end; //inner loop
Inc(yP,yP2);
end;
end; //<>24bits,custompal
end;
*)
begin
FreeBackupBitmap;
gLine.Left := -666;
gLineLenMM := 0;
DetermineZoom;
lScale := gZoomPct / 100;
lBits := lInBits;
//lScale := 2;//if lScale = 1 then lScale := 1.01;
if (lScale = 1) or (not gSmooth) then begin
lPGWid := lInPGWid;
lPGHt := lInPGHt;
lBuff := @lInBuff^;
lBufferUsed := false;
end else begin
lBufferUsed := true;
ScaleStretch(lInPGHt,lInPGWid, lScale);
end;
(* if (lScale = 1) or (not gSmooth) then begin
lPGWid := lInPGWid;
lPGHt := lInPGHt;
lBuff := @lInBuff^;
lBufferUsed := false;
end else
lBufferUsed := true;
ScaleStretch(lInPGHt,lInPGWid, lScale);
*)
//lBits := lInBits;
//lPGWid := lInPGWid;
//lPGHt := lInPGHt;
//lBuff := @lInBuff^;
if (lBits > 23) {or (lBits = 25)} then begin
if (gDICOMdata.RLERedSz <> 0) or (gDICOMdata.SamplesPerPixel > 1) or (gCustomPalette > 0) then begin
lWinC := round(gWinCen);
lWinW := round(gWinWid);
if ((lWinC = 127) and (lWinW = 255)) or (lWinW = 0) then
//scaling not required
else begin
if not lBufferUsed then begin
getmem(lBuff, lPGHt*lPGWid*3);
{$ifdef Linux}
move(lInBuff[0],lBuff[0],lPGHt*lPGWid*3);
{$else}
CopyMemory(Pointer(lBuff),Pointer(lInBuff),lPGHt*lPGWid*3);
{$endif}
lBufferUsed := true;
end;
lWinScaleShl16 := 1 shl 16;
lWinScaleShl16 := round (lWinScaleShl16*(256/lWinW));
for lL := 0 to 255 do begin //lookup buffer for scaling
lTemp := lL-lWinC;
lTemp := (lTemp * lWinScaleShl16);
lTemp := lTemp div 65536;
lTemp := 128 + lTemp;
if lTemp < 0 then lTemp := 0
else if lTemp > 255 then lTemp := 255;
lByteRA[lL] := lTemp;
end;
J := (lPGWid * lPGHt * 3) -1;
for lL := 0 to J do begin
lBuff[lL] := lByteRA[lBuff[lL]];
end;
end; //scaling required
//self.caption :=('update(ms): '+inttostr(GetTickCount-lStartTime)); //70 ms
end;
BMP := TBitmap.Create;
lL := 0;
TRY
BMP.PixelFormat := pf32bit; {Kylix = 32bit}
BMP.Width := lPGwid;
BMP.Height := lPGHt;
if lBuff <> nil then begin
if true{lRevScanLine24b} THEN
J := 0
ELSE
J := BMP.Height-1;
REPEAT
lRow := BMP.Scanline[j];
FOR i := 0 TO BMP.Width-1 DO BEGIN
WITH lRow[i] DO BEGIN
rgbtRed := lBuff[lL];
inc(lL);
rgbtGreen := lBuff[lL];
inc(lL);
rgbtBlue := lBuff[lL];
inc(lL);
trgbreserved := 0;
END //with row
END; //for width
IF true{lRevScanLine24b} THEN
Inc(J)
ELSE
Dec(J);
UNTIL (J < 0) or (J >= BMP.Height); //for J
end;
Self.Picture.Graphic := BMP;
//if lBits = 25 then begin
//z Self.Height:= round(lPGHt*lScale);
//z Self.Width := round(lPGWid*lScale){(ZoomBox.ItemIndex+1)};
//end else begin
//abba image.Height:= lPGHt;
//abba image.Width := lPGWid;
//end;
// z Self.Refresh;
FINALLY
BMP.Free;
END;
if lBufferUsed then
freemem(lBuff);
exit;
end; //24bit
if (lUseWinCenWid) and (gWinWid > 0) then begin
lMinPal := round(gWinCen - (gWinWid / 2));
lMaxPal := lMinPal + round(gWinWid);
//showmessage(floattostr(gWinCen)+'x'+floattostr(gWinWid)+'xx'+inttostr(lMinPal)+'abba'+inttostr(lMaxPal));
lSlope := 255 / gWinWid;
if (lMinPal < 0) or (lMinPal > 255) then
lMinPal := 0;
if (lMaxPal < 0) or (lMaxPal > 255) then
lMaxPal := 255;
for I := 0 to lMinPal do begin
lRGB32ra[I] := (gBra[0])+(gGra[0] shl 8)+(gRra[0] shl 16);
end;
for I := lMaxPal to 255 do begin
lRGB32ra[I] := (gBra[255])+(gGra[255] shl 8)+(gRra[255] shl 16);
end;
if (lMinPal+1) < (lMaxPal) then begin
for I := (lMinPal+1) to (lMaxPal-1) do begin
J := 128+round(lSLope*(I-gWinCen));
if J < 0 then J := 0
else if J > 255 then J := 255;
lRGB32ra[I] := (gBra[J])+(gGra[J] shl 8)+(gRra[J] shl 16);
end;
end;
end else begin //use wincen/wid
for lL := 0 to 255 do
lRGB32ra[lL] := (gBra[lL])+(gGra[lL] shl 8)+(gRra[lL] shl 16);
end; //use wincen/wid ddd
BMP := TBitmap.Create;
lL := 0;
TRY
BMP.PixelFormat := pf32bit; {ABBA- DElphi = 24bit}
BMP.Width := lPGwid;
BMP.Height := lPGHt;
if lBuff <> nil then begin
if true{lRevScanLine24b} THEN
J := 0
ELSE
J := BMP.Height-1;
REPEAT
lRow32 := BMP.Scanline[j];
FOR i := 0 TO BMP.Width-1 DO BEGIN
lRow32[i] := lRGB32ra[lBuff[lL]];
inc(lL);
END; //for width
IF true{lRevScanLine24b} THEN
Inc(J)
ELSE
Dec(J);
UNTIL (J < 0) or (J >= BMP.Height); //for J
end;
Self.Picture.Graphic := BMP;
if Self.width <> lPGWid then Self.width := lPGWid;
if Self.Height <> lPGHt then Self.Height := lPGHt;
FINALLY
BMP.Free;
END;
if lBufferUsed then
freemem(lBuff);
end;
(*var
lBuff: ByteP0;
lPGwid,lPGHt,lBits: integer;
procedure ScaleStretch(lSrcHt,lSrcWid: integer; lInXYRatio: single);
var
lKScale: integer;
lrRA,lbRA,lgRA: array [0..255] of byte;
lPos,xP,yP,yP2,xP2,t,z, z2,iz2,w1,w2,w3,w4,lTopPos,lBotPos,
lINSz, lDstWidM,x,y,lLT,lLB,lRT,lRB: integer;
lXRatio,lYRatio: single;
begin
yP:=0;
lXRatio := lInXYRatio;
lYRatio := lInXYRatio;
lInSz := lSrcWid *lSrcHt;
lPGwid := round(lSrcWid*lXRatio);//*lZoom;
lPGHt := round(lSrcHt*lYRatio);//*lZoom;
lkScale := 1;
xP2:=((lSrcWid-1)shl 15)div (lPGWid -1 );
yP2:=((lSrcHt-1)shl 15)div (lPGHt -1);
lPos := 0;
lDstWidM := lPGWid - 1;
if lBIts = 24 then begin
getmem(lBuff, lPGHt*lPGWid*3);
lInSz := lInSz * 3; //24bytesperpixel
for y:=0 to lPGHt-1 do begin
xP:= 0;
lTopPos:=lSrcWid *(yP shr 15) *3; //top row
if yP shr 16<lSrcHt-1 then
lBotPos:=lSrcWid *(yP shr 15+1) *3 //bottom column
else
lBotPos:=lTopPos;
z2:=yP and $7FFF;
iz2:=$8000-z2;
x := 0;
while x < lPGWid do begin
t:=(xP shr 15) * 3;
if ((lBotPos+t+6) > lInSz) or ((lTopPos+t) < 0) then begin
lBuff[lPos] :=0; inc(lPos); //reds
lBuff[lPos] :=0; inc(lPos); //greens
lBuff[lPos] :=0; inc(lPos); //blues
end else begin
z:=xP and $7FFF;
w2:=(z*iz2)shr 15;
w1:=iz2-w2;
w4:=(z*z2)shr 15;
w3:=z2-w4;
lBuff[lPos] :=(lInBuff[lTopPos+t]*w1+lInBuff[lTopPos+t+3]*w2
+lInBuff[lBotPos+t]*w3+lInBuff[lBotPos+t+3]*w4)shr 15;
inc(lPos); //reds
lBuff[lPos] :=(lInBuff[lTopPos+t+1]*w1+lInBuff[lTopPos+t+4]*w2
+lInBuff[lBotPos+t+1]*w3+lInBuff[lBotPos+t+4]*w4)shr 15;
inc(lPos); //greens
lBuff[lPos] :=(lInBuff[lTopPos+t+2]*w1+lInBuff[lTopPos+t+5]*w2
+lInBuff[lBotPos+t+2]*w3+lInBuff[lBotPos+t+5]*w4)shr 15;
inc(lPos); //blues
end;
Inc(xP,xP2);
inc(x);
end; //inner loop
Inc(yP,yP2);
end;
end else if gCustomPalette > 0 then begin //<>24bits,custompal
lBits := 24;
for y := 0 to 255 do begin
lrRA[y] := grRA[y];
lgra[y] := ggRA[y] ;
lbra[y] := gbRA[y];
end;
getmem(lBuff, lPGHt*lPGWid*3);
for y:=0 to lPGHt-1 do begin
xP:= 0;
lTopPos:=lSrcWid *(yP shr 15); //Line1
if yP shr 16<lSrcHt-1 then
lBotPos:=lSrcWid *(yP shr 15+1) //Line2
else
lBotPos:=lTopPos;//lSrcWid *(yP shr 15);
z2:=yP and $7FFF;
iz2:=$8000-z2;
x := 0;
while x < lPGWid do begin
t:=xP shr 15;
if ((lBotPos+t+2) > lInSz) or ((lTopPos+t{-1}) < 0) then begin
lLT := 0;
lRT := 0;
lLB := 0;
lRB := 0;
end else begin
lLT := lInBuff[lTopPos+t];
lRT := lInBuff[lTopPos+t+1];
lLB := lInBuff[lBotPos+t];
lRB := lInBuff[lBotPos+t+1];
end;
z:=xP and $7FFF;
w2:=(z*iz2)shr 15;
w1:=iz2-w2;
w4:=(z*z2)shr 15;
w3:=z2-w4;
lBuff[lPos] :=(lrRA[lLT]*w1+lrRA[lRT]*w2
+lrRA[lLB]*w3+lrRA[lRB]*w4)shr 15;
inc(lPos);
lBuff[lPos] :=(lgRA[lLT]*w1+lgRA[lRT]*w2
+lgRA[lLB]*w3+lgRA[lRB]*w4)shr 15;
inc(lPos);
lBuff[lPos] :=(lbRA[lLT]*w1+lbRA[lRT]*w2
+lbRA[lLB]*w3+lbRA[lRB]*w4)shr 15;
inc(lPos);
Inc(xP,xP2);
inc(x);
end; //inner loop
Inc(yP,yP2);
end;
end else begin //<>24bits,custompal
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -