⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 childwin.pas

📁 用Delphi做的读取医学图片的控件及代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
end;


function TMDIChild.LoadData(lFileName : string; lAnalyze,lECAT,l2dImage,lRaw: boolean ) : Boolean;
//Loads and displays a medical image, also searches for other DICOM images in the same folder as the image you have opened
//  This latter feature allows the user to quickly cycle between successive images
var
     lHdrOK: boolean;
     lAllocSLiceSz,lS: integer;
     lExt : string;
     JPG:  TJPEGImage;
     Stream: TmemoryStream;
     BMP: TBitmap;
     lImage: TImage;
begin
  ReleaseDICOMmemory;
  RescaleClear;
  gFilePath := extractfilepath(lFileName);
  FDICOM := true;
  gScheme := 1;
  gSlice := 1;
  LoadColorScheme('',gScheme); //load Black and white
  Result := TRUE;
  gImgOK := false;
  FFileName := lFileName;
  gAbort:= true;
  if not fileexists(lFilename) then begin
     result := false;
     showmessage('Unable to find the file: '+lFilename);
     exit;
  end;
     Self.caption := extractfilename(lFilename);
     lExt := UpperCase(ExtractFileExt(FFileName));
     if (l2DImage) or ('.JPG'= lExt) or ('.JPEG'= lExt) or('.BMP'= lExt) then begin
        FDICOM := false;
        if ('.JPG'= lExt) or ('.JPEG'= lExt) then begin
           {JPEGOriginal := TJPEGImage.Create;
           TRY
              JPEGOriginal.LoadFromFile(FFilename);
              Image.Picture.Graphic := JPEGOriginal
           FINALLY
               JPEGOriginal.Free
           END;}
           //the following longer method makes sure the user can save the JPEG file...
           {Stream := TMemoryStream.Create;
           try
              Stream.LoadFromFile(FFilename);
              Stream.Seek(0, soFromBeginning);
              Jpg := TJPEGImage.Create;
              try
                 Jpg.LoadFromStream(Stream);
                 BMP := TBitmap.create;
                 try
                    BMP.Height := JPG.Height;
                    BMP.Width := JPG.Width;
                    BMP.PixelFormat := pf24bit;
                    BMP.Canvas.Draw(0,0, JPG);
                    Image.Picture.Graphic := BMP;
                 finally
                        BMP.Free;
                 end;
              finally
                     JPG.Free;
              end;
           finally
                  Stream.Free;
           end;{}
//next bit allows contrast adjustable JPEG images....
           Stream := TMemoryStream.Create;
           try
              Stream.LoadFromFile(FFilename);
              Stream.Seek(0, soFromBeginning);
              Jpg := TJPEGImage.Create;
              try
                 Jpg.LoadFromStream(Stream);
        gDICOMData.XYZdim[1] :=JPG.Width;
        gDICOMData.XYZdim[2] := JPG.Height;
        Image.Width :=  JPG.Width;
        Image.Height :=  JPG.Height;

{                 BMP := TBitmap.create;
                 try
                    BMP.Height := JPG.Height;
                    BMP.Width := JPG.Width;
                    BMP.PixelFormat := pf24bit;
                    BMP.Canvas.Draw(0,0, JPG);
                    Image.Picture.Graphic := BMP;
                 finally
                        BMP.Free;
                 end;}
              finally
                     JPG.Free;
              end;
           finally
                  Stream.Free;
           end;


        gDICOMData.SamplesPerPixel := 3;
        gDICOMData.Storedbits_per_pixel := 8;
        gDICOMData.Allocbits_per_pixel := 8;
        gDICOMData.ImageStart := 0;
        g100PctImageWid := gDICOMData.XYZdim[1];
        g100PctImageHt := gDICOMData.XYZdim[2];
        gDICOMData.XYZdim[3] := 1;
        gECATposra[1] := 0;
        //CloseFile(infp); //we will read this file directly
        lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2]); //24bits per pixel: number of voxels in each colour plane
        gBuff24Sz := lAllocSliceSz*3;
        GetMem( gBuff24, lAllocSliceSz*3);
        decompressJPEG24 (FFilename,gBuff24,lAllocSliceSz,gECATposra[1],Image);
        MainForm.ColUpdate;
                 DetermineZoom;
         SetDimension(gDIcomData.XYZdim[2],gDIcomData.XYZdim[1] ,24, gBuff24,false);
         DICOMImageRefreshAndSize;
         Image.Refresh;
        FDICOM := true;
  gImgMin := 0;
  gImgMax := 255;
  gWinMin := 0;
  gWinMax := 255;


        {}
        //?? what if gDICOMdata.monochrome = 4 -> is YcBcR photometric interpretation dealt with by the JPEG comrpession or not? I have never seen such an image, so I guess this is an impossible combination
        //Reset(infp, 1); //other routines expect this to be left open


        end else
            Image.Picture.Bitmap.LoadFromFile(FFilename);
        //if Image.Picture.Bitmap.PixelFormat = pf8 then
        gDICOMData.SamplesPerPixel := 3;
        gDICOMData.Storedbits_per_pixel := 8;
        gDICOMData.Allocbits_per_pixel := 8;
        gDICOMData.ImageStart := 54;
        gDICOMData.XYZdim[1] := Image.Picture.Width;
        gDICOMData.XYZdim[2] := Image.Picture.Height;
        g100PctImageWid := gDICOMData.XYZdim[1];
        g100PctImageHt := gDICOMData.XYZdim[2];
        Image.Width :=  Image.Picture.Width;
        Image.Height :=  Image.Picture.Height;
        gDICOMData.XYZdim[3] := 1;
        if self.WindowState <> wsMaximized then begin
           self.ClientHeight:=gDICOMdata.XYZdim[2];
           self.ClientWidth:= (gDICOMData.XYZdim[1]);
        end;
        MainForm.ColUpdate;
        ContrastAutobalance1.enabled := false;
        OptionsImgInfoItem.enabled := false;
        gImgOK := true;
        automaximise;
        Image.Refresh;
        exit;
     end;
     FDICOM := true;
     if lRaw then begin
         lHdrOK := true;
         gImgOK := true;
     end else if lAnalyze then
         OpenAnalyze (lHdrOK,gImgOK,gDynStr,FFileName, gDicomData)
     else if lECAT then
         read_ecat_data(gDICOMdata,true{verbose},true{offset tables supported},lHdrOK,gImgOK,gDynStr,FFileName)
     else
      read_dicom_data(true,true,true,true,true,true,true, gDICOMdata, lHdrOK, gImgOK, gDynStr,FFileName );
     rescaleInit;

     if gDICOMdata.ElscintCompress then begin
         showmessage('Unable to descode Elscint compressed images.');
         gImgOK := false;
     end;
     if (lHdrOK) and (gImgOK) and (not fileexists(FFileName)) then begin
        MainForm.OpenDialog.Title := 'Select Interfile image file...';
            if MainForm.OpenDialog.Execute and Fileexists (MainForm.OpenDialog.Filename)  then
               FFilename := MainForm.OpenDialog.Filename
            else
                gImgOK := false;
        MainForm.OpenDialog.Title := 'Open';
     end; //1.33
     HdrShow;
     if gECATJPEG_table_entries > 0 then begin
         //showmessage('ecatabba'+inttostr(gDICOMdata.CompressOffset));
         //gDicomData.ImageStart := gECATJPEG_pos_table[1];
         {if (gECATJPEG_table_entries = 1) then begin
                 gECATposra[1]:=gDICOMdata.CompressOffset;
                 gECATszra[1]:=gDICOMdata.CompressSz;
         end else}  if (gECATJPEG_table_entries > kMaxECAT) then begin
            gImgOK := false;
            Showmessage('This ECAT file has too many slices ('+inttostr(gECATJPEG_table_entries)+').');
         end else begin
             gECATslices:= gECATJPEG_table_entries;
             for lS := 1 to gECATslices do begin
                 //gECATslices
                 //showmessage(inttostr(lS)+'@abba'+inttostr(gECATJPEG_pos_table[lS]));
                 gECATposra[lS]:=gECATJPEG_pos_table[lS];
                 gECATszra[lS]:=gECATJPEG_size_table[lS];
             end;
         end;
         freemem(gECATJPEG_pos_table);
         freemem(gECATJPEG_size_table);
         gECATJPEG_table_entries := 0;
      end;
  gBlack := 1;
  gScale := 1;
  gPro := 0;
  gCustomPalette := 0;
  if red_table_size > 0 then begin
     //gCustomPalette := 0;
  end else begin
      if gDICOMdata.monochrome = 1 then
         gScheme := 0
      else
          gScheme := 1;
  LoadColorScheme('',gScheme); //load Black and white
end;
  gWinCen := 0;
  gWinWid := 0;
  if (gDICOMdata.XYZdim[2] < 1) or (gDICOMdata.XYZdim[1] < 1) or (not lHdrOK) or (not gImgOK) then begin
     showmessage('LoadData: Error reading image.');
     ReleaseDICOMmemory;
     OptionsImgInfoItemClick(nil);
     exit;
  end;
  LowerSlice1.enabled := gDicomdata.XYZdim[3] > 1;
  HigherSlice1.enabled := gDicomdata.XYZdim[3] > 1;
  Mosaic1.enabled := gDicomdata.XYZdim[3] > 1;
  if self.WindowState <> wsMaximized then begin
      self.ClientHeight:=gDICOMdata.XYZdim[2];
      self.ClientWidth:= (gDICOMData.XYZdim[1]);
  end;
  if (gDICOMdata.RLERedSz > 0) or (gDICOMdata.SamplesPerPixel > 1) or (gCustomPalette > 0) then begin
     gDICOMdata.WindowCenter := 127;
     gDICOMdata.WindowWidth := 255;
     gImgMin := 0;
     gImgMax := 255;
     gWinCen := gDICOMdata.WindowCenter;
     gWinWid := 0;//gDICOMdata.WindowWidth;
     gFastCen := 128;
     gFastSlope := 128;
  end;
  gAbort := false;
  Overlay1.enabled := true;
  gSlice := 0; {force a new image to be displayed - so gSlice should be different from displayimage requested slice}
  DisplayImage(True,True,1,-1,0);
  Screen.Cursor := crDefault;
  if Self.Active then
        MainForm.ColUpdate;
    MainForm.StatusBar.Panels[5].text := 'id:s:a:i '+inttostr(gDicomData.PatientIDInt)+':'+inttostr(gDicomData.SeriesNum)+':'+inttostr(gDicomData.AcquNum)+':'+inttostr(gDicomData.ImageNum);

end;

procedure TMDIChild.FileOpenItemClick(Sender: TObject);
//File menu, OPEN
begin
	MainForm.FileOpenItemClick(Sender);
end;

procedure TMDIChild.FileExitItemClick(Sender: TObject);
begin
	MainForm.FileExitItemClick(Sender);
end;

procedure TMDIChild.HdrShow;
var lLen,lI : integer;
lStr: string;
begin
  if not FDICOM then begin
     //showmessage('Unable to show DICOM header information. This is not a DICOM file.');
     EXIT;
  end;
  Memo1.Lines.Clear;
  //Memo1.lines.add(inttostr(gDicomData.ImageStart));
  lLen := Length (gDynStr);
  if lLen > 0 then begin
       lStr := '';
       for lI := 1 to lLen do begin
           if gDynStr[lI] <> kCR then
              lStr := lStr + gDynStr[lI]
           else begin
                Memo1.Lines.add(lStr);
                lStr := '';
           end;
       end;
       Memo1.Lines.Add(lStr);
  end; //lLen > 0
end;

procedure TMDIChild.OptionsImgInfoItemClick(Sender: TObject);
begin
     MainForm.HdrBtn.Down := not  MainForm.HdrBtn.Down;
     MainForm.HdrBtn.Click;
end;
        (*
procedure TMDIChild.decompressJPEG24x (lFilename: string; var lOutputBuff: ByteP0; lImageVoxels,lImageStart{gECATposra[lSlice]}: integer);
var
   Stream: Tmemorystream;
   Jpg: TJPEGImage;

   TmpBmp: TPicture;
   lImage: Timage;
   lRow:  pRGBTripleArray;
   lHt0,lWid0,lInc,i,j: integer;
begin
  try
      Stream := TMemoryStream.Create;
      Stream.LoadFromFile(lFilename);
      Stream.Seek(lImageStart, soFromBeginning);
      try
        Jpg := TJPEGImage.Create;
        Jpg.LoadFromStream(Stream);
        //lImage.Create(Image);


        Image.Height := JPG.Height;
        Image.Width := JPG.Width;



        //Image.Picture.Graphic:=JPG;
        //Image.Picture.Assign(jpg);
        Image.Picture.Bitmap.Assign(jpg);
        {Image.Picture.Bitmap.Height := JPG.Height;
        Image.Picture.Bitmap.Width := JPG.Width;
        Image.Picture.Bitmap.PixelFormat := pf24bit;
             {}
        //lImageVoxels = (JPG.Height*JPG.Width);
        lWid0 := JPG.Width-1;
        lHt0 := JPG.Height-1;
        lInc := (3*lImageVoxels)-1; //*3 because 24-bit, -1 since index is from 0
        //showmessage(inttostr(lWid0)+'@'+inttostr(lHt0));
        FOR j := lHt0-1 DOWNTO 0 DO BEGIN
                          lRow := Image.Picture.Bitmap.ScanLine[j];
                          //lRow := TmpImage.Picture.Bitmap.Scanline[j];
                          FOR i := lWid0 downto 0 DO BEGIN
                              lOutputBuff[lInc] := (lRow[i].rgbtBlue) and 255;//lRow[i].rgbtRed;
                              lOutputBuff[lInc-1] := (lRow[i].rgbtGreen) and 255;//lRow[i].rgbtRed;
                              lOutputBuff[lInc-2] := (lRow[i].rgbtRed) and 255;//lRow[i].rgbtRed;
                              dec(lInc,3);
                          END; //for i.. each column
        END; //for j...each row
        {}
        //lImage.Free;
        //TmpBmp.Create;
        //TmpBmp.Graphic := Jpg;
        //TmpBmp.Free;
      finally //try..finally
        Jpg.Free;
      end;
    finally
      Stream.Free;
    end; //try..finally
end;  *)

procedure TMDIChild.DisplayImage(lUpdateCon,lForceDraw: b

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -