ezdicomimpl1.pas

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

end;

function TezDICOMX.Get_AlignDisabled: WordBool;
//standard activeX routines
begin
  Result := AlignDisabled;
end;

function TezDICOMX.Get_AutoScroll: WordBool;
//standard activeX routines
begin
  Result := AutoScroll;
end;

function TezDICOMX.Get_AutoSize: WordBool;
//standard activeX routines
begin
  Result := AutoSize;
end;

function TezDICOMX.Get_AxBorderStyle: TxActiveFormBorderStyle;
//standard activeX routines
begin
  Result := Ord(AxBorderStyle);
end;

function TezDICOMX.Get_Caption: WideString;
//standard activeX routines
begin
  Result := WideString(Caption);
end;

function TezDICOMX.Get_Color: OLE_COLOR;
//standard activeX routines
begin
  Result := OLE_COLOR(Color);
end;

function TezDICOMX.Get_DoubleBuffered: WordBool;
//standard activeX routines
begin
  Result := DoubleBuffered;
end;

function TezDICOMX.Get_DropTarget: WordBool;
//standard activeX routines
begin
  Result := DropTarget;
end;

function TezDICOMX.Get_Enabled: WordBool;
//standard activeX routines
begin
  Result := Enabled;
end;

function TezDICOMX.Get_Font: IFontDisp;
//standard activeX routines
begin
  GetOleFont(Font, Result);
end;

function TezDICOMX.Get_HelpFile: WideString;
//standard activeX routines
begin
  Result := WideString(HelpFile);
end;

function TezDICOMX.Get_KeyPreview: WordBool;
//standard activeX routines
begin
  Result := KeyPreview;
end;

function TezDICOMX.Get_PixelsPerInch: Integer;
//standard activeX routines
begin
  Result := PixelsPerInch;
end;

function TezDICOMX.Get_PrintScale: TxPrintScale;
//standard activeX routines
begin
  Result := Ord(PrintScale);
end;

function TezDICOMX.Get_Scaled: WordBool;
//standard activeX routines
begin
  Result := Scaled;
end;

function TezDICOMX.Get_Visible: WordBool;
//standard activeX routines
begin
  Result := Visible;
end;

function TezDICOMX.Get_VisibleDockClientCount: Integer;
//standard activeX routines
begin
  Result := VisibleDockClientCount;
end;

procedure TezDICOMX._Set_Font(var Value: IFontDisp);
//standard activeX routines
begin
  SetOleFont(Font, Value);
end;

procedure TezDICOMX.ActivateEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure TezDICOMX.ClickEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TezDICOMX.CreateEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TezDICOMX.DblClickEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TezDICOMX.DeactivateEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TezDICOMX.DestroyEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TezDICOMX.KeyPressEvent(Sender: TObject; var Key: Char);
//standard activeX routines
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TezDICOMX.PaintEvent(Sender: TObject);
//standard activeX routines
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure TezDICOMX.Set_AutoScroll(Value: WordBool);
//standard activeX routines
begin
  AutoScroll := Value;
end;

procedure TezDICOMX.Set_AutoSize(Value: WordBool);
//standard activeX routines
begin
  AutoSize := Value;
end;

procedure TezDICOMX.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
//standard activeX routines
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TezDICOMX.Set_Caption(const Value: WideString);
//standard activeX routines
begin
  Caption := TCaption(Value);
end;

procedure TezDICOMX.Set_Color(Value: OLE_COLOR);
//standard activeX routines
begin
  Color := TColor(Value);
end;

procedure TezDICOMX.Set_DoubleBuffered(Value: WordBool);
//standard activeX routines
begin
  DoubleBuffered := Value;
end;

procedure TezDICOMX.Set_DropTarget(Value: WordBool);
//standard activeX routines
begin
  DropTarget := Value;
end;

procedure TezDICOMX.Set_Enabled(Value: WordBool);
//standard activeX routines
begin
  Enabled := Value;
end;

procedure TezDICOMX.Set_Font(const Value: IFontDisp);
//standard activeX routines
begin
  SetOleFont(Font, Value);
end;

procedure TezDICOMX.Set_HelpFile(const Value: WideString);
//standard activeX routines
begin
  HelpFile := String(Value);
end;

(*procedure TezDICOMX.Set_HelpKeyword(const Value: WideString);
//standard activeX routines
begin
  HelpKeyword := String(Value);
end;

procedure TezDICOMX.Set_HelpType(Value: TxHelpType);
//standard activeX routines
begin
  HelpType := THelpType(Value);
end;*)

procedure TezDICOMX.Set_KeyPreview(Value: WordBool);
//standard activeX routines
begin
  KeyPreview := Value;
end;

procedure TezDICOMX.Set_PixelsPerInch(Value: Integer);
//standard activeX routines
begin
  PixelsPerInch := Value;
end;

procedure TezDICOMX.Set_PrintScale(Value: TxPrintScale);
//standard activeX routines
begin
  PrintScale := TPrintScale(Value);
end;

procedure TezDICOMX.Set_Scaled(Value: WordBool);
//standard activeX routines
begin
  Scaled := Value;
end;

procedure TezDICOMX.Set_Visible(Value: WordBool);
//standard activeX routines
begin
  Visible := Value;
end;

procedure TezDICOMX.FreeBackupBitmap;
//standard activeX routines
begin
     if BackupBItmap <> nil then begin
        Backupbitmap.free;
        Backupbitmap := nil;
     end;
     gMagRect := Rect(0,0,0,0);
end;

procedure   TezDICOMX.ReleaseDICOMmemory;
//This flushes the image buffers. It reduces RAM uses, and releases dynamically assigned memory
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;

//NOTE: Procedure SetDimension is a low level API call. This is a bizarre procedure to understand.
//Hopefully you will never have to change this code
//The nested procedure 'ScaleStretch' computes a bilinear-interpolation image to make a smooth
//[not jaggy] version of the image in any scale.
//HOWEVER: Bilinear interpolation is simple but slow when computed as floats.
//Here an INTEGER bilinear interpolation is used: it is fast but not intuitive code

procedure TezDICOMX.SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean);
//creates a bitmap of Heigth*Width InPGHt*InPGWid with a bit-depth of InBits
//The uncompressed array of this data is stored in InBuff
//UseWinCenWid: this is only used for 8-bit images.
//  If set to true, values clipped:
//     -values less than (gWinCen-(gWinWid/2)) are set to the minimum colour, red/green blue= gRra[0]/gGra[0]/gBra[0]
//     -values greater than (gWinCen+(gWinWid/2)) are set to the maximum colour, red/green blue= gRra[255]/gGra[255]/gBra[255]
//  If set to false, values are not clipped
//     -value of i gets  red/green blue= gRra[i]/gGra[i]/gBra[i]
var

  lBuff: ByteP0;
  lPGwid,lPGHt,lBits: integer;
procedure ScaleStretch(lSrcHt,lSrcWid: integer; lInXYRatio: single); //NOTE: NESTED in SETDIMENSION
{nested procedure of SetDimension - this is the most complicated procedure, but probably does not need to be changed!
this stretches an image to a new size using bilinear interpolation.
Parameters: Bitmap Heigth*Width: SrcHt*SrcWid; Zoom ratio InXYratio
e.g. a source image of SrcHt*SrcWid of 128*128 with a InXYratio of 2 will create output with a Ht*Wid 256*256
there are three types of images:
  1.) 24bit images will have 24bit output
  2.) 8bit indexed images will have 24bit output (e.g. mean RGB value of intensity values 1+2+4+5 does not necessarily equal RGB of 3)
  3.) 8bit continuous images will have 8bit output (e.g. mean intensity of values 1+2+4+5 DOES equal 3)
Note: this uses integer math instead of float math for speed.
 Multples of values are used for precision: this explains the 'shr' values{}
var
  lKScale: integer;
  lrRA,lbRA,lgRA: array [0..255] of byte;
  lPos,xP,yP,yP2,xP2,t,z, z2,iz2,w1,w2,w3,w4,lTopPos,lBotPos,