?? unit1.pas
字號:
Unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
Memo1: TMemo;
Image: TImage;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
Buff : PChar;
width : Integer;
height : Integer;
{ Public declarations }
procedure DisplayImage;
end;
(***********************************************************)
type
int32 = LongInt;
uint32 = Cardinal;
int16 = SmallInt;
uint16 = Word;
int8 = ShortInt;
uint8 = Byte;
function read16( var fp : File ): uint16;
function read32 ( var fp : File ): uint32;
procedure read_dicom_data( var buff : PChar; var width:Integer;
var height:Integer; var fp:File );
procedure flip_16bit_data ( var buff : PChar; width : Integer; height:Integer);
procedure scale16to8( var buff : PChar; width : Integer; height:Integer);
var
little_endian : Integer = 1; //1 for pre-swapped
bytes_per_pixel : Integer = 1;
scale_flag : Integer = 0; //scale 16 bits to 8
flip_flag : Integer = 0; //flip 16 bit data values
no_flip_flag : Integer = 0; //no flip no matter what!
invert_flag : Integer = 0; //invert data values
infp : File; //DICOM file
textfp : Text; //text file containing DICOM header info
var
Form1: TForm1;
implementation
{$R *.DFM}
(***********************************************************)
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
// open the input DICOM file
AssignFile(infp, OpenDialog1.FileName);
Reset(infp, 1);
// open the DICOM text file
AssignFile(textfp, 'text.txt');
Rewrite(textfp);
read_dicom_data(buff, width, height, infp);
if CheckBox1.Checked then
begin
flip_flag := 1;
flip_16bit_data ( buff, width, height);
end;
scale16to8( buff, width, height );
CloseFile(infp);
CloseFile(textfp);
Memo1.Lines.LoadFromFile('text.txt');
// Display Image
DisplayImage;
end;
end;
procedure TForm1.DisplayImage;
var
I : Integer;
hBmp : HBITMAP;
BI : PBitmapInfo;
BIH : TBitmapInfoHeader;
Bmp : TBitmap;
TmpDC : hDC;
ImagoDC : hDC;
begin
// Fill BitmapInfoHeader structure
BIH.biSize := Sizeof(BIH);
BIH.biWidth := width;
BIH.biHeight := -height;
BIH.biPlanes := 1;
BIH.biBitCount := 8;
BIH.biCompression := BI_RGB;
BIH.biSizeImage := 0;
BIH.biXPelsPerMeter := 0;
BIH.biYPelsPerMeter := 0;
BIH.biClrUsed := 0;
BIH.biClrImportant := 0;
{$P+,S-,W-,R-}
// Create DIB Bitmap Info with actual color table
BI := AllocMem(SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
try
BI^.bmiHeader := BIH;
for I:=0 to 255 do begin
BI^.bmiColors[I].rgbBlue := Byte( I );
BI^.bmiColors[I].rgbGreen := Byte( I );
BI^.bmiColors[I].rgbRed := Byte( I );
BI^.bmiColors[I].rgbReserved := 0;
end;
Bmp := TBitmap.Create;
Bmp.Height := width;
Bmp.Width := height;
ImagoDC := GetDC(Form1.Handle);
hBmp := CreateDIBitmap(
ImagoDC, // handle of device context
BIH, // address of bitmap size and format data
CBM_INIT, // initialization flag
buff, // address of initialization data
BI^, // address of bitmap color-format data
DIB_RGB_COLORS ); // color-data usage
Bmp.Handle := hBmp;
// Draw bitmap proportional into the given Image
// Image.Canvas.Brush.Color := clRED;
// Image.Canvas.FillRect(Image.BoundsRect);
// Image.Canvas.StretchDraw(ImgRect, Bmp);
Image.Picture.Bitmap.Assign( Bmp );
Image.Refresh;
Bmp.Free;
except
// showmessage(MainForm.MultiLanguage1.GetMsg('XOutOfMemory'));
exit;
end;
FreeMem( BI, SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
{$P-,S+,W+,R+}
end;
(***********************************************************)
function read16( var fp : File ): uint16;
var
t1, t2 : uint8;
n : Integer;
begin
BlockRead(fp, t1, SizeOf(uint8), n);
BlockRead(fp, t2, SizeOf(uint8), n);
if little_endian <> 0
then Result := (t1 + t2*256) AND $FFFF
else Result := (t1*256 + t2) AND $FFFF;
end;
(***********************************************************)
function read32 ( var fp : File ): uint32;
var
t1, t2, t3, t4 : uint8;
n : Integer;
begin
BlockRead(fp, t1, SizeOf(uint8), n);
BlockRead(fp, t2, SizeOf(uint8), n);
BlockRead(fp, t3, SizeOf(uint8), n);
BlockRead(fp, t4, SizeOf(uint8), n);
if little_endian <> 0
then Result := (t1 + t2*256 + t3*256*256 + t4*256*256*256) AND $FFFFFFFF
else Result := (t1*256*256*256 + t2*256*256 + t3*256 + t4) AND $FFFFFFFF;
end;
(***********************************************************)
procedure read_dicom_data( var buff : PChar; var width:Integer;
var height:Integer; var fp:File );
type
dicom_types = (unknown, i8, i16, i32, ui8, ui16, ui32, _string );
var
first_one : Boolean;
time_to_quit : Boolean;
group, element, dummy, e_len, remaining, tmp : uint32;
info : string;
t : dicom_types;
where : LongInt;
tx : array [0..3] of Char;
n, i : Integer;
begin
info := '';
t := unknown;
// try DICOM part 10 i.e. a 128 byte file preamble followed by "DICM"
seek(fp, 0);
where := FilePos(fp);
BlockRead(fp, tx, 4*SizeOf(Char), n);
if (tx[0] <> 'D') OR (tx[1] <> 'I') OR (tx[2] <> 'C') OR (tx[3] <> 'M') then
begin
seek(fp, 128); //skip the preamble - next 4 bytes should be 'DICM'
where := FilePos(fp);
BlockRead(fp, tx, 4*SizeOf(Char), n);
if (tx[0] <> 'D') OR (tx[1] <> 'I') OR (tx[2] <> 'C') OR (tx[3] <> 'M') then
begin
// showmessage('not a proper DICOM file');
// try DICOM without header
seek(fp, 0);
group := read16(fp);
element := read16(fp);
if NOT (group in [$0000, $0002, $0004, $0008]) then
exit;
seek(fp, 0);
end;
end;
// Read DICOM Tags
time_to_quit := FALSE;
while NOT time_to_quit do
begin
where := FilePos(fp);
group := read16(fp);
element := read16(fp);
if group = $0002 then
begin
dummy := read16(fp);
e_len := read16(fp);
if element = $0001 then
begin
dummy := read32(fp);
dummy := read16(fp);
e_len := 0;
end;
end
else e_len := read32(fp);
remaining := e_len;
info := 'unknown';
case group of
$0002 :
case element of
$00 : info := 'file meta elements group len';
$01 : info := 'file meta info version';
$02 : info := 'media storage SOP class uid';
$03 : info := 'media storage SOP inst uid';
$10 : info := 'transfer syntax uid';
$12 : info := 'implementation class uid';
$13 : info := 'implementation version name';
$16 : info := 'source app entity title';
$100: info := 'private info creator uid';
$102: info := 'private info';
end;
$0008 :
case element of
$00 : info := 'identifying group';
$01 : info := 'length to end';
$08 : info := 'image type';
$10 : info := 'recognition code';
$16 : info := 'SOP Class UID';
$18 : info := 'SOP Instance UID';
$20 : info := 'study date';
$21 : info := 'series date';
$22 : info := 'acquisition date';
$23 : info := 'image date';
$30 : info := 'study time';
$31 : info := 'series time';
$32 : info := 'acquisition time';
$33 : info := 'image time';
$40 : info := 'data set type';
$41 : info := 'data set subtype';
$50 : info := 'accession number';
$60 : begin info := 'modality'; t := _string; end;
$70 : info := 'manufacturer';
$80 : info := 'institution name';
$90 : info := 'referring physician''s name';
$1010: info := 'station name';
$103e: info := 'series description';
$1030: info := 'study description';
$1040: info := 'institutional dept. name';
$1060: info := 'name phys(s) read stdy';
$1070: begin info := 'operator''s name'; t := _string; end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -