ezdicomimpl1.pas

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

unit ezDICOMImpl1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, ezDICOMax_TLB, StdVcl, ExtCtrls, StdCtrls, ComCtrls,
  Buttons, ToolWin,DICOM,analyze,JPEG,lsjpeg, Grids, ValEdit,ClipBrd,decompress,define_types;
const
  kCopyrightString = 'ezDICOM ActiveX component version 3/3/2004, BSD license, copyright Krug and Rorden 2002, www.mricro.com'; //do not change this string - copyright notice
  k10 = chr(10);
  kRadCon = pi/180;
  kMaxECAT = 5120;
  kBorderSz = 2;
  kContrast = 1;
  kAreaContrast = 2;
  kMagnify = 3;
  kPan = 4;
  kLine = 5;
  kOffset = 0; {always smallest value in gOffsetRA}
  kWinCen = 1;
  kWinWid = 2; {almost largest value in gOffsetRA}
type
  TezDICOMX = class(TActiveForm, IezDICOMX)
    ToolBar1: TToolBar;
    OpenBtn: TSpeedButton;
    PreviousBtn: TSpeedButton;
    NextBtn: TSpeedButton;
    MosaicBtn: TSpeedButton;
    AboutBtn: TSpeedButton;
    ToolButton1: TToolButton;
    ColorDrop: TComboBox;
    ToolButton3: TToolButton;
    ZoomDrop: TComboBox;
    ToolButton4: TToolButton;
    ToolDrop: TComboBox;
    ToolButton2: TToolButton;
    ScrollBox1: TScrollBox;
    Image: TImage;
    OpenDialog1: TOpenDialog;
    ValueListEditor1: TValueListEditor;
    HdrBtn: TSpeedButton;
    SmoothBtn: TSpeedButton;
    ClipBtn: TSpeedButton;
    procedure RescaleClear; //15za
    procedure RescaleInit; //15za
    function RescaleToBuffer(lIn:single):integer; //15za
    function RescaleFromBuffer(lIn:integer):integer; //15za
    procedure DisplayImage(lUpdateCon,lForceDraw: boolean;lSlice: integer;lInWinWid,lInWinCen: double);
    procedure ShowText (var lDynStr: string);
    function LoadData(lFileName : string; lAnalyze,lECAT,lRaw,lSilentErrors: boolean ) : Integer;
    procedure UpdateBtns;
    procedure UpdatePalette (lApply: boolean;lWid0ForSlope:integer);
    procedure RefreshZoom;
    procedure SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean);
    procedure Scale16to8bit(lWinCen,lWinWid: double);
    procedure DICOMImageRefreshAndSize;
    procedure DetermineZoom;
    procedure OverlayData;
    procedure ShowMagnifier (const X,Y:  INTEGER);
    procedure LoadFileList;
    Procedure LoadFiles;
    Procedure FreeBackupBitmap;
    procedure ReleaseDICOMmemory;
    procedure ColorScheme;
    function VxlVal(X,Y: integer; lRGB_greenOnly: boolean):integer;
    procedure ActiveFormCreate(Sender: TObject);
    procedure AboutBtnClick(Sender: TObject);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageDblClick(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ActiveFormDestroy(Sender: TObject);
    procedure OpenBtnClick(Sender: TObject);
    procedure NextBtnClick(Sender: TObject);
    procedure PreviousBtnClick(Sender: TObject);
    procedure MosaicBtnClick(Sender: TObject);
    procedure ColorDropChange(Sender: TObject);
    procedure ZoomDropChange(Sender: TObject);
    procedure ToolDropChange(Sender: TObject);
    procedure SmoothBtnClick(Sender: TObject);
    procedure HdrBtnClick(Sender: TObject);
    procedure ClipBtnClick(Sender: TObject);
  private
    { Private declarations }
        gSelectOrigin,gLastDown,gLastMousePos: tpoint;
    gDICOMnotBMP,gMouseDown,{gHdrOK,}gImgOK: boolean;
    gDicomData: DICOMdata;
    gIntenScaleInt,gIntenInterceptInt : integer;
     gIntRescale : boolean;
    gStartSlope,gStartCen,gXstart,gYstart,gWinMin,gWinMax,g100pctImageHt,
    g100pctImageWid,gFastSlope,gFastCen {,gViewSlice}: integer;
    gWinWid,gWinCen: double;
    BackupBitmap: TBitmap;
    gSelectRect,gMagRect,gLine: TRect;
    //gLineMsg: Str25;
    gBuff8,gBuff24: Bytep0;
    gOffsetList: array [1..kMaxEcat,kOffset..kWinWid] of longint;
    {gOffsetList,}gECATposra,gECATszra: array[1..kMaxECAT] of longint;
    gBuff16: SmallIntP0;
    gZoomPct,gBuff24sz,gBuff16sz,
    gBuff8sz,gCustomPalette,
    gSlice,gImgMin,gImgMax,gImgCen,
    gECATslices,gImgWid,gMultiRow,
    gMultiCol,gMultiFirst,gMultiLast,
    gPrevMultiRow,gPrevMultiCol,
    gPrevMultiFirst,
    gPrevMultiLast,gFileListSz,
    gTool,
    gColorScheme,gOverlayColor,
    gOffsetListSize,gCurrentPosInFileList: integer;
    gLineLenMM: double;
    gUseRecommendedContrast,gMultiLoad,gBestFitZoom,gAbort,gSmooth,gOverlay: boolean;
    gStringList : TStringList;
    gDynStr,gFileName,gFilePath: string;
    gRra,gGra,gBra: array [0..255] of byte;
    FEvents: IezDICOMXEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Active: WordBool; safecall;
    function Get_AlignDisabled: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_ScreenSnap: WordBool; safecall;
    function Get_SnapBuffer: Integer; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(var Value: IFontDisp); safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_ScreenSnap(Value: WordBool); safecall;
    procedure Set_SnapBuffer(Value: Integer); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    function Get_DCMbestFitZoom: WordBool; safecall;
    function Get_DCMcolorScheme: Integer; safecall;
    function Get_DCMfilenameOld: WideString; safecall;
    function Get_DCMfilename: WideString; safecall;
    function Get_DCMimageHt: Integer; safecall;
    function Get_DCMimageSlices: Integer; safecall;
    function Get_DCMimageWid: Integer; safecall;
    function Get_DCMintercept: Double; safecall;
    function Get_DCMlineMM: Double; safecall;
    function Get_DCMloadMultipleFiles: WordBool; safecall;
    function Get_DCMmmHt: Double; safecall;
    function Get_DCMmmSlices: Double; safecall;
    function Get_DCMmmWid: Double; safecall;
    function Get_DCMmosaicCols: Integer; safecall;
    function Get_DCMmosaicFirstSlice: Integer; safecall;
    function Get_DCMmosaicLastSlice: Integer; safecall;
    function Get_DCMmosaicRows: Integer; safecall;
    function Get_DCMoverlayColor: Integer; safecall;
    function Get_DCMoverlayOn: WordBool; safecall;
    function Get_DCMrecWinCenter: Integer; safecall;
    function Get_DCMrecWinWidth: Integer; safecall;
    function Get_DCMslice: Integer; safecall;
    function Get_DCMsliceMaxBright: Integer; safecall;
    function Get_DCMsliceMinBright: Integer; safecall;
    function Get_DCMslope: Double; safecall;
    function Get_DCMsmoothOn: WordBool; safecall;
    function Get_DCMtool: Integer; safecall;
    function Get_DCMtoolbar: WordBool; safecall;
    function Get_DCMuseRecommendedContrast: WordBool; safecall;
    function Get_DCMversionInfo: WideString; safecall;
    function Get_DCMwinCenter: Double; safecall;
    function Get_DCMwinWidth: Double; safecall;
    function Get_DCMzoomPct: Integer; safecall;
    procedure Set_DCMbestFitZoom(Value: WordBool); safecall;
    procedure Set_DCMcolorScheme(Value: Integer); safecall;
    procedure Set_DCMfilenameOld(const Value: WideString); safecall;
    procedure Set_DCMfilename(const Value: WideString); safecall;
    procedure Set_DCMloadMultipleFiles(Value: WordBool); safecall;
    procedure Set_DCMmosaicCols(Value: Integer); safecall;
    procedure Set_DCMmosaicFirstSlice(Value: Integer); safecall;
    procedure Set_DCMmosaicLastSlice(Value: Integer); safecall;
    procedure Set_DCMmosaicRows(Value: Integer); safecall;
    procedure Set_DCMmosaicX(Row, Col, FirstSlice, Value: Integer); safecall;
    procedure Set_DCMoverlayColor(Value: Integer); safecall;
    procedure Set_DCMoverlayOn(Value: WordBool); safecall;
    procedure Set_DCMsaveToFile(const Value: WideString); safecall;
    procedure Set_DCMslice(Value: Integer); safecall;
    procedure Set_DCMsmoothOn(Value: WordBool); safecall;
    procedure Set_DCMtool(Value: Integer); safecall;
    procedure Set_DCMtoolbar(Value: WordBool); safecall;
    procedure Set_DCMuseRecommendedContrast(Value: WordBool); safecall;
    procedure Set_DCMwinCenter(Value: Double); safecall;
    procedure Set_DCMwinWidth(Value: Double); safecall;
    procedure Set_DCMwriteHeader2Text(const DICOMinput,
      TEXToutput: WideString); safecall;
    procedure Set_DCMzoomPct(Value: Integer); safecall;
    function Get_DCMcopyImage2Clipboard: WordBool; safecall;
    function Get_DCMshowHeader: WordBool; safecall;
    procedure Set_DCMshowHeader(Value: WordBool); safecall;
    function Get_DCMcopyHeader2Clipboard: WordBool; safecall;
    procedure Set_DCMunloadImages(Value: Integer); safecall;
    function Get_DCMhorzScrollPosition: Integer; safecall;
    function Get_DCMopenBtnEnabled: WordBool; safecall;
    function Get_DCMvertScrollPosition: Integer; safecall;
    procedure Set_DCMopenBtnEnabled(Value: WordBool); safecall;
    function Get_DCMfilenameSilentErrors(const Filename: WideString): Integer;
      safecall;
    function Get_DCMwriteHeader2String(const DICOMinput: WideString): WideString;
      safecall;
  public
    { Public declarations }
    procedure Initialize; override;
  end;

implementation

uses ComObj, ComServ;

{$R *.DFM}

{ TezDICOMX }

procedure TezDICOMX.RescaleClear; //15za
//Allows intensity scaling of images  o = (i*s)+k
// o=output, i=input, s=slope, k=constant
//in DICOM:
// intensity scale = slope
// intensity intercept = constant
//CT images are usually present data in calibrated hounsfield units
//This equation allows 16-bit integer data to retain good precision
begin
     gIntenScaleInt := 1;
     gIntenInterceptInt := 0;
     gIntRescale := true;
end;

procedure TezDICOMX.RescaleInit; //15za
//see notes for RescaleClear
var lS,lI: single;
 lSi, lIi: integer;
begin
     RescaleClear;
     if gDICOMdata.IntenScale = 0 then
        gDICOMdata.IntenScale := 1;
     lS := gDICOMdata.IntenScale;
     lI := gDICOMdata.IntenIntercept;
     lSi := round(lS);
     lIi := round(lI);
     if (lS=lSi) and (lI=lIi) then begin
        gIntenScaleInt := lSi;
        gIntenInterceptInt := lIi;
        gIntRescale := true;
     end else
         gIntRescale := false;
end;

function TezDICOMX.RescaleFromBuffer(lIn:integer):integer; //15za
//see notes for rescaleClear
//RescaleFromBuffer takes the raw image intensity value and returns the equivalent hounsfield value
begin
     if gIntRescale then
        result := round((lIn*gIntenScaleInt)+ gIntenInterceptInt)
     else
          result := round((lIn*gDICOMdata.IntenScale)+ gDICOMdata.intenIntercept);

end;

function TezDICOMX.RescaleToBuffer(lIn:single):integer; //15za
//see notes for rescaleClear
//RescaleToBuffer inverts RescaleFromBuffer
//converts from Hounsfield value to value as presented in raw image
begin
     result := round((lIn- gDICOMdata.intenIntercept)/gDICOMdata.IntenScale);//ChayMarch2003
//     result := round((lIn/gDICOMdata.IntenScale)- gDICOMdata.intenIntercept);
end;

procedure TezDICOMX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
//standard activeX routines
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_DCMaxPage); }
end;

procedure TezDICOMX.EventSinkChanged(const EventSink: IUnknown);
//standard activeX routines
begin
  FEvents := EventSink as IezDICOMXEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure TezDICOMX.Initialize;
//standard activeX routines
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TezDICOMX.Get_Active: WordBool;
//standard activeX routines
begin
  Result := Active;