home *** CD-ROM | disk | FTP | other *** search
Wrap
unit Childwin; interface uses SysUtils, Windows, Classes, Graphics, Forms, Controls, ExtCtrls, StdCtrls, Buttons, ComCtrls, Menus, Dialogs,DICOM,Analyze,JPEG,lsJPEG,Clipbrd, ToolWin,uMultislice; const kRadCon = pi/180; kMaxECAT = 512; PixelCountMax = 32768; gMouseDown : boolean = false; gInc: integer = 0; type pRGBTripleArray = ^TRGBTripleArray; TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple; palentries = array[0..255] of TPaletteEntry; palindices = array[0..255] of word; TMDIChild = class(TForm) MainMenu1: TMainMenu; OptionsSettingsMenu: TMenuItem; OptionsImgInfoItem: TMenuItem; N2: TMenuItem; Lowerslice1: TMenuItem; Higherslice1: TMenuItem; SelectZoom1: TMenuItem; ContrastAutobalance1: TMenuItem; ScrollBox1: TScrollBox; Image: TImage; Memo1: TMemo; CopyItem: TMenuItem; EditMenu: TMenuItem; Timer1: TTimer; StudyMenu: TMenuItem; Previous1: TMenuItem; Next1: TMenuItem; Mosaic1: TMenuItem; N1x11: TMenuItem; N2x21: TMenuItem; N3x31: TMenuItem; N4x41: TMenuItem; Other1: TMenuItem; Smooth1: TMenuItem; Overlay1: TMenuItem; None1: TMenuItem; White1: TMenuItem; Black1: TMenuItem; procedure FreeBackupBitmap; //procedure ReleaseDICOMmemory; procedure UpdatePalette (lApply: boolean; lWid0ForSlope:integer); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure FileOpenItemClick(Sender: TObject); procedure FileCloseItemClick(Sender: TObject); procedure FileExitItemClick(Sender: TObject); procedure OptionsImgInfoItemClick(Sender: TObject); procedure FileExportAsBmpItemClick(Sender: TObject); procedure FileOpenpicture1Click(Sender: TObject); procedure Lowerslice1Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure LoadColorScheme(lStr: string; lScheme: integer); procedure DetermineZoom; procedure AutoMaximise; procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SelectZoom1Click(Sender: TObject); procedure ContrastAutobalance1Click(Sender: TObject); procedure FormResize(Sender: TObject); procedure CopyItemClick(Sender: TObject); procedure DICOMImageRefreshAndSize; procedure SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean); procedure Scale16to8bit(lWinCen,lWinWid: integer); function VxlVal(X,Y: integer):integer; procedure Vxl(X,Y: integer); procedure Timer1Timer(Sender: TObject); procedure Previous1Click(Sender: TObject); procedure N1x11Click(Sender: TObject); procedure Smooth1Click(Sender: TObject); procedure None1Click(Sender: TObject); private { Private declarations } FLastDown,gSelectOrigin: TPoint; // gMagRect,gSelectRect: TRect; FFileName,gFilePath : string; gPalRA,gRra,gGra,gBra: array [0..255] of byte; gECATslices: integer; gECATposra,gECATszra: array[1..kMaxECAT] of longint; gDynStr: string; gAbort: boolean; public BackupBitmap: TBitmap; gSelectRect,gMagRect: TRect; gMultiFirst,gMultiLast,gMultiRow,gMultiCol,g100pctImageWid, g100pctImageHt{,gMaxRGB,gMinRGB,gMinHt,gMinWid}: integer; gSmooth,gImgOK,FDICOM: boolean; gBuff16: SmallIntP0; gBuff8,gBuff24: Bytep0; gDicomData: DIcomData; gStringList : TStringList; gVideoSpeed,gBuff24sz,gBuff8sz, gBuff16sz,gCustomPalette: integer; gFileListSz,gCurrentPosInFileList,gWinCen,gWinWid,gSlice,gnSLice,gXStart,gStartSlope,gStartCen,gYStart,gImgMin,gImgMax,gImgCen,gImgWid,gWinMin,gWinMax,gWHite,gBlack,gScheme,gZoomPct,gPro,gScale: integer; gContrastStr: string; gFastSlope,gFastCen : integer; { Public declarations } procedure OverlayData; function LoadData( lFileName : string; lAnalyze,lECAT,l2dImage,lRaw: boolean ) : Boolean; procedure LoadFileList; procedure ReleaseDICOMmemory; procedure DisplayImage(lUpdateCon,lForceDraw: boolean; lSlice,lWinWid,lWincen: integer); //procedure Vxl; procedure HdrShow; procedure RefreshZoom; PROCEDURE ShowMagnifier (CONST X,Y: INTEGER);//requires backup bitmap end; var MDIChild : TMDIChild; // gImgStr: string =''; implementation uses Main; var //gPalUpdated: boolean; gMaxRGB,gMinRGB,gMinHt,gMinWid: integer; gRGBquadRA: array [0..255] of TRGBquad; {$R *.DFM} procedure TMDIChild.OverlayData; var lZOomPct,lMultiSlice,lRowPos,lColPos,lDiv,lFOntSpacing,lSpace,lRow,lSlice,lCol: integer; lMultiSliceInc : single; begin if None1.checked then exit; if gSmooth then lZoomPct := gZoomPct else lZoomPct := 100; if gMultiCol > 0 then lDiv := gMultiCol else lDiv := 1; case {gDicomData.XYZdim[1]}(image.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; Image.Canvas.Font.Name := 'MS Sans Serif'; Image.Canvas.Brush.Style := bsClear; Image.Canvas.Font.Size := lFontSpacing; if White1.Checked then Image.Canvas.Font.Color := gMaxRGB else Image.Canvas.Font.Color := gMinRGB; 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] )* lZoomPct) div 100 )); for lCol := 0 to (gMultiCOl-1) do begin lColPos :=6+ (lCol * (((gDICOMdata.XYZdim[1] )* 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 Image.Canvas.TextOut(lColPos,lROwPos,inttostr(lSlice+1)+':'+extractfilename(ffilename)) else Image.Canvas.TextOut(lColPos,lROwPos,inttostr(lSlice+1)) end end else if (lSlice < gFileListSz) and (lSlice >= 0) then Image.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice+1)+':'+(gStringList.Strings[lSlice])); // Image.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice)); inc(lMultiSlice); end;//for lROw end; //for lCol. end else //not multislice mosaic Image.Canvas.TextOut(6,6,extractfilename(FFilename)); lSpace := 6+2+lFontSpacing; //Image.Canvas.TextOut(6,lSpace,'Name: '+gDicomData.PatientName); //lSpace :=lSpace+ 2+lFontSpacing; //if DetailedItem.checked then begin //Image.Canvas.TextOut(6,lSpace,'ID: '+gDicomData.PatientID); //lSpace :=lSpace+ 2+lFontSpacing; //Image.Canvas.TextOut(6,lSpace,'Date: '+gDicomData.StudyDate); //lSpace :=lSpace+ 2+lFontSpacing; Image.Canvas.TextOut(6,lSpace,'C: '+inttostr(gWinCen)); lSpace :=lSpace+ 2+lFontSpacing; Image.Canvas.TextOut(6,lSpace,'W: '+inttostr(gWinWid)); //end; end; procedure TMDIChild.RefreshZoom; begin LockWindowUpdate(Self.Handle); if gBuff24sz > 0 then SetDimension(g100pctImageHt,g100pctImageWid,24,gBuff24,false) else if gBuff16sz > 0 then Scale16to8bit(TMDIChild(MainForm.ActiveMDIChild).gWinCen,TMDIChild(MainForm.ActiveMDIChild).gWinWid) else if (gBuff8sz > 0) {and (gCustomPalette = 0)} then begin //showmessage('abba'+inttostr(gWinWid)); SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true); //showmessage('abba'+inttostr(gWinWid)); XXX end else begin //if Image.Picture.Bitmap.PixelFormat = pf24bit then //if gCustomPalette <> 0 then // MainForm.StatusBar.Panels[4].text := inttostr(gCustomPalette)+':'+inttostr(random(8888))+'%'; MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct)+'%'; image.Height:= round((image.Picture.Height * gZoomPct) div 100); image.Width := round((image.Picture.Width* gZoomPct) div 100) ; IMage.refresh; LockWindowUpdate(0); exit; end; MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct)+'%'; DICOMImageRefreshAndSize; LockWindowUpdate(0); //inc(gInc); //MainForm.StatusBar.Panels[0].text := inttostr(gInc)+'abba'; end; procedure TMDIChild.DICOMImageRefreshAndSize; begin if gSmooth then begin image.Height:= image.Picture.Height; image.Width := image.Picture.Width ; end else begin image.Height:= round((image.Picture.Height * gZoomPct) div 100); image.Width := round((image.Picture.Width* gZoomPct) div 100) ; end; OverlayData; IMage.refresh; end; procedure TMDIChild.ReleaseDICOMmemory; begin {if (BackupBitmap <> nil) and (self.active) then begin//magnifier on MainForm.StatusBar.Panels[1].text := inttostr(gCustomPalette)+':'+inttostr(random(8888))+'release'; BackupBitmap.Free; BackupBitmap := nil end;} FreeBackupBitmap; if (gBuff24sz > 0) then begin freemem(gBuff24); gBuff24sz := 0; end; if (gBuff16sz > 0) then begin freemem(gBuff16); gBuff16sz := 0; end; if (gBuff8sz > 0) then begin freemem(gBuff8); gBuff8sz := 0; end; if red_table_size > 0 then begin freemem(red_table); red_table_size := 0; end; if green_table_size > 0 then begin freemem(green_table); green_table_size := 0; end; if blue_table_size > 0 then begin freemem(blue_table); blue_table_size := 0; end; gCustomPalette := 0; gECATslices:= 0; end; procedure TMDIChild.LoadFileList; var lSearchRec: TSearchRec; lName,lFilenameWOPath,lExt : string; lSz,lDICMcode: integer; lDICM: boolean; FP: file; begin lFilenameWOPath := extractfilename(FFilename); lExt := ExtractFileExt(FFileName); 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, 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); gStringlist.Sort; if gStringlist.Count > 0 then begin for lSz := (gStringList.count-1) downto 0 do begin //showmessage(gStringList.Strings[lSz]); if gStringList.Strings[lSz] = lFilenameWOPath then gCurrentPosInFileList := lSz; end; end; gFileListSz := gStringList.count; //showmessage(inttostr(gCurrentPosInFileList )); //lStringList.Free; end; //NamePos > 0 *) if (gStringlist.Count > 1) then begin StudyMenu.enabled := true; //Next1.enabled := true; //Previous1.enabled := true; //VideospeedMenu.enabled := true; end; end; procedure TMDIChild.FreeBackupBitmap; begin if BackupBItmap <> nil then begin Backupbitmap.free; Backupbitmap := nil; end; gMagRect := Rect(0,0,0,0); end; procedure TMDIChild.Scale16to8bit(lWinCen,lWinWid: integer); var value,i,lScaleShl10,lSz,min16,max16 :integer; lBuffx: ByteP0; begin if gBuff16 = nil then exit; gWinCen := lWinCen; gWinWid := lWinWid; if Self.Active then begin//qwer gContrastStr := 'Window Center/Width: '+inttostr(lWinCen)+'/'+inttostr(lWinWid){+':'+inttostr(round(lSlopeReal))}; MainForm.StatusBar.Panels[4].text := gContrastStr; end; //if lWinWid{Edit.value} <> 0 then begin min16 := lWinCen{Edit.value} - (abs(trunc(lWinWid{Edit.value}/2))); max16 := lWinCen{Edit.value} + (abs(trunc(lWinWid{Edit.value}/2))); //end; gWinMin := min16; gWinMax := max16; lSz:= (g100pctImageWid*g100pctImageHt); GetMem( lbuffx,lSz {width * height}); lSz := lSz -1; value := (max16-min16); //value = range if (value = 0) or (trunc((1024/value) * 255) = 0) then begin if lWinWid > 1024 then begin for i := 0 to lSz do lbuffx[i] := 128; end else begin for i := 0 to lSz do if gBuff16[i] < lWinCen then lbuffx[i] := 0 else lbuffx[i] := 255; end; end else begin if value = 0 then value := 1; lScaleShl10 := trunc((1024/value) * 255); //value = range,Scale = 255/range for i := 0 to lSz do begin if gBuff16[i] < min16 then lbuffx[i] := 0 else if gBuff16[i] > max16 then lbuffx[i] := 255 else lbuffx[i] := (((gBuff16[i])-min16) * lScaleShl10) shr 10; //NOTE: integer maths increases speed x7! // lbuff[i] := (Trunc(255*((gBuff16[i])-min16) / (value))); end; end; SetDimension(g100pctImageHt,g100pctImageWid,8,lBuffx,false); DICOMImageRefreshAndSize; FreeMem( lbuffx ); //if gZoomTag = 0 then // automaximise; end; function TMDIChild.VxlVal (X,Y: integer): integer; var lVxl: integer; begin RESULT := 0; lVxl := (Y* g100PctImageHt) +X; if (gBuff16Sz > 0) and (lVxl >= 0) and (lVxl < gBuff16Sz) then result := gbuff16[lVxl] else if (gBuff8sz > 0) and (lVxl >= 0) and (lVxl < gBuff8Sz) then result := gbuff8[lVxl]; end; procedure TMDIChild.Vxl (X,Y: integer); begin if (gBuff8sz > 0) or (gBuff16sz > 0) then MainForm.StatusBar.Panels[0].text := inttostr(VxlVal(X,Y)){} else MainForm.StatusBar.Panels[0].text := '' end; procedure TMDIChild.SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean); var lBuff: ByteP0; lPGwid,lPGHt,lBits: integer; procedure ScaleStretch(lSrcHt,lSrcWid: integer; lInXYRatio: single); var lKScale: byte; lrRA,lbRA,lgRA: array [0..255] of byte; //lBuff: ByteP0; lPos,xP,yP,yP2,xP2,t,z, z2,iz2,w1,w2,w3,w4,lTopPos,lBotPos, lINSz, lDstWidM,{lDstWid,lDstHt,}x,y,lLT,lLB,lRT,lRB: integer; lXRatio,lYRatio: single; begin yP:=0; lXRatio := lInXYRatio; lYRatio := lInXYRatio; lInSz := lSrcWid *lSrcHt; lPGwid := {round}round(lSrcWid*lXRatio);//*lZoom; lPGHt := {round}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 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; 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; if (lBits = 24) {or (lBits = 25)} 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; (*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;*) if (lUseWinCenWid) and (gWinWid > 0) then begin //if lMin < 0 then lMin := 0 //lMin > 255 then lMin := 255; //if lMax < 0 then lMax := 0 //else if lMax > 255 then lMax := 255; lMinPal := gWinCen - (gWinWid shr 1); lMaxPal := 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 (hBmp = 0) or (pixmap = nil) then if GetLastError = 0 then ShowMessage('Error!') else RaiseLastWin32Error;} if lBuff <> nil then begin {if HorFlipItem.checked then begin For i:= (lHt) downto 0 do begin lPixMapInt := i * lScanLineSz; for j := (lWid shr 1) downto 0 do begin lTemp :=lBuff[lPixMapInt+j]; lBuff[lPixMapInt+j] := lBuff[lPixMapInt+(lWid-j)]; lBuff[lPixMapInt+(lWid-j)] := lTemp; end; end; //i 0..lHt end; //horflip{} lPixmapInt := Integer(pixmap); lBuffInt := Integer(lBuff); {if VertFlipItem.checked then begin For i:= (lHt) downto 0 do CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)), Pointer(lBuffInt+((i))*lScanLineSz),lScanLineSz); end else begin} For i:= (lHt) downto 0 do CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)), Pointer(lBuffInt+((lHt-i))*lScanLineSz),lScanLineSz); {end; {} 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); // Image.Refresh; {$P-,S+,W+,R-} end; PROCEDURE TMDIChild.ShowMagnifier (CONST X,Y: INTEGER); VAR AreaRadius : INTEGER; Magnification : INTEGER; //ModifiedBitmap: TBitmap; xActual,yActual{,lMagArea} : INTEGER; BEGIN if BackupBitmap = nil then exit; xActual := round((X *image.Picture.Height)/image.Height); yActual := round((Y *image.Picture.Width)/image.Width); if (xActual < 0) or (yActual < 0) or (xActual > Image.Picture.width) or (yActual > Image.Picture.height) then exit; {if gZoomPct <> 0 then AreaRadius := (50 * 100) div gZoomPct//ROUND(SpinEditMagnifierRadius.Value / Magnification); else AreaRadius := 50; } if (not gSmooth) and (gZoomPct <> 0) then AreaRadius := (50 * 100) div gZoomPct // AreaRadius := (50 * gZoomPct) div 100//ROUND(SpinEditMagnifierRadius.Value / Magnification); else AreaRadius := 50; Magnification := {round((30*2) / (100))}AreaRadius*2;//round(( (( gZoomPct div 50)+1) * 100) /gZoomPct * AreaRadius); if (gMagRect.Left <> gMagRect.Right) then begin Image.Picture.Bitmap.Canvas.CopyRect(gMagRect, BackupBitmap.Canvas, // [anme] gMagRect); end; gMagRect := Rect(xActual - Magnification, yActual - Magnification, xActual + Magnification, yActual + Magnification); //MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct); Image.Picture.Bitmap.Canvas.CopyRect(gMagRect{Rect(xActual - Magnification, yActual - Magnification, xActual + Magnification, yActual + Magnification)}, BackupBitmap.Canvas, // [anme] Rect(xActual - AreaRadius, yActual - AreaRadius, xActual + AreaRadius, yActual + AreaRadius) ); //Image.invalidate; Image.refresh; END; {ShowMagnifier}(**) procedure FireLUT (lIntensity, lTotal: integer; var lR,lG,lB: integer); var l255scale: integer; begin l255Scale := round ( lIntensity/lTotal * 255); lR := (l255Scale - 52) * 3; if lR < 0 then lR := 0 else if lR > 255 then lR := 255; lG := (l255Scale - {96}108) * 2{2}; if lG < 0 then lG := 0 else if lG > 255 then lG := 255; case l255Scale of 0..55: lB := (l255Scale * 4); 56..118: lB := 220-((l255Scale-55)*3); 119..235: lB := 0; else lB := {255-}((l255Scale-235)*10); end; {case} if lB < 0 then lB := 0 else if lB > 255 then lB := 255; end; procedure TMDIChild.LoadColorScheme(lStr: string; lScheme: integer); const UNIXeoln = chr(10); var lF: textfile; lBuff: bytep0; lFdata: file; lCh: char; lNumStr: String; lRi,lGi,lBi,lZ: integer; lByte,lIndex,lRed,lBlue,lGreen: byte; lType,lIndx,lLong,lR,lG,lB: boolean; procedure ResetBools; begin lType := false; lIndx := false; lR := false; lG := false; lB := false; lNumStr := ''; end; begin gScheme := lScheme; if lScheme < 3 then begin case lScheme of 0: for lZ:=0 to 255 do begin gRra[lZ] := 255-lZ; gGra[lZ] := 255-lZ; gBra[lZ] := 255-lZ; end; 2: for lZ:=0 to 255 do begin FireLUT (lZ,255,lRi,lGi,lBi); gRra[lZ] := lRi; gGra[lZ] := lGi; gBra[lZ] := lBi ; end; else for lZ:=0 to 255 do begin gRra[lZ] := lZ; gGra[lZ] := lZ; gBra[lZ] := lZ; end; end; //case {for lZ := 0 to 255 do begin gRra[lZ] := lZ; gGra[lZ] := lZ; gBra[lZ] := lZ; end;} gMaxRGB := (gRra[255] + (gGra[255] shl 8)+(gBra[255] shl 16)); gMinRGB := (gRra[0] + (gGra[0] shl 8)+(gBra[0] shl 16)); exit; end; lIndex := 0; lRed := 0; lGreen := 0; if gCustomPalette > 0 then exit; if not fileexists(lStr) then exit; assignfile(lFdata,lStr); reset(lFdata,1); lZ := FileSize(lFData); if (lZ =768) or (lZ = 800) or (lZ = 970) then begin GetMem( lBuff, 768); Seek(lFData,lZ-768); BlockRead(lFdata, lBuff^, 768); closeFile(lFdata); for lZ := 0 to 255 do begin //lZ := (lIndex); gRra[lZ] := lBuff[lZ]; gGra[lZ] := lBuff[lZ+256]; gBra[lZ] := lBuff[lZ+512]; end; freemem(lBuff); gMaxRGB := (gRra[255] + (gGra[255] shl 8)+(gBra[255] shl 16)); gMinRGB := (gRra[0] + (gGra[0] shl 8)+(gBra[0] shl 16)); exit; end; closefile(lFdata); lLong := false; assignfile(lF,lStr); reset(lF); ResetBools; for lByte := 0 to 255 do begin gRra[lByte] := 0; gGra[lByte] := 0; gBra[lByte] := 0; end; while not EOF(lF) do begin read(lF,lCh); if lCh = '*' then //comment character while (not EOF(lF)) and (lCh <> kCR) and (lCh <> UNIXeoln) do read(lF,lCh); if (lCh = 'L') or (lCh = 'l') then begin lType := true; lLong := true; end; //'l' if (lCh = 's') or (lCh = 'S') then begin lType := true; lLong := false; end; //'s' if lCh in ['0'..'9'] then lNumStr := lNumStr + lCh else if length(lNumStr) > 0 then begin //not a number = space??? try to read number string if not lIndx then begin lIndex := strtoint(lNumStr); lIndx := true; end else begin //not index if lLong then lByte := trunc(strtoint(lNumStr) / 256) else lByte := strtoint(lNumStr); if not lR then begin lRed := lByte; lR := true; end else if not lG then begin lGreen := lByte; lG := true; end else if not lB then begin lBlue := lByte; lB := true; gRra[lIndex] := lRed; gGra[lIndex] := lGreen; gBra[lIndex] := lBlue; //if lIndex = 236 then showmessage(inttostr(lBlue)); ResetBools; end; end; lNumStr := ''; end; end; //not eof gMaxRGB := (gRra[255] + (gGra[255] shl 8)+(gBra[255] shl 16)); gMinRGB := (gRra[0] + (gGra[0] shl 8)+(gBra[0] shl 16)); closefile(lF); (*export as medcon .pal file-> AssignFile(lF, 'C:\'+extractfilename(lStr)); Rewrite(lF); for lIndex := 0 to 255 do begin Write(lF, '0x'+IntToHex(gRra[lIndex],2)+' 0x'+IntToHex(gGra[lIndex],2)+' 0x' +IntToHex(gBra[lIndex],2)+chr(10)); end; CloseFile(lF); (* //export as imagej .lut file-> AssignFile(lFData, 'C:\'+extractfilename(lStr)); Rewrite(lFData,1); GetMem( lBuff, 768); for lIndex := 0 to 255 do begin lBuff[lIndex] := gRra[lIndex]; lBuff[lIndex+256] := gGra[lIndex]; lBuff[lIndex+512] := gBra[lIndex]; end; BlockWrite(lFdata, lBuff^, 768); freemem(lBuff); CloseFile(lFData); (**) end; procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction); begin gDynStr:= ''; gSelectRect := rect(0,0,0,0); gSelectOrigin.X := -1; Action := caFree; MainForm.ColUpdate; if (BackupBitmap <> nil) then //magnifier on BackupBitmap.Free; BackupBitmap := nil; if (gBuff16sz > 0) then begin freemem(gBuff16); gBuff16sz := 0; end; if (gBuff8sz > 0) then begin freemem(gBuff8); gBuff8sz := 0; end; MainForm.UpdateMenuItems(nil); //MainForm.UpdateMenus(MDIChildCount{-1}); end; (*========================================================================*) procedure TMDIChild.FormCreate(Sender: TObject); var lInc: integer; begin //gCine := false; gSmooth := false; Smooth1.Checked := gSmooth; gMultiRow := 1; gMultiCol := 1; BackupBitmap := nil; gScheme := 1; gWinCen := 0; gWinWid := 0; gStringList := TStringList.Create; gFileListSz := 0; gCurrentPosInFileList := -1; gBuff16sz := 0; gVideoSpeed := 0; gBuff8sz := 0; FFileName := ''; gContrastStr := ''; gDICOMdata.Allocbits_per_pixel := 0; gCustomPalette := 0; gMinHt := 10; gMinWid := 10; gDICOMData.XYZdim[1] := 0; gDICOMData.XYZdim[2] := 0; g100PctImageWid := 0; g100PctImageHt := 0; gZoomPct := 100; for lInc := 0 to 255 do gRGBquadRA[lInc].rgbReserved := 0; {if (MainForm.MDIChildCount > 1) then if (TMDIChild(MainForm.ActiveMDIChild).WindowState = wsMaximized) then Self.Top := 64; } //Self.windowstate := wsMaximized; end; procedure TMDIChild.DetermineZoom; var lHZoom: single; lZoom,lZoomPct: integer; begin if (not MainForm.BestFitItem.checked) then exit; lHZoom := (ClientWidth)/g100pctImageWid; if ((ClientHeight)/g100pctImageHt) < lHZoom then lHZoom := ((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 TMDIChild.AutoMaximise; var lZoom: integer; begin if (not MainForm.BestFitItem.checked) or (g100pctImageHt < 1) or (g100pctImageWid < 1) then exit; lZoom := gZoomPct; DetermineZoom; if lZoom <> gZoomPct then begin RefreshZoom; MainForm.ZoomSlider.Position := lZoom; end; //MainForm.ZoomSliderChange(nil); end; function TMDIChild.LoadData(lFileName : string; lAnalyze,lECAT,l2dImage,lRaw: boolean ) : Boolean; var lHdrOK: boolean; lS: integer; lExt : string; JPG{,JPEGOriginal}: TJPEGImage; Stream: TmemoryStream; BMP: TBitmap; //lStartTime, lEndTime: DWord; begin ReleaseDICOMmemory; gFilePath := extractfilepath(lFileName); gScheme := 1; gSlice := 1; LoadColorScheme('',gScheme); //load Black and white Result := TRUE; gImgOK := false; FFileName := lFileName; gAbort:= true; if not fileexists(lFilename) then begin result := false; showmessage('Unable to find the file: '+lFilename); exit; end; Self.caption := extractfilename(lFilename); if l2DImage then begin FDICOM := false; lExt := ExtractFileExt(FFileName); if length(lExt) > 0 then for lS := 1 to length(lExt) do lExt[lS] := upcase(lExt[lS]); if ('.JPG'= lExt) then begin {JPEGOriginal := TJPEGImage.Create; TRY JPEGOriginal.LoadFromFile(FFilename); Image.Picture.Graphic := JPEGOriginal FINALLY JPEGOriginal.Free END;} //the following longer method makes sure the user can save the JPEG file... Stream := TMemoryStream.Create; try Stream := TMemoryStream.Create; Stream.LoadFromFile(FFilename); Stream.Seek(0, soFromBeginning); Jpg := TJPEGImage.Create; try Jpg.LoadFromStream(Stream); BMP := TBitmap.create; try BMP.Height := JPG.Height; BMP.Width := JPG.Width; BMP.PixelFormat := pf24bit; BMP.Canvas.Draw(0,0, JPG); Image.Picture.Graphic := BMP; finally BMP.Free; end; finally JPG.Free; end; finally Stream.Free; end; end else Image.Picture.Bitmap.LoadFromFile(FFilename); gDICOMData.XYZdim[1] := Image.Picture.Width; gDICOMData.XYZdim[2] := Image.Picture.Height; g100PctImageWid := gDICOMData.XYZdim[1]; g100PctImageHt := gDICOMData.XYZdim[2]; //if MainForm.WindowMaximizeItem.checked then begin //Self.WindowState:=wsMaximized; //automaximise; //end;//else begin} Image.Width := Image.Picture.Width; Image.Height := Image.Picture.Height; //end; //MainForm.StatusBar.Panels[0].text := inttostr(gDICOMData.XYZdim[1])+'x'+inttostr(gDICOMData.XYZdim[2]); gDICOMData.XYZdim[3] := 1; {if MainForm.WindowMaximizeItem.checked then begin Self.WindowState:=wsMaximized; end else begin} if self.WindowState <> wsMaximized then begin self.ClientHeight:=gDICOMdata.XYZdim[2]; self.ClientWidth:= (gDICOMData.XYZdim[1]); end; MainForm.ColUpdate; //OptionsSettingsMenu.enabled := false; ContrastAutobalance1.enabled := false; OptionsImgInfoItem.enabled := false; gImgOK := true; automaximise; //asdf Image.Refresh; exit; end; FDICOM := true; if lRaw then begin lHdrOK := true; gImgOK := true; end else if lAnalyze then OpenAnalyze (lHdrOK,gImgOK,gDynStr,FFileName, gDicomData) else if lECAT then read_ecat_data(gDICOMdata,true{verbose},true{offset tables supported},lHdrOK,gImgOK,gDynStr,FFileName) else read_dicom_data(true,true,true,true,true,true,true, gDICOMdata, lHdrOK, gImgOK, gDynStr,FFileName ); HdrShow; if gECATJPEG_table_entries > 0 then begin if (gECATJPEG_table_entries > kMaxECAT) then begin gImgOK := false; Showmessage('This ECAT file has too many slices ('+inttostr(gECATJPEG_table_entries)+').'); end else begin gECATslices:= gECATJPEG_table_entries; for lS := 1 to gECATslices do begin gECATposra[lS]:=gECATJPEG_pos_table[lS]; gECATszra[lS]:=gECATJPEG_size_table[lS]; end; end; freemem(gECATJPEG_pos_table); freemem(gECATJPEG_size_table); gECATJPEG_table_entries := 0; end; gBlack := 1; gScale := 1; gPro := 0; //if gCurrentPosInFileList < 0 then begin gCustomPalette := 0; if red_table_size > 0 then begin //gCustomPalette := 0; end else begin if gDICOMdata.monochrome = 1 then gScheme := 0 else gScheme := 1; LoadColorScheme('',gScheme); //load Black and white end; gWinCen := 0; gWinWid := 0; //end; //showmessage('abba'+inttostr(red_table_size)); if (gDICOMdata.XYZdim[2] < 1) or (gDICOMdata.XYZdim[1] < 1) or (not lHdrOK) or (not gImgOK) then begin showmessage('Error reading image.'); ReleaseDICOMmemory; OptionsImgInfoItemClick(nil); exit; end; //if gDicomdata.XYZdim[3] > 1 then begin LowerSlice1.enabled := gDicomdata.XYZdim[3] > 1; HigherSlice1.enabled := gDicomdata.XYZdim[3] > 1; Mosaic1.enabled := gDicomdata.XYZdim[3] > 1; //end; {if MainForm.WindowMaximizeItem.checked then begin Self.WindowState:=wsMaximized; automaximise; end else begin} if self.WindowState <> wsMaximized then begin self.ClientHeight:=gDICOMdata.XYZdim[2]; self.ClientWidth:= (gDICOMData.XYZdim[1]); end; //end; //MainForm.PGSaveDialog1.initialdir := extractfilepath(FFilename); gAbort := false; Overlay1.enabled := true; gSlice := 0; {force a new image to be displayed - so gSlice should be different from displayimage requested slice} //lStartTime := GetTickCount; //showmessage('abba'+inttostr(red_table_size)); // Showmessage('MRIcro can not convert run-length compressed DICOM images. You can view this image with ezDICOM.'+inttostr(gDicomData.CompressOffset)); DisplayImage(True,True,1,-1,0); //showmessage('abba'+inttostr(gDicomdata.xxx)); //lEndTime := GetTickCount; //showmessage('display time(ms): '+inttostr(lEndTime-lStartTime)); Screen.Cursor := crDefault; end; (*========================================================================*) procedure TMDIChild.FileOpenItemClick(Sender: TObject); begin MainForm.FileOpenItemClick(Sender); end; (*========================================================================*) procedure TMDIChild.FileExportAsBmpItemClick(Sender: TObject); begin end; (*========================================================================*) procedure TMDIChild.FileCloseItemClick(Sender: TObject); begin end; (*========================================================================*) procedure TMDIChild.FileExitItemClick(Sender: TObject); begin MainForm.FileExitItemClick(Sender); end; procedure TMDIChild.HdrShow; var lLen,lI : integer; lStr: string; begin if not FDICOM then begin //showmessage('Unable to show DICOM header information. This is not a DICOM file.'); EXIT; end; //Memo1.visible := not Memo1.visible; //ClipCopy.enabled := Memo1.visible; Memo1.Lines.Clear; //if not Memo1.visible then begin // exit; //end; lLen := Length (gDynStr); if lLen > 0 then begin lStr := ''; for lI := 1 to lLen do begin if gDynStr[lI] <> kCR then lStr := lStr + gDynStr[lI] else begin Memo1.Lines.add(lStr); lStr := ''; end; end; Memo1.Lines.Add(lStr); end; end; procedure TMDIChild.OptionsImgInfoItemClick(Sender: TObject); begin MainForm.HdrBtn.Down := not MainForm.HdrBtn.Down; MainForm.HdrBtn.Click; end; procedure TMDIChild.DisplayImage(lUpdateCon,lForceDraw: boolean;lSlice,lWinWid,lWinCen: integer); label 123,444; var 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,lnMultiRow,lMultiSlice,lnMultiCol,lnMultiSlice: integer; //lMultiBuff16:SmallIntP0; lSmall: word;//smallint; l16Signed,l16Signed2 : smallint; lFileName: string; infp: file; max16 : LongInt; min16 : LongInt; lShort: ShortInt; lCptVal,lRunVal,lByte2,lByte: byte; lLineLen,{lScaleShl10,}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; var s : SmallInt; begin seek(infp,lPos); BlockRead(infp, s, 2{, n}); swap16i:=swap(s); end; function GetByte: byte; 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; // if lTmpPos > lMaxo then lMaxo := lTmpPos; inc(lTMpPos); end; begin 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; //MainForm.StatusBar.Panels[1].text := inttostr(8888)+'abba'; lFileName := FFilename; Size := 0; //dsa gPalUpdated := false; //MainForm.Caption := inttostr(random(8888))+'abba'; 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; gImgCen := 0; gImgWid := 0; gWinMin := gImgMin; gWinMax := gImgMax; gWinCen := lWinCen; gWinWid := lWinWid; //dsa gPalUpdated := false; if (not gImgOK) or (gAbort) then exit; if lSlice < 1 then {exit}lSlice := 1; g100pctImageWid := gDICOMdata.XYZdim[1]; g100pctImageHt := gDICOMdata.XYZdim[2]; gSlice := lSlice; 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]; gMultiFirst := 1; gMultiLast := lnMultiSlice; 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; g100pctImageHt := g100pctImageHt * lnMultiRow; if gDICOMdata.SamplesPerPixel > 1 then lMultiColSz := gDICOMdata.XYZdim[1]* gDICOMdata.SamplesPerPixel else lMultiColSz := gDICOMdata.XYZdim[1]; //if gDICOMdata.Allocbits_per_pixel > 8 then // lMultiColSz := lMultiColSz * 2; //save as 16bit buffer lMultiLineSz := lMultiColSz * lnMultiCol; lMultiFullRowSz := lMultiLineSz * gDICOMdata.XYZdim[2]; lMultiSliceSz := lMultiLineSz * gDICOMdata.XYZdim[2]*lnMultiRow; //showmessage('capture : '+inttostr(lMultiSliceSz)); If (gDICOMdata.Allocbits_per_pixel > 8) then getmem(lMultiBuff{lMultiBuff16},lMultiSliceSz*2) else getmem(lMultiBuff,lMultiSliceSz); //fillchar(lMultiBuff,lMultiSliceSz,0); //lnMultiSLice := 4; 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; //showmessage(floattostr(lMultiSliceInc)+':'+inttostr(lMultiMaxSlice)+':'+inttostr(lSlice)); end else begin Self.caption := extractfilename(FFilename); end; lMultiSlice := 1; //1stSlice 123: //return here for multislice view xx lMultiCol := lMultiSlice mod lnMultiCol; {if (lMultiMultiFile) then begin lSlice := 1; lFilename := gFilePath+gStringList.Strings[lMultiSlice-1];//-1: indexed from 0 lImageStart := gOffsetList[lMultislice]; end;} if lMultiCol = 0 then lMultiCol := lnMultiCol; lMultiCol := lMultiCol - 1; //index from 0 lMultiRow := (lMultiSlice-1) div lnMultiCol; //showmessage({inttostr(lMultiSLice)+':'+}inttostr(lMultiCol)); if (gDICOMdata.JPEGLossyCpt) and ((gDICOMdata.SamplesPerPixel > 1) or (gDICOMdata.Allocbits_per_pixel> 8)) then begin Stream := TMemoryStream.Create; try Stream.LoadFromFile(lFilename); Stream.Seek(gECATposra[lSlice], soFromBeginning); Jpg := TJPEGImage.Create; try Jpg.LoadFromStream(Stream); BMP := TBitmap.create; try BMP.Height := JPG.Height; BMP.Width := JPG.Width; BMP.Canvas.Draw(0,0, JPG); Image.Picture.Bitmap := BMP; finally //try..finally BMP.Free; end; finally //try..finally Jpg.Free; end; finally Stream.Free; end; //try..finally if Self.Active then //qwer MainForm.ColUpdate; FileMode := 0; //Read only exit; end; //JPEGcpt (*if gDICOMdata.JPEGLossyCpt then begin try Stream := TMemoryStream.Create; Stream.LoadFromFile(lFilename); Stream.Seek(gECATposra[lSlice], soFromBeginning); try Jpg := TJPEGImage.Create; Jpg.LoadFromStream(Stream); Image.Picture.Graphic := Jpg; finally //try..finally Jpg.Free; end; finally Stream.Free; end; //try..finally MainForm.ColUpdate; FileMode := 0; //Read only exit; end; //JPEGcpt *) if (gDICOMdata.JPEGLosslessCpt) and(gDICOMdata.SamplesPerPixel = 3) then begin exit; end; 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 lImageStart := gDicomData.ImageStart + ((lSlice-1) * (lAllocSliceSz*gDICOMdata.SamplesPerPixel)); if (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)); closefile(infp); FileMode := 2; //read/write exit; end; Seek(infp, lImageStart); if (gDICOMdata.Allocbits_per_pixel = 8) and(gDICOMdata.SamplesPerPixel = 3) then begin if gBuff24Sz <>(lAllocSliceSz*gDICOMdata.SamplesPerPixel) then begin if gBuff24Sz <> 0 then Freemem(gBuff24); gBuff24Sz := lAllocSliceSz*gDICOMdata.SamplesPerPixel; GetMem( gBuff24, lAllocSliceSz*gDICOMdata.SamplesPerPixel); end; if gDICOMdata.planarconfig = 0 then begin BlockRead(infp, gBuff24^, lAllocSliceSz*gDICOMdata.SamplesPerPixel); end else begin if gDICOMdata.CompressSz > 0 then begin Seek(infp,gDICOMdata.CompressOffset+4*(lSlice-1)); BlockRead(infp, J, 4{, n}); J := J+(gDicomData.XYZDim[3]*4)+64+8; J := gDICOMdata.CompressOffset+J; if J < 1 then begin Freemem(gBuff24); exit; end; lFullSz := lAllocSliceSz*3; GetMem( TmpBuff, lFullSz); lFullSz := lFullSz -1; Seek(infp, J);//gDICOMdata.CompressOffset+64); GetMem( CptBuff, gDICOMdata.CompressSz); BlockRead(infp, CptBuff^, gDICOMdata.CompressSz{, n}); lCptPos := 0; J := 0; repeat lCptVal := CptBuff[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 < lFullSz then TmpBuff[J] := CptBuff[lCptPos]; inc(J); inc(lCptPos); end; end; else begin lCptVal := (-lShort); lRunVal := CptBuff[lCptPos]; inc(lCptPos); for i := 0 {0->n+1 bytes} to lCptVal do begin if J < lFullSz then TmpBuff[J] := lRunVal; inc(J); end; end; end; until (lCptPos >= gDICOMdata.CompressSz) or (J >= lFullSz); FreeMem(CptBuff); size := lAllocSliceSz-1; j:= 0; for i := 0 to size do begin gBuff24[j] := TmpBuff[i]; //red gBuff24[j+1] := TmpBuff[i+lAllocSliceSz]; gBuff24[j+2] := TmpBuff[i+lAllocSliceSz+lAllocSliceSz]; //blue j := j + 3; end; //for loop 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; end; //no compression FreeMem( TmpBuff); end; //planar config 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;//TmpBuff[i+lAllocSliceSz+lAllocSliceSz]; gBuff24[j+1] := lG;//TmpBuff[i+lAllocSliceSz]; gBuff24[j+2] := {TmpBuff[i]}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; //xxfreemem(lBuff); lBuff XXXXXX exit; end; //rgb case gDICOMdata.Allocbits_per_pixel of 8: begin if lAllocSliceSz <> gBuff8Sz then begin if gBuff8Sz <> 0 then freemem(gBuff8); GetMem( gbuff8, lAllocSliceSz); end; gBuff8Sz := lAllocSliceSz; if gDICOMdata.JPEGlossyCpt then begin Stream := TMemoryStream.Create; try CloseFile(infp); Stream.LoadFromFile(lFilename); Stream.Seek(gECATposra[lSlice], soFromBeginning); Jpg := TJPEGImage.Create; try Jpg.LoadFromStream(Stream); BMP := TBitmap.create; try BMP.Height := JPG.Height; BMP.Width := JPG.Width; BMP.PixelFormat := pf24bit; BMP.Canvas.Draw(0,0, JPG); lInc := lAllocSliceSz-1; FOR j := BMP.Height-1 DOWNTO 0 DO BEGIN lRow := BMP.Scanline[j]; FOR i := (BMP.Width - 1) downto 0 DO BEGIN gBuff8[lInc] := lRow[i].rgbtRed; dec(lInc); END; //for i.. each column END; //for j...each row //Image.Picture.Bitmap := BMP; finally //try..finally BMP.Free; end; finally //try..finally Jpg.Free; end; finally Stream.Free; end; //try..finally end else if gDicomData.JPEGlosslessCpt then begin DecodeJPEG(infp,gBuff16,gBuff8, lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice],false); end else if gDICOMdata.CompressSz > 0 then begin lFullSz := lAllocSliceSz -1; Seek(infp,gDICOMdata.CompressOffset+4*(lSlice-1)); BlockRead(infp, J, 4{, n}); J := J+(gDicomData.XYZDim[3]*4)+64+8; lCompSz := FileSize(infp) - (gDICOMdata.CompressOffset+{64}J); if lCompSz >gDICOMdata.CompressSz then lCompSz := gDICOMdata.CompressSz; Seek(infp, gDICOMdata.CompressOffset+J); GetMem( CptBuff, lCompSz); BlockRead(infp, CptBuff^, lCompSz{, n}); lCptPos := 0; J := 0; repeat lCptVal := CptBuff[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 < lFullSz then gBuff8[J] := CptBuff[lCptPos]; inc(J); inc(lCptPos); end; end; else begin lCptVal := (-lShort); lRunVal := CptBuff[lCptPos]; inc(lCptPos); for i := 0 {0->n+1 bytes} to lCptVal do begin if J < lFullSz then gBuff8[J] := lRunVal; inc(J); end; end; end; until (lCptPos >= lCompSz) or (J >= lFullSz); FreeMem( CptBuff); end else begin BlockRead(infp, gBuff8^, lAllocSliceSz{, n}); end; if not gDICOMdata.JPEGlossyCpt then begin CloseFile(infp); end; FileMode := 2; //read/write size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height}; value := gBuff8[0]; max16 := value; min16 := value; i:=0; while I < (Size) do begin value := gBuff8[i]; if value < min16 then min16 := value; if value > max16 then max16 := value; i := i+1; end; //size := (gDicomData.XYZdim[1]*gDicomData.XYZdim[2])-1 {width*height-1 }; gImgMin := min16; gImgMax := max16; gWinMin := min16; gWinMax := max16; gImgWid := gImgMax-gImgMin; gImgCen := gImgMin + ((gImgWid)shr 1); if lWinWid < 0 then begin //autocontrast gWinMin := gImgMin; gWinMax := gImgMax; gWinWid := gImgWid; gWinCen := gImgCen; end; if (gCustomPalette>0) or ((red_table_size > 0) and (red_table_size <= 256) and (red_table_size=green_table_size) and (red_table_size=blue_table_size)) then begin if gCustomPalette = 0 then begin gCustomPalette := red_table_size-1; for lInc := (gCustomPalette-1) downto 0 do begin gRra[gCustomPalette-lInc] := red_table[lInc+1];//red_table[lInc+1]; gGra[gCustomPalette-lInc] := green_table[lInc+1]; gBra[gCustomPalette-lInc] := blue_table[lInc+1];//blue_table[lInc+1]; end; freemem(red_table); red_table_size := 0; freemem(green_table); green_table_size := 0; freemem(blue_table); blue_table_size := 0; end; //red_size > 0 end; if lnMultiSlice > 1 then begin lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0 for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin i := j * lMultiColSz; move(gBuff8[i],lMultiBuff[lMultiStart+ (J*lMultiLineSz)],lMultiColSz); end; lSlice := gMultiFirst+round (lMultiSliceInc*lMultiSlice); inc(lMultiSlice); if (lMultiSlice <= lnMultiSlice) and (lSlice <= {lMultiMaxSlice}gMultiLast) then goto 123; freemem(gBuff8); getmem(gBuff8,lMultiSliceSz); move(lMultiBuff[0],gBuff8[0],lMultiSliceSz); freemem(lMultiBuff); gBuff8Sz := lMultiSliceSz; //gBuff8 := @lMultiBuff^; end; // g100pctImageWid := gDIcomData.XYZdim[1]; // g100pctImageHt :=gDIcomData.XYZdim[2]; DetermineZoom; SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true); UpdatePalette(true,0); //dsa gPalUpdated := false; // image.Height:= round((image.Picture.Bitmap.Height * gZoomPct) div 100); // image.Width := round((image.Picture.Bitmap.Width* gZoomPct) div 100) ; {image.Height:= image.Picture.Height; image.Width := image.Picture.Width; Image.Refresh;} DICOMImageRefreshAndSize; if Self.Active then //qwer MainForm.ColUpdate; exit; end; 16: begin if gECATslices >= lSlice then seek(infp, gECATposra[lSlice]) else Seek(infp, lImageStart); if (gBuff16Sz <> (lAllocSliceSz shr 1)) then begin if gBuff16sz <> 0 then Freemem(gBuff16); gBuff16Sz := 0; end; if gBuff16sz = 0 then GetMem( gbuff16, lAllocSliceSz); gBuff16sz := (lAllocSliceSz shr 1); if gDicomData.JPEGlosslessCpt then begin DecodeJPEG(infp,gBuff16,lBuff, lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice],false); end else if gDicomData.GenesisCpt then begin lLastPixel := 0; lBufEntries := lAllocSliceSz div 2; lTmpSz := FileSize(infp)-lImageStart; if (lAllocSliceSz < lTmpSz) then lTmpSz := FileSize(infp)-lImageStart; if (lAllocSliceSz < lTmpSz) then lTmpSz := lAllocSliceSz; {idea: for multi slice images, limit compression} lTmpSz := lTmpSz - 2; GetMem( TmpBuff, lTmpSz); BlockRead(inFp, TmpBuff^, lTmpSz); {$R-} lTmpPos := 0; lImgPos := 0; lLineStart := 1; lLineEnd := gDicomData.XYZdim[1]{round(Xdim.value)};//gDicomData.XYZdim[1]; for lLine := 1 to gDicomData.XYZdim[2] do begin if gDicomData.GenesisPackHdr <> 0 then begin lLineStart :=swap16i(gDicomData.GenesisPackHdr+((lLine-1)*4)); lLineEnd := -1+lLineStart+ swap16i(2+gDicomData.GenesisPackHdr+((lLine-1)*4)); //if lLine < 10 then showmessage(inttostr(lLineStart)); if lLinestart >0 then for lPos := 1 to (lLineStart) do begin gBuff16[lImgPos] := 0; inc(lImgPos); end; end; for lPos := lLineStart to lLineEnd do begin lByte := GetByte; if (lByte > 127) then begin if ((lByte and 64)=64) then begin {new 16 bits} I := GetByte;//lByte2; lByte := GetByte; lLastPixel := ((I shl 8)+lByte); end else begin {not lbyte and 64: 14 byte delta} lByte2 := getbyte; J := lByte2; if ((lByte and 32)=32) then {subtract delta} //shl1=2,shl2=4,shl3=8,shl4=16,shl5=32 I := (lByte or $E0) else I := lByte and $1F; lLastPixel := lLastPixel + smallint(((I)shl 8)+ (J {shl 5})) end; {14 byte delta} end else begin {not lbyte and 128: 7 byte delta} if (lByte > 63) then {subtract delta} lByte := lByte or $C0; lLastPixel := lLastPixel + shortInt(lByte); end; //lbyte values if lImgPos <= lBufEntries then gBuff16[lImgPos] := lLastPixel else //imgpos >= lAlloc goto 444; inc(lImgPos); end; //lPos if (lLineEnd+1) < {round(Xdim.value)}gDICOMData.XYZdim[1] then begin for lPos := gDICOMData.XYZdim[1] downto (lLineEnd+2) do begin //if lLine < (512) then gBuff16[lImgPos] := 0; inc(lImgPos); end; end; end; //for lines 444: Freemem(TmpBuff); end else begin //not genesis BlockRead(infp, gbuff16^, lAllocSliceSz{, n}); end; CloseFile(infp); FileMode := 2; //read/write end; 12: begin GetMem( tmpbuff, lAllocSliceSz); BlockRead(infp, tmpbuff^, lAllocSliceSz{, n}); CloseFile(infp); FileMode := 2; //read/write lStoreSliceVox := gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2]; lStoreSLiceSz := lStoreSliceVox * 2; if (gBuff16Sz <> (lStoreSLiceSz shr 1)) then begin if gBuff16sz <> 0 then Freemem(gBuff16); //asdf gBuff16Sz := 0; end; if gBuff16sz = 0 then GetMem( gbuff16, lStoreSLiceSz); gBuff16sz := lStoreSLiceSz shr 1; I12 := 0; I := 0; if gDicomData.little_endian = 1 then begin repeat gbuff16[I] := tmpbuff[I12] + ((tmpbuff[I12+1] and 15) shl 8); inc(I); if I < lStoreSliceVox then gbuff16[i] := (tmpbuff[I12+2] shl 4) +((tmpbuff[I12+1] and 240) shr 4 ); inc(I); I12 := I12 + 3; until I >= lStoreSliceVox; end else begin repeat gbuff16[I] := tmpbuff[I12] shl 4 + (tmpbuff[I12+1] and 15); inc(I); if I < lStoreSliceVox then gbuff16[i] := (((tmpbuff[I12+2]) and 15) shl 8) +((((tmpbuff[I12+1]) shr 4 ) shl 4)+((tmpbuff[I12+2]) shr 4) ); inc(I); I12 := I12 + 3; until I >= lStoreSliceVox; end; FreeMem( tmpbuff); end; else exit; end; size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height}; if (gDicomdata.little_endian <> 1) and (not gDicomData.GenesisCpt) then //convert big-endian data to Intel friendly little endian for i := (Size-1) downto 0 do gbuff16[i] := swap(gbuff16[i]); value := gbuff16[0]; max16 := value; min16 := value; i:=0; while I < (Size) do begin value := gbuff16[i]; if value < min16 then min16 := value; if value > max16 then max16 := value; i := i+1; end; gImgMin := min16; gImgMax := max16; gImgWid := gImgMax-gImgMin; gImgCen := gImgMin + ((gImgWid)shr 1); if lWinWid < 0 then begin //autocontrast gWinMin := gImgMin; gWinMax := gImgMax; gWinCen := gImgCen; gWinWid := gImgWid; gFastCen := gImgCen; //showmessage('x'); end; if lnMultiSlice > 1 then begin //showmessage(inttostr(lMultiSlice)+':'+inttostr(lnMultiSlice)+':'+inttostr(g100pctImageWid)); lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0 for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin i := j * lMultiColSz; move(gBuff16[i],lMultiBuff[(lMultiStart+ (J*lMultiLineSz)) shl 1],lMultiColSz shl 1); end; // lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0 // for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin // i := j * lMultiColSz; // move(gBuff16[i],lMultiBuff16[(lMultiStart+ (J*lMultiLineSz)) shr 1],lMultiColSz {shl 1}); // end; //showmessage('CXZ'+inttostr(lMultiSlice)+':'+inttostr(lnMultiSlice)+':'+inttostr(g100pctImageWid)); //inc(lSlice); lSlice := gMultiFirst+round (lMultiSliceInc*lMultiSlice); inc(lMultiSlice); if (lMultiSlice <= lnMultiSlice) and (lSlice <= {lMultiMaxSlice}gMultiLast) then goto 123; freemem(gBuff16); getmem(gBuff16,lMultiSliceSz shl 1); gBuff16sz := (lMultiSliceSz); move(lMultiBuff[0],gBuff16[0],lMultiSliceSz shl 1); freemem(lMultiBuff); {} //gBuff16 := @lMultiBuff^; end; //showmessage(inttostr(g100pctImageWid)+':123abba:'+inttostr(gMultiRow)); DetermineZoom; Scale16to8bit(gWinCen,gWinWid); DICOMImageRefreshAndSize; if Self.Active then //qwer MainForm.ColUpdate; exit; {$P-,S+,W+,R+} end; procedure TMDIChild.FileOpenpicture1Click(Sender: TObject); begin MainForm.Opengraphic1Click(Sender); end; procedure TMDIChild.Lowerslice1Click(Sender: TObject); var lSlice: integer; begin gMultiCol := 1; gMultiRow := 1; if (sender as TMenuItem).tag = 1 then begin{increment} if gSlice >= gDICOMdata.XYZdim[3] then lSlice := 1 else lSlice := gSlice + 1; end else begin if gSlice > 1 then lSlice := gSlice -1 else lSlice := gDICOMdata.XYZdim[3]; end; MainForm.SliceSlider.position := lSlice; MainForm.SliceSliderChange(nil); end; procedure TMDIChild.FormActivate(Sender: TObject); begin MainForm.ColUpdate; automaximise; end; procedure TMDIChild.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lSlice,lX,lY: integer; lSLopeReal: single; begin if (button = mbLeft) and (ssCtrl{Shift} in Shift) then begin Screen.Cursor := crDrag; //GetCursorPos( FLastDown ); gMouseDown := true; lX := round((X *image.Picture.Height)/image.Height); lY := round((Y *image.Picture.Width)/image.Width); //lX := ((X * 100) div gZoomPct); //lY := ((Y * 100) div gZoomPct); gSelectOrigin.X := lX; gSelectOrigin.Y := lY; end else if (button = mbLeft) and (ssAlt in Shift) then begin Screen.Cursor := crHandPoint; GetCursorPos( FLastDown ); gMouseDown := true; end else if (button = mbLeft) and (ssShift in Shift) then begin if (BackupBitmap = nil) then begin {if gPalUpdated then begin lSlice := gSlice; gSlice := 0; //force redraw DisplayImage(false,true,lSlice,gWinWid,gWinCen); end; dsa} BackupBitmap := TBitmap.Create; BackupBitmap.Assign(Image.Picture.Bitmap); end; FLastDown := Point( - 1, - 1); gMouseDown := true; ShowMagnifier (X,Y); {} end else if (button = mbLeft) and (FDicom) and (gCustomPalette = 0) and (gDicomdata.SamplesPerPixel = 1) then begin FLastDown := Point( - 1, - 1); if gBuff16sz > 0 then begin if (gImgMax-gIMgMin) > 0 then gFastCen := round( ((gWinCen-gImgMin)/(gImgMax-gIMgMin))* 1024{512}) else gFastCen := 512; if gWinWId > 0 then lSlopeReal := (gImgMax-gIMgMin)/ gWinWid else lSlopeReal := 666; gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.0878); end else begin gFastCen := gWinCen; if gWinWId > 0 then lSlopeReal := 255 / gWinWid else lSlopeReal := 45; gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.352059); end; gXstart := X; gYstart := Y; gStartSlope := gFastSlope; gStartCen := gFastCen; gMouseDown := true; end; end; procedure TMDIChild.UpdatePalette (lApply: boolean;lWid0ForSlope:integer); var lMin,lMax,lInc{,lV,lMinPal,lMaxPal}: integer; //PPal: PLogPalette; lSlopeReal: single; begin //dsa gPalUpdated := true; if gDICOMdata.Allocbits_per_pixel > 8 then begin if not lApply then exit; (*for lInc := 0 to 255 do begin gRGBquadRA[lInc].rgbRed := gRra[lInc]; gRGBquadRA[lInc].rgbGreen :=gGra[lInc]; gRGBquadRA[lInc].rgbBlue := gBra[lInc]; //gRGBquadRA[lInc].rgbReserved := 0; end; Image.Picture.Bitmap.HandleType := bmDIB; SetDIBColorTable(Image.Picture.Bitmap.Canvas.Handle, 0, 256, gRGBQuadRA); IMage.Invalidate;*) refreshzoom; exit; end; if lWid0ForSlope = 0 then begin lSlopeReal := gFastSlope * 0.352059; lSlopeReal := sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon); //showmessage(Floattostr(gFastSlope)+':'+ floattostr((arctan(lSlopeReal)/kRadCon)/0.352059)); if lSlopeReal <> 0 then begin lMax := round(128 / lSlopeReal); lMin := gFastCen-lMax; lMax := gFastCen+lMax; 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); //gFastSlope := round((ArcTan(lSlopeReal*kRadCon))/ 0.352059); //showmessage(inttostr(gFastSlope)); //gFastSlope := 128;//round((cos(lSlopeReal*kRadCon)/sin(lSlopeReal*kRadCon))/0.352059); end; if gDicomData.Allocbits_per_pixel < 9 then begin gWinCen := (gFastCen); if ((lMax - lMin) > maxint) or ((lMin=0) and (lMax=0)) then begin gContrastStr := 'Window Cen/Wid: '+inttostr(gFastCen)+'/inf'; gWInWid := maxint; end else begin gContrastStr := 'Window Cen/Wid: '+inttostr(gFastCen)+'/'+inttostr(lMax - lMin); gWInWid := (lMax - lMin); end; end; if gBuff8Sz > 0 then begin SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true); DICOMImageRefreshAndSize; end; (*if lMin < 0 then lMin := 0 else if lMin > 255 then lMin := 255; if lMax < 0 then lMax := 0 else if lMax > 255 then lMax := 255; lMinPal := 128+round(lSlopeReal*(0-gFastCen)); if (lMinPal < 0) or (lMinPal > 255) then lMinPal := 0; lMaxPal := 128+round(lSlopeReal*(255-gFastCen)); if (lMaxPal < 0) or (lMaxPal > 255) then lMaxPal := 255; for lInc := 0 to lMin do gPalra[lInc] := lMinPal;//0; for lInc := lMax to 255 do gPalra[lInc] := lMaxPal;//255; if (lMin+1) < lMax then begin for lInc := (lMin+1) to (lMax-1) do begin lV := 128+round(lSlopeReal*(lInc-gFastCen)); if lV < 0 then lV := 0 else if lV > 255 then lV := 255; gPalRA[lInc] := lV;//(lInc-gFastCen); end; end; if not lApply then exit; for lInc := 0 to 255 do begin gRGBquadRA[lInc].rgbRed := gRra[gPalRA[lInc]]; gRGBquadRA[lInc].rgbGreen :=gGra[gPalRA[lInc]]; gRGBquadRA[lInc].rgbBlue := gBra[gPalRA[lInc]]; //gRGBquadRA[lInc].rgbReserved := 0; end; Image.Picture.Bitmap.HandleType := bmDIB; SetDIBColorTable(Image.Picture.Bitmap.Canvas.Handle, 0, 256, gRGBQuadRA); IMage.Invalidate;*) end; procedure TMDIChild.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var lX,lY,lWid: integer; lSlopeReal: single; var pt: TPoint; begin if not gMouseDown then begin lX := {trunc}((X * 100) div gZoomPct); lY := {trunc}((Y * 100) div gZoomPct); Vxl(lX,lY); //MainForm.StatusBar.Panels[3].text := inttostr(lX)+':'+inttostr(lY);//abba exit; end; if (ssCtrl in Shift) then begin Image.Canvas.DrawFocusRect(gSelectRect); lX := round((X *image.Picture.Height)/image.Height); lY := round((Y *image.Picture.Width)/image.Width); if gSelectOrigin.X < 1 then begin gSelectOrigin.X := lX; gSelectOrigin.Y := lY; end; if lX < gSelectOrigin.X then begin gSelectRect.Right := gSelectOrigin.X; gSelectRect.Left := lX; end else begin gSelectRect.Right := lX; gSelectRect.Left := gSelectOrigin.X; end; if lY < gSelectOrigin.Y then begin gSelectRect.Bottom := gSelectOrigin.Y; gSelectRect.Top := lY; end else begin gSelectRect.Bottom := (lY); gSelectRect.Top := gSelectOrigin.Y end; Image.Canvas.DrawFocusRect(gSelectRect); end else if {(ssLeft In Shift) gMouseDown and} (FLastDown.X >= 0) then begin GetCursorPos( pt ); Scrollbox1.VertScrollBar.Position := Scrollbox1.VertScrollBar.Position + FLastDown.Y - pt.Y; Scrollbox1.HorzScrollBar.POsition := Scrollbox1.HorzScrollBar.Position + FLastDown.X - pt.X; FLastDown := pt; {end else if (BackupBitmap <> nil) then begin ShowMagnifier (X,Y);} end else if (BackupBitmap <> nil) then begin ShowMagnifier (X,Y); end else if gBuff16sz > 0 then begin (* lX := x-gXStart; if ((lX+gStartSlope) > 512) then gFastSlope := 512 else if ((lX+gStartSlope) < 1) then gFastSlope := 1 else gFastSlope := lX+gStartSlope; lSlopeReal := gFastSlope * 0.175781; lWid := trunc((gImgMax-gIMgMin)/(sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon))); lY := y-gYStart; lY := round(lY*(gImgMax-gIMgMin)/ 512); if ((gStartCen + lY)> gImgMax) then gFastCen := gImgMax else if ((lY+gStartCen) < gImgMin) then gFastCen := gImgMin else gFastCen := gStartCen + lY;{} Scale16to8bit(gFastCen,lWid); DICOMImageRefreshAndSize;*) lX := x-gXStart; if ((lX+gStartSlope) > 1024) then gFastSlope := 1024 else if ((lX+gStartSlope) < 1) then gFastSlope := 1 else gFastSlope := lX+gStartSlope; lSlopeReal := gFastSlope * 0.0878{0.175781 {CONTRAST change here}; lWid := trunc((gImgMax-gIMgMin)/(sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon))); lY := y-gYStart; if ((gStartCen + lY)> 1024) then gFastCen := 1024 else if ((lY+gStartCen) < 0) then gFastCen := 0 else gFastCen := gStartCen + lY;{} lY := round(((gFastCen/ 1024)*(gImgMax-gIMgMin))+gImgMin); {CONTRAST change here: /n where n is amount of mouse movement} Scale16to8bit(lY,lWid); DICOMImageRefreshAndSize; end else begin lX := x-gXStart; if ((lX+gStartSlope) > 255) then gFastSlope := 255 else if ((lX+gStartSlope) < 0) then gFastSlope := 0 else gFastSlope := lX+gStartSlope; lY := y-gYStart; if ((gStartCen + lY)> 255) then gFastCen := 255 else if ((lY+gStartCen) < 0) then gFastCen := 0 else gFastCen := gStartCen + lY; UpdatePalette(true,0); MainForm.StatusBar.Panels[4].text := gContrastStr; end; end; procedure TMDIChild.ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure MinMaxRect (var lIn: integer; lMaxPlus1: integer); begin if lIn < 0 then lIn := 0; if lIn >= lMaxPlus1 then lIn := lMaxPlus1 -1; end; var lSlice,lWinWid,lWinCen,lVal,lMin,lMax,lCol,lROw: integer; begin FLastDown := Point( - 1, - 1); Screen.Cursor := crDefault; if (gSelectRect.left <> gSelectRect.right) and (gSelectRect.top <> gSelectRect.bottom) then begin Image.Canvas.DrawFocusRect(gSelectRect); if gSmooth then begin gSelectRect.Left := ((gSelectRect.Left * 100) div gZoomPct); gSelectRect.Top := ((gSelectRect.Top * 100) div gZoomPct); gSelectRect.Right := ((gSelectRect.Right * 100) div gZoomPct); gSelectRect.Bottom := ((gSelectRect.Bottom * 100) div gZoomPct); end; MinMaxRect(gSelectRect.Left,g100pctImageWid); MinMaxRect(gSelectRect.Top,g100pctImageHt); MinMaxRect(gSelectRect.Right,g100pctImageWid); MinMaxRect(gSelectRect.Bottom,g100pctImageHt); //MainForm.StatusBar.Panels[1].text := inttostr(gSelectRect.Left)+':'+inttostr(gSelectRect.Top)+':'+inttostr(gSelectRect.Right)+':'+inttostr(gSelectRect.Bottom); //cxz lMin := VxlVal((gSelectRect.Left {* 100}) {div gZoomPct},(( gSelectRect.Top {* 100}) {div gZoomPct})); lMax := lMin; for lCol := gSelectRect.Left to gSelectRect.Right do begin //lX := ((lCol * 100) div gZoomPct); for lRow := gSelectRect.Top to gSelectRect.Bottom do begin lVal := VxlVal(lCol,{((lRow * 100) div gZoomPct)}lRow); if lVal < lMin then lMin := lVal; if lVal > lMax then lMax := lVal; end; //row end; //column gSelectRect := Rect(0,0,0,0); gSelectOrigin.X := -1; lWinWid := lMax - lMin; //max now = windowwid lWinCen := lMin + (lWinWid shr 1); gWinWid := lWinWid; gWinCen := LwinCen; gFastCen := lWinCen; if gBuff16sz > 0 then begin RefreshZoom; end else begin if lWinWid = 0 then lWinWid := 1; UpdatePalette(true,lWinWid); end; end else if (BackupBitmap <> nil) then begin//magnifier was on Image.Picture.Graphic := BackupBitmap; // Restore base image BackupBitmap.Free; BackupBitmap := nil; IMage.refresh; end else if (gMOuseDown) and (gBuff16sz > 0) then begin Mainform.WinCenEdit.value := gWinCen; MainForm.WinWidEdit.value := gWinWid; end; gMouseDown := false; end; procedure TMDIChild.SelectZoom1Click(Sender: TObject); begin if MainForm.ZoomSlider.enabled then MainForm.ZoomSlider.SetFocus else if MainForm.SchemeDrop.enabled then MainForm.SchemeDrop.SetFocus; end; procedure TMDIChild.ContrastAutobalance1Click(Sender: TObject); begin MainForm.AutoBal.Click; end; procedure TMDIChild.FormResize(Sender: TObject); begin //if (MainForm.BestFitItem.checked) {and (not gZoomSlider)} then automaximise; end; procedure TMDIChild.CopyItemClick(Sender: TObject); var MyFormat : Word; AData: THandle; //APalette : THandle; APalette : HPalette; begin if (Image.Picture.Bitmap = nil) or (Image.Picture.Width < 1) or (Image.Picture.Height < 1) then exit; Image.Picture.Bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette); ClipBoard.SetAsHandle(MyFormat,AData); end; procedure TMDIChild.Timer1Timer(Sender: TObject); var lSlice: integer; begin if gDicomdata.XYZdim[3] > 1 then begin if gSlice >= gDICOMdata.XYZdim[3] then lSlice := 1 else lSlice := gSlice + 1; DisplayImage(false,false,lSlice,gWinWid,gWinCen); end else begin Timer1.enabled := false; gVideoSpeed := 0; MainForm.VideoBtn.Caption := '0'; end; end; procedure TMDIChild.Previous1Click(Sender: TObject); begin gMultiCol := 1; gMultiRow := 1; if (sender as TMenuItem).tag = 1 then begin //increment gCurrentPosInFileList := gCurrentPosInFileList+1; end else gCurrentPosInFileList := gCurrentPosInFileList-1; if (gCurrentPosInFileList >= gFileListSz) then gCurrentPosInFileList := 0; if (gCurrentPosInFileList < 0) then gCurrentPosInFileList := gFileListSz-1; //showmessage(gStringList.Strings[gCurrentPosInFileList]); LoadData( gFilePath+gStringList.Strings[gCurrentPosInFileList] ,false,false,false,false ); MainForm.ColUpdate; //if (MainForm.BestFitItem.checked) then automaximise; //if (MainForm.BestFitItem.checked) {and (not gZoomSlider)} then // automaximise; end; procedure TMDIChild.N1x11Click(Sender: TObject); var lSize : integer; begin // (sender as tmenuitem).checked := true; lSize := (sender as TMenuItem).tag; Timer1.enabled := false; gVideoSpeed := 0; MainForm.VideoBtn.Caption := '0'; if lSize < 5 then begin gMultiCol := lSize; gMultiRow := lSize; gMultiFirst := 1; gMultiLast := gDICOMdata.XYZdim[3]; lSize := gSlice; gSlice := 0; //force redraw DisplayImage(false,false,lSize,gWinWid,gWinCen); //if (MainForm.BestFitItem.checked) then automaximise; //gMultiCol := 1; //gMultiRow := 1; end else begin MultiSliceForm.gMaxMultiSlices := gDICOMdata.XYZdim[3]; MultiSliceForm.ShowModal; gMultiCol := MultiSliceForm.ColEdit.value; gMultiRow := MultiSliceForm.RowEdit.value; gMultiFirst := MultiSliceForm.FirstEdit.value; gMultiLast := MultiSliceForm.LastEdit.value; lSize := gSlice; gSlice := 0; //force redraw DisplayImage(false,false,lSize,gWinWid,gWinCen); //if (MainForm.BestFitItem.checked) then automaximise; //gMultiCol := 1; //gMultiRow := 1; end; end; procedure TMDIChild.Smooth1Click(Sender: TObject); begin Smooth1.checked := not Smooth1.checked; gSmooth := Smooth1.checked; RefreshZoom; end; procedure TMDIChild.None1Click(Sender: TObject); begin (sender as tmenuitem).checked := true; RefreshZoom; end; end.