main.pas

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

      SliceSlider.position := 1;
  end else begin
      SliceSlider.enabled := true;
     VideoBtn.caption := inttostr(TMDIChild(MainForm.ActiveMDIChild).gVideoSpeed);
     VideoBtn.enabled := true;
      SliceSlider.Max := TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.XYZdim[3];
      SliceSlider.position := TMDIChild(MainForm.ActiveMDIChild).gSlice;
      //showmessage(inttostr(TMDIChild(MainForm.ActiveMDIChild).gSlice)+'.'+inttostr(SliceSlider.Max));
  end;

end;
procedure TMainForm.SchemeDropChange(Sender: TObject);
var lStr: string;
lSearchRec: TSearchRec;
begin
if MainForm.MDIChildCount = 0 then exit;
     if SchemeDrop.ItemIndex > 2 then begin
       lStr := extractfilepath(paramstr(0)){+'\'}+SchemeDrop.Items.Strings[SchemeDrop.ItemIndex]+'.lut';
       if FindFirst(lStr, faAnyFile, lSearchRec) <> 0 then begin
          SchemeDrop.ItemIndex := 0;
          FindClose(lSearchRec);
          exit;
       end;
       FindClose(lSearchRec);
       TMDIChild(MainForm.ActiveMDIChild).LoadColorScheme(lStr,SchemeDrop.ItemIndex);
     end else
         TMDIChild(MainForm.ActiveMDIChild).LoadColorScheme('',SchemeDrop.ItemIndex);
     TMDIChild(MainForm.ActiveMDIChild).UpdatePalette(true,0);
     //TMDIChild(MainForm.ActiveMDIChild).DisplayImage(false,SliceSlider.position,WinWidEdit.value,WincenEdit.value,MainForm.SchemeDrop.itemindex);
     //zap conlabelclick;
end;

procedure TMainForm.ApplyConClick(Sender: TObject);
var lMin,lWid,lCen: integer;
begin
if MainForm.MDIChildCount = 0 then exit;
case (sender as TSpeedButton).tag of
     1: begin
     lMin := TMDIChild(MainForm.ActiveMDIChild).gImgMin;
     lWid := TMDIChild(MainForm.ActiveMDIChild).gImgMax - lMin;
     lCen := lMin + (lWid shr 1);
     //self.caption := inttostr(lMin)+'abba'+inttostr(lCen)+'aaa'+inttostr(TMDIChild(MainForm.ActiveMDIChild).gImgMax);
     if TMDIChild(MainForm.ActiveMDIChild).gBuff16sz > 0 then
         TMDIChild(MainForm.ActiveMDIChild).Scale16to8bit(lCen,lWid)
     else begin
     //TMDIChild(MainForm.ActiveMDIChild).gWinCen := lMin + (lWid shr 1);
     TMDIChild(MainForm.ActiveMDIChild).gFastCen := lMin + (lWid shr 1);
     //TMDIChild(MainForm.ActiveMDIChild).gWinWid :=lWid;
     TMDIChild(MainForm.ActiveMDIChild).UpdatePalette(true,lWid);
     end;
     ConLabelClick;
     exit;
     end;
     2: begin
     WinWidEdit.value :=(TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.WindowWidth);
     WinCenEdit.value :=(TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.WindowCenter);
     TMDIChild(MainForm.ActiveMDIChild).gWinWid :=(TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.WindowWidth);
     TMDIChild(MainForm.ActiveMDIChild).gWinCen :=(TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.WindowCenter);
     end;
     else begin
          TMDIChild(MainForm.ActiveMDIChild).gWinWid :=WinWidEdit.value ;
          TMDIChild(MainForm.ActiveMDIChild).gWinCen :=WinCenEdit.value ;
     end;
     end;
     TMDIChild(MainForm.ActiveMDIChild).RefreshZoom;
     //TMDIChild(MainForm.ActiveMDIChild).DisplayImage(true,false,SliceSlider.position,WinWidEdit.value,WincenEdit.value);
     ConLabelClick;
end;
PROCEDURE PrintBitmap(Canvas:  TCanvas; DestRect:  TRect;  Bitmap:  TBitmap);
  VAR
    BitmapHeader:  pBitmapInfo;
    BitmapImage :  POINTER;
    HeaderSize  :  DWORD;    // Use DWORD for D3-D5 compatibility
    ImageSize   :  DWORD;
BEGIN
  GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
  GetMem(BitmapHeader, HeaderSize);
  GetMem(BitmapImage,  ImageSize);
  TRY
    GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
    StretchDIBits(Canvas.Handle,
                  DestRect.Left, DestRect.Top,     // Destination Origin
                  DestRect.Right  - DestRect.Left, // Destination Width
                  DestRect.Bottom - DestRect.Top,  // Destination Height
                  0, 0,                            // Source Origin
                  Bitmap.Width, Bitmap.Height,     // Source Width & Height
                  BitmapImage,
                  TBitmapInfo(BitmapHeader^),
                  DIB_RGB_COLORS,
                  SRCCOPY)
  FINALLY
    FreeMem(BitmapHeader);
    FreeMem(BitmapImage)
  END
END {PrintBitmap};
procedure TMainForm.PrintImg;
VAR
  Bitmap             :  TBitmap;
  liHt,liWid,iFromLeftMargin,iPrintedImageWidth,jDelta,jFromTopOfPage,jPrintedImageHeight:  INTEGER;
begin
  if MainForm.MDIChildCount = 0 then exit;
  if not PrintDialog1.Execute then exit;
  liHt := TMDIChild(MainForm.ActiveMDIChild).image.Picture.Height;
  liWid := TMDIChild(MainForm.ActiveMDIChild).image.Picture.Width;
  if (liHt = 0) or (liWid = 0) then exit;
  Screen.Cursor := crHourGlass;
  TRY
    {if liHt >= liWid then
        Printer.Orientation := poPortrait //image is taller than wide
    else
        Printer.Orientation := poLandscape; //image is wider than tall
     }
      Printer.BeginDoc;
      Printer.Canvas.Font.Size := 12;
      Printer.Canvas.Font.Name := 'Arial';
      jDelta := Printer.Canvas.TextHeight('X');
      //jFromTopOfPage := 3*jDelta;
      //s := 'Image Title';
      //Printer.Canvas.TextOut(CenterText(s), jFromTopOfPage, s);
      // 5th line from top
      jFromTopOfPage := 5*jDelta;

      // Image position and size
      // 12% left and right margin
      iFromLeftMargin    := MulDiv(Printer.PageWidth,12,100);  // 12%
      if (liHt/liWid) > (Printer.PageHeight/Printer.PageWidth) then begin
         //Paper HEIGHT is constrained aspect ration
         // Set printed bitmap with to be 76% of paper HEIGHT
         jPrintedImageHeight := MulDiv(Printer.PageHeight,76,100);  // 76%
         // Set printed bitmap WIDTH to maintain aspect ratio
         iPrintedImageWidth:= liWid*jPrintedImageHeight DIV liHt;
         // maintain aspect ratio of bitmap
      end else begin
         //Paper WIDTH is constrained aspect ration
        // Set printed bitmap with to be 76% of paper WIDTH
           iPrintedImageWidth := MulDiv(Printer.PageWidth,76,100);  // 76%
           // Set printed bitmap height to maintain aspect ratio
           jPrintedImageHeight := liHt*iPrintedImageWidth DIV liWid;
      end;
      Bitmap := TBitmap.Create;
      TRY
        Bitmap.Width  := liWid;
        Bitmap.Height := liHt;
        Bitmap.PixelFormat := pf24bit;
        // Convert JPEG to BMP
        Bitmap.Canvas.Draw(0,0, TMDIChild(MainForm.ActiveMDIChild).image.Picture.Graphic);
        PrintBitmap (Printer.Canvas,
                    Rect(iFromLeftMargin, jFromTopOfPage,
                        iFromLeftMargin + iPrintedImageWidth,
                         jFromTopOfPage  + jPrintedImageHeight),
                    Bitmap)
      FINALLY
        Bitmap.Free
      END;
    Printer.EndDoc;
  FINALLY
    Screen.Cursor := crDefault
  END;
end;

procedure TMainForm.ConLabelClick;
//var lWid,lCen: integer;
begin

  if (MainForm.MDIChildCount = 0) then exit;
  StatusBar.Panels[1].text := inttostr(TMDIChild(MainForm.ActiveMDIChild).gZoomPct)+'%';
  if TMDIChild(MainForm.ActiveMDIChild).gDICOMData.XYZdim[3] < 2 then
     StatusBar.Panels[2].text := inttostr(TMDIChild(MainForm.ActiveMDIChild).gDICOMData.XYZdim[1])+'x'+inttostr(TMDIChild(MainForm.ActiveMDIChild).gDICOMData.XYZdim[2])
  else
     StatusBar.Panels[2].text := inttostr(TMDIChild(MainForm.ActiveMDIChild).gSlice)+'/'+ inttostr(TMDIChild(MainForm.ActiveMDIChild).gDICOMData.XYZdim[3])+' '+inttostr(TMDIChild(MainForm.ActiveMDIChild).gDICOMData.XYZdim[1])+'x'+inttostr(TMDIChild(MainForm.ActiveMDIChild).gDICOMData.XYZdim[2]);
  if (TMDIChild(MainForm.ActiveMDIChild).gimgmin=0)and (TMDIChild(MainForm.ActiveMDIChild).gimgmax=0) then
     StatusBar.Panels[3].text := ''
  else
      StatusBar.Panels[3].text := 'Image  Cen/Wid: '
     +inttostr(TMDIChild(MainForm.ActiveMDIChild).gimgCen)+'/'+inttostr(TMDIChild(MainForm.ActiveMDIChild).gimgWid);
 StatusBar.Panels[4].text := TMDIChild(MainForm.ActiveMDIChild).gContrastStr{+'abba'+inttostr(random(888))};
end;

procedure TMainForm.BestFitItemClick(Sender: TObject);
begin
  BestFitItem.checked := not BestFitItem.checked;
  AutoFitBtn.Down := BestFitItem.checked;
  if BestFitItem.checked then begin
     ZoomSLider.enabled := false;
     Pct100btn.enabled := false;
  end else begin
      ZoomSlider.enabled := true;
      Pct100btn.enabled := true;
  end;
  if MainForm.MDIChildCount = 0 then exit;
  if BestFitItem.checked then
     TMDIChild(MainForm.ActiveMDIChild).AutoMaximise;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
  if (MainForm.MDIChildCount = 0) or (not BestFitItem.checked) then exit;
  TMDIChild(MainForm.ActiveMDIChild).AutoMaximise; 
end;

procedure TMainForm.Print1Click(Sender: TObject);
begin
PrintImg;
end;

procedure TMainForm.Exportaspicture1Click(Sender: TObject);
var
   JPG : TJPEGImage;
   BMP: TBitmap;
   lExt: string;
   lS: integer;
begin
     //TMDIChild(MainForm.ActiveMDIChild).Image = nil then exit;
     if not MainForm.PGSaveDialog.Execute then exit;
     PGOpenDialog.InitialDir := extractfilepath(PGSaveDialog.FileName);
     PGSaveDialog.InitialDir := PGOpenDialog.InitialDir;
     lExt := ExtractFileExt(MainForm.PGSaveDialog.FileName);
     if length(lExt) > 0 then
        for lS := 1 to length(lExt) do
            lExt[lS] := upcase(lExt[lS]);
     if ('.JPG'= lExt) or (lExt='.JPEG') then begin
           JPG := TJPEGImage.Create;
           TRY
              JPG.CompressionQuality := 80;
              //if TMDIChild(MainForm.ActiveMDIChild).FDICOM and TMDIChild(MainForm.ActiveMDIChild).gImgOK then
              //TMDIChild(MainForm.ActiveMDIChild).DisplayImage(true,false,false,SliceSlider.position,WinWidEdit.value,WincenEdit.value{,MainForm.SchemeDrop.itemindex});
              //JPG.Assign(TMDIChild(MainForm.ActiveMDIChild).Image.Picture.Bitmap);
              //following code ensures color palette is saved
              BMP := TBitmap.create;
              try
                 BMP.Height := TMDIChild(MainForm.ActiveMDIChild).image.Picture.Height;
                 BMP.Width := TMDIChild(MainForm.ActiveMDIChild).image.Picture.Width;
                 BMP.PixelFormat := pf24bit;
                 BMP.Canvas.Draw(0,0, TMDIChild(MainForm.ActiveMDIChild).image.Picture.Graphic);
                 JPG.Assign(BMP);
              finally
                        BMP.Free;
              end;
              JPG.SaveToFile(ChangeFileExt(MainForm.PGSaveDialog.FileName,'.jpg'));
           FINALLY
               JPG.Free
           END;
     end else
  	TMDIChild(MainForm.ActiveMDIChild).Image.Picture.Bitmap.SaveToFile( ChangeFileExt(MainForm.PGSaveDialog.FileName,'.bmp' ));
     PGSaveDialog.Filename := '';   
end;

procedure TMainForm.Close1Click(Sender: TObject);
begin
if MainForm.MDIChildCount = 0 then UpdateMenuItems(nil);
TMDIChild(MainForm.ActiveMDIChild).close;
end;
procedure TMainForm.GetRegistryData;
  var
    reg: TRegistry;
    lInc: integer;
    lStr: STRING;
  begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKey( gKeyRoot, true ) then begin
      if reg.ValueExists( 'OpenDir' ) then
        lStr := reg.ReadString( 'OpenDir' );
      OpenDialog.InitialDir := lStr;
      if reg.ValueExists( 'PixDir' ) then
        lStr := reg.ReadString( 'PixDir' );
      PGOpenDialog.InitialDir := lStr;
      PGSaveDialog.InitialDir := lStr;
      if reg.ValueExists( 'RawWid' ) then gRawWid := reg.ReadInteger('RawWid');
      if reg.ValueExists( 'RawHt' ) then gRawHt := reg.ReadInteger('RawHt');
      if reg.ValueExists( 'RawSlice' ) then gRawSlice := reg.ReadInteger('RawSlice');
      if reg.ValueExists( 'RawOffset' ) then gRawOffset := reg.ReadInteger('RawOffset');
      if reg.ValueExists( 'RawBits' ) then gRawBits := reg.ReadInteger('RawBits');
      if reg.ValueExists( 'RawLittleEnd' ) then gRawLittleEnd := reg.ReadBool('RawLittleEnd');
      if reg.ValueExists( 'RawPlanarRGB' ) then gRawPlanarRGB := reg.ReadBool('RawPlanarRGB');
      if reg.ValueExists( 'Maximize' ) then
        BestFitItem.checked := reg.ReadBool( 'Maximize' );
      AutoFitBtn.Down := BestFitItem.checked;
      for lInc := 1 to kMaxMRU do
          if reg.ValueExists( 'MRU'+inttostr(lInc) ) then begin
             lStr := reg.ReadString('MRU'+inttostr(lInc) );
             if (length(lStr)>0)  {and (fileexistsex(lStr))} then begin
                gMRUra[lInc] := lStr;
             end;
          end;
      end;
  finally
    reg.Free;
    end;
  UpdateMRUMenu;

  end;

  procedure TMainForm.PutRegistryData;
  var
    reg: TRegistry;
    lInc: integer;
  begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKey( gKeyRoot, true ) then
      begin
      reg.WriteString( 'OpenDir', OpenDialog.INitialDir );
      reg.WriteString( 'PixDir', PGOpenDialog.InitialDir );
      reg.WriteInteger('RawWid',gRawWid);
      reg.WriteInteger('RawHt',gRawHt);
      reg.WriteInteger('RawSlice',gRawSlice);
      reg.WriteInteger('RawOffset',gRawOffset);
      reg.WriteInteger('RawBits',gRawBits);
      reg.WriteBool( 'RawLittleEnd',gRawLittleEnd);
      reg.WriteBool('RawPlanarRGB',gRawPlanarRGB);
      reg.WriteBool( 'Maximize',BestFitItem.checked );
      for lInc := 1 to kMaxMRU do begin
                reg.WriteString( 'MRU'+inttostr(lInc), gMRUra[lInc] );
      end;
      reg.CloseKey;
      end;
  finally