qdcmimage.pas

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

unit QDCMImage;
{
 ezDICOM medical viewer: CLX component
Copyright (c) 2002, Wolfgang Krug and Chris Rorden
All rights reserved.

Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

Redistributions of source code must retain the above copyright notice, this list
of conditions and the following disclaimer.

Redistributions in binary form must reproduce the above copyright notice, this
list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.

Neither the names of the copyright owners nor the names of this project (ezDICOM)
may be used to endorse or promote products derived from this software without
specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}

interface
{$IFDEF Linux}
uses
  dicom, analyze,lsjpeg,QDialogs, SysUtils, Classes, QControls,
  QStdCtrls, QExtCtrls, Types, Variants, QGraphics, QForms,
  QButtons, QComCtrls,QT{,QClipbrd},define_types,decompress;
{$ELSE}
uses
  Windows,dicom, analyze,lsjpeg,Dialogs,Messages, SysUtils, Classes, QControls,
  QStdCtrls, QExtCtrls, Types, Variants, QGraphics, QForms, QDialogs,
  QButtons, QComCtrls,QT{,QClipbrd},define_types,decompress;

{$ENDIF}

const
  PixelCountMax = 32768;
  kRadCon = pi/180;
  kMaxECAT = 512;
  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
  Str25 = String[25];
  TRGB32ra = array [word] of longword;
  pRGB32ra = ^TRGB32ra;
{  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple;
  LongIntRA = array [1..1] of LongInt;
  LongIntp = ^LongIntRA;}
  TDCMImage = class(TImage)
  private
    //Image1 : TScrollbox;
    gSelectOrigin,gLastDown,gLastMousePos: tpoint;
    gIntenScaleInt,gIntenInterceptInt: integer;
    gIntRescale : boolean;
    gDicomData: DICOMdata;
    gBackupBitmap: TBitmap;
    gSelectRect,gMagRect,gLine: TRect;
    gLineMsgPoint: TPoint;
    gLineMsg: Str25;
    gBuff8,gBuff24: Bytep0;
    gBuff16: SmallIntP0;
    gStartSlope,gStartCen,gXstart,gYstart,gWinMin,gWinMax,
    g100pctImageHt,g100pctImageWid,gFastSlope,gFastCen ,
    gZoomPct,gBuff24sz,gBuff16sz,gBuff8sz,gCustomPalette,gSlice,gImgMin,gImgMax,gImgCen,
    gECATslices,gImgWid,gMultiRow,gMultiCol,gMultiFirst,gMultiLast,gPrevMultiRow,
    gFileListSz,gTool,gPrevMultiCol,gPrevMultiFirst,gPrevMultiLast,
    gColorScheme,gOverlayColor,gOffsetListSize,gCurrentPosInFileList: integer;
    gLineLenMM,gWinWid,gWinCen: double;
    gDICOMnotBMP,gMouseDown,gImgOK,
    gloadmultiplefiles,gBestFitZoom,gUseRecommendedContrast,gAbort,gSmooth,gOverlay: boolean;
    gStringList : TStringList;
    gFileName,gFilePath: string;
    gOffsetList: array [1..kMaxEcat,kOffset..kWinWid] of longint;
    gECATposra,gECATszra: array[1..kMaxECAT] of longint;
    gRra,gGra,gBra: array [0..255] of byte;
    //procedure click; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure FreeBackupBitmap;
    procedure ReleaseDICOMmemory;
    procedure SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean);
    procedure DetermineZoom;
    procedure OverlayData;
    procedure LoadFileList;
    procedure LoadFiles;
    procedure DICOMImageRefreshAndSize;
    procedure Scale16to8bit(lWinCen,lWinWid: double);
    procedure RefreshZoom;
    procedure RescaleClear;
    procedure RescaleInit;
    function RescaleFromBuffer(lIn:integer):integer; //15za
    function RescaleToBuffer(lIn:single):integer; //15za
    procedure UpdatePalette (lApply: boolean;lWid0ForSlope:integer);
    procedure DisplayImage(lUpdateCon,lForceDraw: boolean;lSlice: integer; lInWinWid,lInWinCen: double);
    procedure ColorScheme;
    function LoadData(lFileName : string; lAnalyze,lECAT,lRaw: boolean ) : Boolean;
    function Get_DCMslice: Integer;
    procedure Set_DCMslice(Value: Integer);
    function Get_DCMzoomPct: Integer;
    procedure Set_DCMsmoothOn(Value: WordBool);
    procedure Set_DCMzoomPct(Value: Integer);
    function Get_DCMfilename: WideString;
    function Get_DCMwinCenter: Double;
    function Get_DCMwinWidth: Double;
    procedure Set_DCMfilename(const Value: WideString);
    function Get_DCMsmoothOn: WordBool;
    procedure Set_DCMwinCenter(Value: Double);
    procedure Set_DCMwinWidth(Value: Double);
    //function Get_DCMimageHt: Integer;
    //function Get_DCMimageWid: Integer;
    function Get_DCMoverlayOn: WordBool;
    procedure Set_DCMoverlayOn(Value: WordBool);
    procedure ShowMagnifier (CONST lX,lY:  INTEGER);
    function VxlVal (X,Y: integer; lRGB_greenOnly: boolean): integer;
    //function VxlVal (X,Y: integer): integer;
    function Get_DCMoverlayColor: Integer;
    procedure Set_DCMoverlayColor(Value: Integer);
    function Get_DCMcolorscheme: Integer;
    procedure Set_DCMcolorscheme(Value: Integer);
    function Get_DCMtool: Integer;
    procedure Set_DCMtool(Value: Integer);
    function Get_DCMbestFitZoom: WordBool;
    procedure Set_DCMbestFitZoom(Value: WordBool);
    function Get_DCMloadmultiplefiles: WordBool;
    procedure Set_DCMloadmultiplefiles(Value: WordBool);
    function Get_DCMuseRecommendedContrast: WordBool; safecall;
    procedure Set_DCMuseRecommendedContrast(Value: WordBool); safecall;

    { Private declarations }
  protected
      {	function WidgetFlags: Integer; override;
            { Protected declarations }
    { Protected declarations }
  public
    property DCMloadmultiplefiles : wordbool
        read Get_DCMloadmultiplefiles write Set_DCMloadmultiplefiles;
    property DCMuseRecommendedContrast : wordbool
        read Get_DCMuseRecommendedContrast write Set_DCMuseRecommendedContrast;

        constructor Create(AOwner:TComponent);override;
    function Get_DCMmosaic(Row: Integer): Integer;
    procedure Set_DCMmosaicX(Row, Col, FirstSlice, LastSlice: Integer);
    function Get_DCMmosaicCol: Integer;
    function Get_DCMmosaicRow: Integer;
    function Get_DCMmosaicFirstSlice: Integer;
    function Get_DCMmosaicLastSlice: Integer;
    function Get_DCMimageSlices: Integer;
    function Get_DCMintercept: Double;
    function Get_DCMmmHt: Double;
    function Get_DCMmmSlices: Double;
    function Get_DCMmmWid: Double;
    function Get_DCMrecWinCenter: Integer;
    function Get_DCMrecWinWidth: Integer;
    function Get_DCMsliceMaxBright: Integer;
    function Get_DCMsliceMinBright: Integer;
    function Get_DCMslope: Double;
    procedure ImageDblClick(Sender: TObject);
    procedure Set_DCMwriteHeader2Text(const DICOMinput,TEXToutput: WideString);
    function Get_DCMversionInfo: WideString;
    function Get_DCMlineMM: Double;
    procedure Set_DCMsavetofile(lFilename: WideString);
    //procedure Set_DCMcopytoClipboard;

    { Public declarations }
  published
    property DCMbestfitzoom : wordbool
        read Get_DCMbestFitZoom write Set_DCMbestFitZoom;
    property DCMcolorScheme : integer
        read Get_DCMcolorscheme write Set_DCMcolorscheme;
    property DCMfilename : widestring
        read Get_DCMfilename write Set_DCMfilename;
    property DCMoverlayColor : integer
        read Get_DCMoverlayColor write Set_DCMoverlayColor;
    property DCMOverlayOn : wordbool
        read Get_DCMoverlayOn write Set_DCMoverlayOn;
    property DCMslice : integer
        read Get_DCMslice write Set_DCMslice;
    property DCMsmoothOn : wordbool
        read Get_DCMsmoothOn write Set_DCMsmoothOn;
    property DCMtool : integer
        read Get_DCMtool write Set_DCMtool;
    property DCMwinCenter : double
        read Get_DCMwinCenter write Set_DCMwinCenter;
    property DCMwinWidth : double
        read Get_DCMwinWidth write Set_DCMwinWidth;
    property DCMzoomPct : integer
        read Get_DCMzoomPct write Set_DCMzoomPct;
    { Published declarations }
  end;

procedure Register;

implementation

procedure TDCMimage.RescaleClear; //15za
begin
     gIntenScaleInt := 1;
     gIntenInterceptInt := 0;
     gIntRescale := true;
end;

procedure TDCMimage.RescaleInit; //15za
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 TDCMimage.RescaleFromBuffer(lIn:integer):integer; //15za
begin
     if gIntRescale then
        result := round((lIn*gIntenScaleInt)+ gIntenInterceptInt)
     else
          result := round((lIn*gDICOMdata.IntenScale)+ gDICOMdata.intenIntercept);

end;

function TDCMimage.RescaleToBuffer(lIn:single):integer; //15za
begin
     result := round((lIn/gDICOMdata.IntenScale)- gDICOMdata.intenIntercept);
end;


procedure Register;
begin
  RegisterComponents('Standard', [TDCMImage]);
end;
(*procedure TDCMimage.click;
begin
  inherited Click;
  self.Caption := inttostr(random(888));
end;*)

constructor TDCMimage.Create(AOwner:TCOmponent);
begin
    inherited Create(AOwner);
    (*Image1 := TImage.Create(self);
    Self.Parent := self;
    Self.Top := 1;
    Self.Left := 1;
    Self.Show; *)
    Self.Width := 100;
    Self.Height := 100;
    Self.Stretch := true;
    Self.Autosize := false;
    Self.Center := false;
    gTool:= 1;
    gLineLenMM:= 0.0;
    gBestFitZoom := false;
    gUseRecommendedContrast := true;
    gloadmultiplefiles := true;
    gColorScheme := 1;
    gOverlay:= {false}true;
    gOverlayColor:= 0;
    gSmooth := false;
    gAbort := false;
    gCurrentPosInFileList := -1;
    gOffsetListSize := 0;
    gZoomPct:= 100;
    gBuff24sz := 0;
    gBuff16sz := 0;
    gBuff8sz := 0;
    gCustomPalette:= 0;
    gSlice := 0;
    gImgMin := 0;
    gImgMax:= 0;
    gImgCen := 0;
    gECATslices := 0;
    gImgWid := 0;
    gMultiRow:= 1;
    gMultiCol := 1;
    gMultiFirst := 1;
    gMultiLast := 1;
    gPrevMultiRow:= 1;
    gPrevMultiCol := 1;
    gPrevMultiFirst := 1;
    gPrevMultiLast := 1;
    gFileListSz := 0;
    gBackupbitmap := nil;
    decimalseparator := '.';
    gStringList := TStringList.Create;
end;


(*function TDCMimage.WidgetFlags: Integer;
begin
        // To reduce flickering on LINUX
        Result := Inherited WidgetFlags or
                Integer(WidgetFlags_WRepaintNoErase) or Integer(WidgetFlags_WResizeNoErase);
end; (* *)

(*procedure TDCMimage.DCMName (Filename:String);
begin
Self.Picture.LoadFromFile(Filename);
Showmessage('x');
end;*)

procedure TDCMimage.FreeBackupBitmap;
begin
     if gBackupBItmap <> nil then begin
        gBackupbitmap.free;
        gBackupbitmap := nil;
     end;
     gMagRect := Rect(0,0,0,0);
end;


(*procedure TDCMimage.Set_DCMCopytoClipboard;
var
  MyFormat : Word;
  AData,APalette : THandle;
begin
  Self.Picture.Bitmap.S
  //TImage(Self).Picture.Bitmap.SaveToClipBoardFormat(MyFormat, AData, APalette);
  ClipBoard.SetAsHandle(MyFormat, AData);

{begin
     Clipboard.Assign(Self.Picture);
     xxx }
end;   *)
procedure TDCMimage.Set_DCMsavetofile(lFilename: WideString);
var