📄 main.~pas
字号:
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 + -