📄 qdcmimage.pas
字号:
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;
var
PixMap: pointer;
Bmp : TBitmap;
hBmp : HBITMAP;
BI : PBitmapInfo;
BIH : TBitmapInfoHeader;
lSlope,lScale: single;
lPixmapInt,lBuffInt: integer ;
ImagoDC : hDC;
lRow: pRGBTripleArray;
lMinPal,lMaxPal,lL,lTemp,lHt,lWid,I,J,lScanLineSz,lScanLineSz8: integer;
begin
FreeBackupBitmap;
gLine.Left := -666;
gLineLenMM := 0;
DetermineZoom;
lScale := gZoomPct / 100;
lBits := lInBits;
if (lScale = 1) or (not gSmooth) then begin
lPGWid := lInPGWid;
lPGHt := lInPGHt;
lBuff := @lInBuff^;
end else begin
ScaleStretch(lInPGHt,lInPGWid, lScale);
end;
(*abba if (lBits = 24) then begin
BMP := TBitmap.Create;
lL := 0;
TRY
BMP.PixelFormat := pf24bit;
BMP.Width := lPGwid;
BMP.Height := lPGHt;
if lBuff <> nil then begin
//if VertFlipItem.checked then
// J := BMP.Height-1
//else
J := 0;
REPEAT
lRow := BMP.Scanline[j];
{if HorFlipItem.checked then begin
FOR i := BMP.Width-1 downto 0 DO BEGIN
WITH lRow[i] DO BEGIN
rgbtRed := lBuff[lL];
inc(lL);
rgbtGreen := lBuff[lL];
inc(lL);
rgbtBlue := lBuff[lL];
inc(lL);
END //with row
END; //for width
end else begin //horflip {}
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);
END //with row
END; //for width
//end; //horflip
//if VertFlipItem.checked then
// Dec(J)
//else
Inc(J)
UNTIL (J < 0) or (J >= BMP.Height); //for J
end;
Image.Picture.Graphic := BMP;
//if lBits = 25 then begin
// image.Height:= lPGHt*(ZoomBox.ItemIndex+1);
// image.Width := lPGWid*(ZoomBox.ItemIndex+1);
//end else begin
image.Height:= lPGHt;
image.Width := lPGWid;
//end;
FINALLY
BMP.Free;
END;
exit;
end; //24bit
BIH.biSize:= Sizeof(BIH);
BIH.biWidth:= lPGwid;//g100pctImageWid{width};
BIH.biHeight := lPGHt{-height};
BIH.biPlanes := 1;
BIH.biBitCount := 8;//lBits;
BIH.biCompression := BI_RGB;
BIH.biSizeImage := 0;
BIH.biXPelsPerMeter := 0;
BIH.biYPelsPerMeter := 0;
BIH.biClrUsed := 0;
BIH.biClrImportant := 0;
{$P+,S-,W-,R-}
BI := AllocMem(SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
BI^.bmiHeader := BIH;
if (gCustomPalette = 0) and (lUseWinCenWid) and (gWinWid > 0) then begin
lMinPal := round(gWinCen - (gWinWid / 2{shr 1}));
lMaxPal := round(lMinPal + gWinWid);
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
BI^.bmiColors[I].rgbRed := gRra[0];
BI^.bmiColors[I].rgbGreen := gGra[0];
BI^.bmiColors[I].rgbBlue := gBra[0];
BI^.bmiColors[I].rgbReserved := 0;
end;
for I := lMaxPal to 255 do begin
BI^.bmiColors[I].rgbRed := gRra[255];
BI^.bmiColors[I].rgbGreen := gGra[255];
BI^.bmiColors[I].rgbBlue := gBra[255];
BI^.bmiColors[I].rgbReserved := 0;
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;
BI^.bmiColors[I].rgbRed := gRra[J];
BI^.bmiColors[I].rgbGreen := gGra[J];
BI^.bmiColors[I].rgbBlue := gBra[J];
BI^.bmiColors[I].rgbReserved := 0;
end;
end;
end else begin //use wincen/wid
for I:=0 to 255 do begin
BI^.bmiColors[I].rgbRed := gRra[i];
BI^.bmiColors[I].rgbGreen := gGra[i];
BI^.bmiColors[I].rgbBlue := gBra[i];
BI^.bmiColors[I].rgbReserved := 0;
end;
end; //use wincen/wid
Bmp := TBitmap.Create;
Bmp.Height := lPGHt{width};
Bmp.Width := lPGwid;
ImagoDC := GetDC(Self.Handle);
hBmp:= CreateDIBSection(imagodc,bi^,DIB_RGB_COLORS,pixmap,0,0);
lScanLineSz := lPGwid;
if(lPGwid mod 4) <> 0 then lScanLineSz8 := 4*((lPGWid + 3)div 4)
else lScanLineSz8 := lPGwid;
lHt := Bmp.Height-1;
lWid := lPGwid -1;
if lBuff <> nil then begin
lPixmapInt := Integer(pixmap);
lBuffInt := Integer(lBuff);
For i:= (lHt) downto 0 do
CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)),
Pointer(lBuffInt+((lHt-i))*lScanLineSz),lScanLineSz);
end; //lBuff full
ReleaseDC(0,ImagoDC);
Bmp.Handle := hBmp;
Bmp.ReleasePalette;
Image.Picture.Assign(Bmp);
Bmp.Free;
FreeMem( BI);
if (lScale <> 1) and (gSmooth) then
freemem(lBuff);
{$P-,S+,W+,R-}
*
end;*)
procedure TDCMimage.OverlayData;
var lMaxSlices,lZOomPct,lMultiSlice,lRowPos,lColPos,lDiv,lFOntSpacing,lSpace,lRow,lSlice,lCol: integer;
lMultiSliceInc : single;
begin
if gDicomData.XYZdim[3] > 1 then
lMaxSlices := gDicomData.XYZdim[3]
else if gFileListSz > 1 then
lMaxSlices := gFileListSz
else
lMaxSlices := 1;
if not gOverlay then exit;
if gSmooth then
lZoomPct := gZoomPct
else
lZoomPct := 100;
if gMultiCol > 0 then
lDiv := gMultiCol
else
lDiv := 1;
case {gDicomData.XYZdim[1]}(Self.Picture.Width div lDiv) of
0..63: lFontSpacing := 8;
64..127: lFontSpacing := 8;//9;
128..255: lFontSpacing := 9;//10;
256..511: lFontSpacing := 10;//12;
512..767: lFontSpacing := 12;//14;
else lFontSpacing := 14;//26;
end;
Self.Canvas.Font.Name := 'MS Sans Serif';
Self.Canvas.Brush.Style := bsClear;
Self.Canvas.Font.Size := lFontSpacing;
if gOverlayColor = 1 then
Self.Canvas.Font.Color := 0//$FFFFFF;//gMaxRGB
else
Self.Canvas.Font.Color := $FFFFFF;
if ((gMultiRow > 1) or (gMultiCol > 1)) and (gMultiROw > 0) and (gMultiCol > 0) then begin
lMultiSliceInc := (gMultiLast -gMultiFirst) / ((gMultiRow * gMultiCol)-1);
if lMultiSliceInc < 1 then
lMultiSliceInc := 1;
lMultiSlice := 0;
for lRow := 0 to (gMultiRow-1) do begin
lRowPos := 6+(lROw * (((gDICOMdata.XYZdim[2]+kBorderSz )* lZoomPct) div 100 ));
for lCol := 0 to (gMultiCOl-1) do begin
lColPos :=6+ (lCol * (((gDICOMdata.XYZdim[1]+kBorderSz )* lZoomPct) div 100 ));
lSlice := gMultiFirst+round (lMultiSliceInc*(lMultiSlice))-1;
//showmessage(inttostr(lColPos)+':'+inttostr(lROwPos));
(*if (gDicomData.XYZdim[3] > 1) then begin
if (lSLice < gDicomData.XYZdim[3]) then begin
if (lRow=0) and (lCol=0) then
Self.Canvas.TextOut(lColPos,lROwPos,inttostr(lSlice+1)+':'+inttostr(gDicomData.XYZdim[3]){+':'+extractfilename(gfilename)})
else
Self.Canvas.TextOut(lColPos,lROwPos,inttostr(lSlice+1)+':'+inttostr(gDicomData.XYZdim[3]))
end
end else if (lSlice < gFileListSz) and (lSlice >= 0) then
Self.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice+1)+':'+inttostr(gFileListSz){+':'+(gStringList.Strings[lSlice])});
*)
Self.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice+1)+':'+inttostr(lMaxSlices));
inc(lMultiSlice);
end;//for lROw
end; //for lCol.
//lSpace := 6+2+lFontSpacing;
end else //not multislice mosaic
Self.Canvas.TextOut(6,6,inttostr(gSlice)+':'+inttostr(lMaxSlices)+' '+gFilename);
lSpace := 6+2+lFontSpacing;
Self.Canvas.TextOut(6,lSpace,'C/W: '+floattostrf(gWinCen,ffFixed,8,0)+'/'+floattostrf(gWinWid,ffFixed,8,0));
lSpace :=lSpace+ 2+lFontSpacing;
Self.Canvas.TextOut(6,lSpace,'Ht*Wid*Thk mm: '+floattostrf(gDicomData.XYZmm[1],ffFixed,8,2)+'*'
+floattostrf(gDicomData.XYZmm[2],ffFixed,8,2)+'*'+floattostrf(gDicomData.XYZmm[3],ffFixed,8,2));
lSpace :=lSpace+ 2+lFontSpacing;
Self.Canvas.TextOut(6,lSpace,'Name: '+gDicomData.PatientName);
lSpace :=lSpace+ 2+lFontSpacing;
Self.Canvas.TextOut(6,lSpace,'ID: '+gDicomData.PatientID);
lSpace :=lSpace+ 2+lFontSpacing;
Self.Canvas.TextOut(6,lSpace,'Date: '+gDicomData.StudyDate);
lSpace :=lSpace+ 2+lFontSpacing;
if (gDICOMdata.TR <> 0) then
Self.Canvas.TextOut(6,lSpace,'TR/TE: '+floattostrf(gDicomData.TR,ffFixed,8,1)+'/'+floattostrf(gDICOMdata.TE,ffFixed,8,1))
else if (gDICOMdata.kV <> 0) then
Self.Canvas.TextOut(6,lSpace,'kV/mA: '+floattostrf(gDicomData.kV,ffFixed,8,1)+'/'+floattostrf(gDICOMdata.mA,ffFixed,8,1));
end;
procedure TDCMimage.LoadFileList;
//loads multiple sequential DICOM files from a directory
var
lSearchRec: TSearchRec;
lName,lFilenameWOPath,lExt : string;
lSz,lDICMcode: integer;
lDICM: boolean;
FP: file;
begin
gFilelistSz := 0;//abz
lFilenameWOPath := extractfilename(gFilename);
lExt := ExtractFileExt(gFileName);
if length(lExt) > 0 then
for lSz := 1 to length(lExt) do
lExt[lSz] := upcase(lExt[lSz]);
if (gDicomData.NamePos > 0) then begin //real DICOM file
if {SysUtils.}FindFirst(gFilePath+'*.*', faAnyFile-faSysFile-faDirectory, lSearchRec) = 0 then begin
repeat
lExt := AnsiUpperCase(extractfileext(lSearchRec.Name));
lName := AnsiUpperCase(lSearchRec.name);
if (lSearchRec.Size > 1024)and (lName <> 'DICOMDIR') then begin
lDICM := false;
if ('.DCM' = lExt) then lDICM := true;
if ('.DCM'<> lExt) then begin
Filemode := 0;
AssignFile(fp, gFilePath+lSearchRec.Name);
Filemode := 0; //read only - might be CD
Reset(fp, 1);
Seek(FP,128);
BlockRead(fp, lDICMcode, 4);
if lDICMcode = 1296255300 then lDICM := true;
CloseFile(fp);
Filemode := 2; //read/write
end; //Ext <> DCM
if lDICM then
gStringList.Add(lSearchRec.Name);{}
end; //FileSize > 512
until ({SysUtils.}FindNext(lSearchRec) <> 0);
Filemode := 2;
end; //some files found
SysUtils.FindClose(lSearchRec);
if gStringlist.Count > 0 then begin
gStringlist.Sort;
for lSz := (gStringList.count-1) downto 0 do begin
if gStringList.Strings[lSz] = lFilenameWOPath then gCurrentPosInFileList := lSz;
end;
end;
gFileListSz := gStringList.count;
end; //NamePos > 0 *)
end; //procedure LoadFileList
Procedure TDCMimage.LoadFiles;
//loads multiple sequential DICOM files from a directory
//note: inefficient bubble sort to compute order
var
lNameStr,lDynStr: string;
lI,lI2,lCount,lX,lY,lBits,lBitsStore,lSamples: integer;
lHdrOK,lImgOK,lSameFormat,lIndexRepeat: boolean;
lDicomData: DICOMdata;
lTempList: TStringList;
lImageStartTempRAz: array [1..kMaxEcat,kOffset..kWinWid] of longint;
lindexRAz: Longintp ;
lPrevSmallest,lNextSmallest,lNextSmallestPos,lindexRAsz: integer;
begin
gStringList.Clear;
LoadFileList;
gOffsetListSize := 0;
if (gFileListSz > 1) and (gFileListSz <= kMaxEcat) then begin
lIndexRASz := gFileListSz;
GetMem( lIndexRAz, gFileListSz*sizeof(longint));
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -