childwin.~pas

在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的

unit Childwin;

interface

uses SysUtils, Windows, Classes, Graphics, Forms,
  Controls, ExtCtrls, StdCtrls, Buttons, define_types, dicom,
  ComCtrls, Menus, Dialogs, JPEG, decompress, lsJPEG, Clipbrd, ToolWin, analyze,
  ImgList, ActnList;
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;
    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;
    ToolBar2: TToolBar;
    btnArrow: TToolButton;
    btnLine: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton1: TToolButton;
    ActionList1: TActionList;
    ToolSelectAct: TAction;
    ToolLineAct: TAction;
    ToolRectAct: TAction;
    ToolRoundRectAct: TAction;
    ToolEllipseAct: TAction;
    DeleteAct: TAction;
    ImageList1: TImageList;
    StatusBar: TStatusBar;
    Image: TImage;
    btnState: TToolButton;
    btnGrid: TToolButton;
    PenBar: TPanel;
    SolidPen: TSpeedButton;
    DashPen: TSpeedButton;
    DotPen: TSpeedButton;
    DashDotPen: TSpeedButton;
    DashDotDotPen: TSpeedButton;
    ClearPen: TSpeedButton;
    PenColor: TSpeedButton;
    PenWidth: TUpDown;
    PenSize: TEdit;
    Memo2: TMemo;
    BrushBar: TPanel;
    SolidBrush: TSpeedButton;
    ClearBrush: TSpeedButton;
    HorizontalBrush: TSpeedButton;
    VerticalBrush: TSpeedButton;
    FDiagonalBrush: TSpeedButton;
    BDiagonalBrush: TSpeedButton;
    CrossBrush: TSpeedButton;
    DiagCrossBrush: TSpeedButton;
    BrushColor: TSpeedButton;
    Memo3: TMemo;
    ColorDialog1: TColorDialog;
    ToolButton3: TToolButton;
    btnPenBar: TToolButton;
    btnBrushBar: TToolButton;
    SpeedButton1: TSpeedButton;
    //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);
    procedure FormDestroy(Sender: TObject);
    procedure ToolSelectActExecute(Sender: TObject);
    procedure DeleteActExecute(Sender: TObject);
    procedure btnStateClick(Sender: TObject);
    procedure btnGridClick(Sender: TObject);
    procedure PenSizeChange(Sender: TObject);
    procedure DashPenClick(Sender: TObject);
    procedure ClearBrushClick(Sender: TObject);
    procedure BrushColorClick(Sender: TObject);
    procedure PenColorClick(Sender: TObject);
    procedure btnPenBarClick(Sender: TObject);
    procedure btnBrushBarClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure TurnBtnClick(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;


  {******************************************************
  //处理图像
  //胥小华
  //2004-10-12
  ******************************************************}
  private
    PicState:Boolean;
    procedure ShowCursorPos(X, Y: Integer);
    procedure DrawGraphics(ABeginPoint, AEndPoint: TPoint; APenMode: TPenMode);
    procedure CreateGraphics;



    procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OnPaintBoxPaint(Sender: TObject);
                                                           
    procedure ViewImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ViewImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ViewImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  //******************************************************}


  public
    BackupBitmap: TBitmap;
    gSelectRect, gMagRect, gLine: TRect;
    gLineLenMM: double;
    gMultiFirst, gMultiLast, gMultiRow, gMultiCol, g100pctImageWid, g100pctImageHt {,gMaxRGB,gMinRGB,gMinHt,gMinWid}:
      integer;
    gSmooth, gImgOK, FDICOM: boolean;
    gBuff16: SmallIntP0;
    gBuff8, gBuff24: Bytep0;
    gDicomData: DIcomData;
    gIntenScaleInt, gIntenInterceptInt: integer;
    gIntRescale: boolean;
    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, lInWinWid, lInWincen: integer);
    procedure HdrShow;
    procedure RefreshZoom;
    procedure ShowMagnifier(const X, Y: INTEGER); //requires backup bitmap
  end;
var
  MDIChild: TMDIChild;
  GRID_SPACE:Integer;

//*********************************************************************************
type
  TDrawTool = (dtSelect, dtLine, dtRect, dtRoundRect, dtEllipse);


//const
//  GRID_SPACE = 16;
var
  BeginPoint, EndPoint: TPoint; //用来保存画图时起始点坐标和终止的坐标
  DragBeginPoint, DragEndPoint: TPoint; //拖放图形时的起始坐标和终止坐标
  bDrawing: Boolean; //是否正在画图
  bMoving: Boolean; //是否正在移动图形
  bResizing: Boolean; //是否正在改变图形的大小
  curTool: TDrawTool = dtSelect; //当前图形

//*********************************************************************************

implementation




uses Main, uMultislice, GraphicsClassUnit, VectorGraphClassUnit;

var
  gMaxRGB, gMinRGB, gMinHt, gMinWid: integer;


//*********************************************************************************
var
  VectorGraph: TVectorGraph;
  SelectedGraphics: TGraphics; //当前选中的图形
//*********************************************************************************



{$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);