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

📄 main.~pas

📁 在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的
💻 ~PAS
📖 第 1 页 / 共 4 页
字号:
    SliceSlider.enabled := false;
    VideoBtn.enabled := false;
    //VideoBtn.down := false;
    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
    reg.Free;
  end;
end;

⌨️ 快捷键说明

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