childwin.pas

用Delphi做的读取医学图片的控件及代码

unit Childwin;

interface
uses SysUtils, Windows, Classes, Graphics, Forms,
     Controls, ExtCtrls, StdCtrls, Buttons,define_types,dicom,
     ComCtrls, Menus, Dialogs,JPEG,decompress,lsJPEG,Clipbrd, ToolWin,uMultislice,analyze;
const
     kRadCon = pi/180;
     kMaxECAT = 512;
     gMouseDown : boolean = false;
     gInc: integer = 0;
type
    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;
    ContrastSuggested1: TMenuItem;
    ContrastCTPresets1: TMenuItem;
    Bone1: TMenuItem;
    Chest1: TMenuItem;
    Lung1: TMenuItem;
    //procedure decompressJPEG24x (lFilename: string; var lOutputBuff: ByteP0; lImageVoxels,lImageStart{gECATposra[lSlice]}: integer);

    procedure RescaleInit;
    procedure RescaleClear;
    function RescaleFromBuffer(lIn:integer):integer;
    function RescaleToBuffer(lIn:integer):integer;
    procedure FreeBackupBitmap;
    procedure UpdatePalette (lApply: boolean; lWid0ForSlope:integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FileOpenItemClick(Sender: TObject);
    procedure FileExitItemClick(Sender: TObject);
    procedure OptionsImgInfoItemClick(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; lRGB_greenOnly: boolean):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);
    procedure ContrastSuggested1Click(Sender: TObject);
    procedure CTpreset(Sender: TObject);
  private
    { Private declarations }
      FLastDown,gSelectOrigin: TPoint;
     // gMagRect,gSelectRect: TRect;
    FFileName,gFilePath     : string;
    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,gLine: TRect;
    gLineLenMM: double;
    gMultiFirst,gMultiLast,gMultiRow,gMultiCol,g100pctImageWid, g100pctImageHt{,gMaxRGB,gMinRGB,gMinHt,gMinWid}: integer;
    gFastCheck,gSmooth,gImgOK,FDICOM: boolean;
    gBuff16: SmallIntP0;
    gBuff8,gBuff24: Bytep0;
    gDicomData: DIcomData;
    gIntenScaleInt,gIntenInterceptInt :integer;
    gIntRescale :boolean;
    gStringList : TStringList;
    gVideoSpeed,gBuff24sz,gBuff8sz, gBuff16sz,gCustomPalette: integer;
    //gRaw16Min,gRaw16Max,
    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,lInWinWid,lInWincen: integer);
    procedure HdrShow;
    procedure RefreshZoom;
    PROCEDURE ShowMagnifier (CONST X,Y:  INTEGER);//requires backup bitmap
  end;
var
   MDIChild : TMDIChild;


implementation

uses Main;

var
gMaxRGB,gMinRGB,gMinHt,gMinWid: integer;
{$R *.DFM}

procedure TMDIChild.OverlayData;
//Overlays Text onto the image reporting image brightness/contrast
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 (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]));
                       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,'C: '+inttostr(gWinCen));
              lSpace :=lSpace+ 2+lFontSpacing;
              Image.Canvas.TextOut(6,lSpace,'W: '+inttostr(gWinWid));
  end;



procedure TMDIChild.RefreshZoom;
//redraws the image to the correct size, minimizes flicker
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) then begin
       SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
  end else begin
       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;
  if gDicomData.Allocbits_per_pixel < 9 then begin
     if (gWinWid >= maxint)  then begin
               gContrastStr := 'Window Cen/Wid: '+inttostr(gWinCen)+'/inf';
     end else begin
                gContrastStr := 'Window Cen/Wid: '+inttostr(gWinCen)+'/'+inttostr(gWinWid)
     end;
  end;
  MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct)+'%';
  DICOMImageRefreshAndSize;
  LockWindowUpdate(0);
end;

procedure TMDIChild.DICOMImageRefreshAndSize;
//Checks image scale and redraws the image
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.FreeBackupBitmap;
//release dynamic memory used for magnifying glass
begin
     if BackupBItmap <> nil then begin
        Backupbitmap.free;
        Backupbitmap := nil;
     end;
     gMagRect := Rect(0,0,0,0);
end;

procedure   TMDIChild.ReleaseDICOMmemory;
//release dynamic memory allocation
begin
  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 ShellSort (first, last: integer; var lPositionRA{,lIndexRA}: longintP; lIndexRA: DWordP; var lRepeatedValues: boolean);
{Shell sort chuck uses this- see 'Numerical Recipes in C' for similar sorts.}
{less memory intensive than recursive quicksort}
label
     555;
const
     tiny = 1.0e-5;
     aln2i = 1.442695022;
var
   n,t, nn, m, lognb2, l, k, j, i, s: INTEGER;
begin
     lRepeatedValues := false;
     n := abs(last - first + 1);
     lognb2 := trunc(ln(n) * aln2i + tiny);
     m := last;
     for nn := 1 to lognb2 do
         begin
              m := m div 2;
              k := last - m;
              for j := 1 to k do begin
                  i := j;
                  555: {<- LABEL}
                  l := i + m;
                  if lIndexRA[lPositionRA[l]] = lIndexRA[lPositionRA[i]] then begin

                      //showmessage(inttostr(lIndexRA[lPositionRA[l]] shr 24 and 255 )+'-'+inttostr(lIndexRA[lPositionRA[l]] shr 16 and 255 )+'-'+inttostr(lIndexRA[lPositionRA[l]] and 65535 ) );
                      lRepeatedValues := true;
                      exit;
                  end;
                  if lIndexRA[lPositionRA[l]] < lIndexRA[lPositionRA[i]] then begin
                     //swap values for i and l
                     t := lPositionRA[i];
                     lPositionRA[i] := lPositionRA[l];
                     lPositionRA[l] := t;
                     i := i - m;
                     if (i >= 1) then
                        goto 555;
                  end
              end
         end
     end;           (**)

procedure TMDIChild.LoadFileList;
//Searches for other DICOM images in the same folder (so user can cycle through images
var
  lSearchRec: TSearchRec;
  lName,lFilenameWOPath,lExt : string;
  lSz,lDICMcode: integer;
  lDICM: boolean;
  FP: file;
  lIndex: DWord;
  lInc,lItems: longint;//vixen
  lDicomData: DicomData; //vixen
  lRepeatedValues,lHdrOK,lImgOK: boolean; //vixen
  lFilename,lDynStr,lFoldername: String;//vixen
  lStringList : TStringList; //vixen
  lTimeD:DWord;
    lIndexRA: DWordP;
  lPositionRA{,lIndexRA}: longintP;//vixen
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 FindFirst(gFilePath+'*.*', faAnyFile-faSysFile-faDirectory, lSearchRec) = 0 then begin
        repeat
              lExt := AnsiUpperCase(extractfileext(lSearchRec.Name));
              lName := AnsiUpperCase(lSearchRec.name);