unit1.pas

CT图象重建的DELPHI源代码,转载自一个学长的博客

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxDockControl, dxBar, cxGraphics, cxControls, dxStatusBar, ImgList,
  dxDockPanel, ExtCtrls, dxsbar, ExtDlgs, RzGroupBar, GR32_Image, Math, StdCtrls,
  RzPanel, Mask, RzEdit, ahofft, RzStatus, dxBarExtItems, ClipBrd, ShellAPI, GR32,
  GraphicEx, GR32_Layers;

type
  TForm1 = class(TForm)
    dxBarManager1: TdxBarManager;
    dxDockSite1: TdxDockSite;
    dxDockingManager1: TdxDockingManager;
    dxBarSubItem1: TdxBarSubItem;
    dxBarSubItem2: TdxBarSubItem;
    dxBarSubItem3: TdxBarSubItem;
    dxBarSubItem4: TdxBarSubItem;
    dxBarSubItem5: TdxBarSubItem;
    dxBarButton1: TdxBarButton;
    dxBarButton2: TdxBarButton;
    dxBarButton3: TdxBarButton;
    dxBarButton4: TdxBarButton;
    dxBarButton5: TdxBarButton;
    ImageList1: TImageList;
    dxBarSubItem6: TdxBarSubItem;
    dxBarSubItem7: TdxBarSubItem;
    dxBarButton6: TdxBarButton;
    dxBarButton7: TdxBarButton;
    dxBarButton8: TdxBarButton;
    dxBarButton9: TdxBarButton;
    dxBarButton10: TdxBarButton;
    dxBarButton11: TdxBarButton;
    dxBarButton12: TdxBarButton;
    dxDockPanel1: TdxDockPanel;
    dxLayoutDockSite1: TdxLayoutDockSite;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    RzGroupBar1: TRzGroupBar;
    RzGroup1: TRzGroup;
    RzGroup2: TRzGroup;
    RzGroup3: TRzGroup;
    ImgView321: TImgView32;
    dxDockPanel2: TdxDockPanel;
    dxTabContainerDockSite1: TdxTabContainerDockSite;
    dxBarButton13: TdxBarButton;
    ImgView322: TImgView32;
    dxDockPanel3: TdxDockPanel;
    ImgView323: TImgView32;
    RzGroupBox1: TRzGroupBox;
    dxDockPanel4: TdxDockPanel;
    ImgView324: TImgView32;
    Edit1: TRzNumericEdit;
    dxDockPanel5: TdxDockPanel;
    dxDockPanel6: TdxDockPanel;
    RzNumericEdit1: TRzNumericEdit;
    RzNumericEdit2: TRzNumericEdit;
    Label1: TLabel;
    Label2: TLabel;
    ImgView325: TImgView32;
    ImgView326: TImgView32;
    RzStatusBar1: TRzStatusBar;
    RzStatusPane1: TRzStatusPane;
    RzProgressStatus1: TRzProgressStatus;
    RzStatusPane2: TRzStatusPane;
    dxBarButton14: TdxBarButton;
    dxBarButton15: TdxBarButton;
    dxBarButton16: TdxBarButton;
    dxBarButton17: TdxBarButton;
    dxBarButton18: TdxBarButton;
    dxBarButton19: TdxBarButton;
    dxBarButton20: TdxBarButton;
    ImageList2: TImageList;
    dxBarLargeButton1: TdxBarLargeButton;
    dxBarLargeButton2: TdxBarLargeButton;
    dxBarLargeButton3: TdxBarLargeButton;
    dxBarLargeButton4: TdxBarLargeButton;
    dxBarLargeButton5: TdxBarLargeButton;
    dxBarLargeButton6: TdxBarLargeButton;
    Label3: TLabel;
    dxBarLargeButton7: TdxBarLargeButton;
    dxDockPanel7: TdxDockPanel;
    ImgView327: TImgView32;
    dxBarButton21: TdxBarButton;
    dxBarLargeButton8: TdxBarLargeButton;
    dxBarLargeButton9: TdxBarLargeButton;
    procedure RzGroup1Items2Click(Sender: TObject);
    procedure RzGroup1Items1Click(Sender: TObject);
    procedure dxBarLargeButton9Click(Sender: TObject);
    procedure dxBarLargeButton8Click(Sender: TObject);
    procedure ImgView321MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ImgView321MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure dxBarButton21Click(Sender: TObject);
    procedure RzGroup2Items2Click(Sender: TObject);
    procedure dxBarLargeButton5Click(Sender: TObject);
    procedure dxBarButton14Click(Sender: TObject);
    procedure dxBarLargeButton4Click(Sender: TObject);
    procedure dxBarLargeButton3Click(Sender: TObject);
    procedure dxBarButton5Click(Sender: TObject);
    procedure RzGroup3Items1Click(Sender: TObject);
    procedure RzGroup3Items0Click(Sender: TObject);
    procedure dxBarButton10Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure dxBarButton9Click(Sender: TObject);
    procedure RzGroup2Items1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RzGroup2Items0Click(Sender: TObject);
    procedure dxBarButton1Click(Sender: TObject);
    procedure dxBarButton13Click(Sender: TObject);
    procedure RzGroup1Items0Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

var
  Source: Array [0..256,0..256] of Integer;
  Sinogram, TempSin: Array [0..360,0..256] of Integer;
  radon1,radon2:array[0..360,0..256] of Single;
  dre,dim:array[0..256,0..256] of Single;
  ART: Array [0..256,0..256] of Single;
  Max, hv, hz, ZJS, Count: Integer;
  Energy: Int64;
  TempBitmap: TBitmap;
  Theta, ff: Real;

function Display(p: Integer; AA,b,a,X0,Y0,x,y: double): Integer;
var
  s: Real;
begin
  s := ((x-x0)*cos(a)+(y-y0)*sin(a))*((x-x0)*cos(a)+(y-y0)*sin(a))/
       (AA*AA)+((y-y0)*cos(a)-(x-x0)*sin(a))*((y-y0)*cos(a)-(x-x0)*sin(a))/(b*b);
  if s >= 1 then
    result := 0
  else
   result := p;
end;

procedure Boundary;
var
  i, j, m, n, g, oo, t: Integer;
begin
  for i := 0 to 256 do
    for j := 0 to 256 do
      ART[i][j] := 128;
  m := 0;
  n := 0;
  for i := 0 to 360 do
  begin
    for j := 0 to 256 do
    begin
      TempSin[i][j] := 0;
      if Sinogram[i][j] > 0 then
      begin
        m := j;
        break;
      end;
    end;
    for j := 256 downto 0 do
    begin
      TempSin[i][j] := 0;
      if Sinogram[i][j] > 0 then
      begin
        n := j;
        break;
      end;
    end;
    for j := m to n do
      TempSin[i][j] := 100;
  end;

  for i:=0 to 256 do
  begin
    m := i - 128;
    for j:=0 to 256 do
    begin
      n := j - 128;
      g := 0;
      for oo:=0 to 360 do
      begin
        t := Floor(128 - m * cos((oo * pi) / 360) - n * sin((oo * pi) / 360));
        if (t >= 0) and (t <= 256) then
          if TempSin[oo][t] = 0 then
          begin
            Inc(g);
            break;
          end;
      end;
      if g = 1 then
        ART[256 - j][i] := -14;
    end;
  end;

end;

procedure TForm1.dxBarButton10Click(Sender: TObject);
var
  i, j: Integer;
begin
  Boundary;
  for i := 0 to 256 do
    for j := 0 to 256 do
    begin
      ImgView321.Canvas.Pixels[i,j] :=
          RGB(Trunc(ART[i][j]), Trunc(ART[i][j]), Trunc(ART[i][j]));
      ImgView321.Canvas.Pixels[i+256,j] :=
          RGB(source[i][j], source[i][j], source[i][j]);
    end;
end;

procedure TForm1.dxBarButton13Click(Sender: TObject);
var
  i,j,r,k: Integer;
  t: Extended;
  Bitmap: TBitmap;
begin
  dxTabContainerDockSite1.ActiveChild := dxDockPanel2;
  Bitmap := TBitmap.Create;
  Bitmap.Width := 360;
  Bitmap.Height := 256;
  hv := ImgView322.Width div 2 - 187;
  hz := ImgView322.Height div 2 - 137;
  Max := Energy div 20000;
  for I := 0 to 360 do
    for j := 0 to 256 do
      Sinogram[i][j] := 0;        // 初始化正弦图

  for k := 0 to 360 - 1 do
  begin
    t :=k * PI / 360;
    for I := 0 to 256 - 1 do
      for j := 0 to 256 - 1 do
        if (Source[i][j] > 0) then
        begin
          r := Floor((128 - j)* cos(t) - (i - 128) * sin(t) + 128);
          Sinogram[k][r] := Sinogram[k][r] + Source[i][j];
        end;
    Application.ProcessMessages;
    rzProgressStatus1.Percent := Trunc(k * 0.278);
    for j := 0 to 256 do
    begin
      r := Sinogram[k][j] div max;
      ImgView322.Canvas.Pixels[k + hv,j + hz] := RGB(r, r, r);
      Bitmap.Canvas.Pixels[k, j] := RGB(r, r, r);
    end;
  end;
  rzProgressStatus1.Percent := 0;
  ImgView322.Bitmap.Assign(Bitmap);
  Bitmap.Destroy;
end;

procedure TForm1.dxBarButton14Click(Sender: TObject);
begin
    ShellAbout(Application.MainForm.Handle,
             '图像重建',
             'Copyright(@)胡志豪'#13'http://deter,icpcn.com',
             Application.Icon.Handle);
end;

procedure TForm1.dxBarButton1Click(Sender: TObject);
var
  i, j: Integer;
  pRGB: pRGBTriple;
begin
  dxTabContainerDockSite1.ActiveChild := dxDockPanel1;
  Energy := 0;
  if OpenPictureDialog1.Execute then
  begin
    TempBitmap.LoadFromFile(OpenPictureDialog1.FileName);
    TempBitmap.Width := 257;
    TempBitmap.Height := 257;
    TempBitmap.PixelFormat := pf24bit;

    for i := 0 to 256 do
    begin
      pRGB := TempBitmap.ScanLine[i];
      for j := 0 to 256 do
      begin
        Source[i][j] := pRGB^.rgbtRed;
        Energy := Energy + pRGB^.rgbtRed;
        Inc(pRGB);
      end;
    end;
    ImgView321.Bitmap.Assign(TempBitmap);
  end;
  Edit1.Text := IntToStr(Energy);
end;

procedure TForm1.dxBarButton21Click(Sender: TObject);
var
  TempStream: TResourceStream;
begin
  TempStream := TResourceStream.Create(Hinstance, 'Instruction', 'TXT');
  TempStream.SaveToFile('c:\huzhihao.txt');
  ShellExecute(handle, nil, 'NOTEPAD.EXE', 'c:\huzhihao.txt', nil, sw_shownormal);
  TempStream.Destroy;
end;

procedure TForm1.dxBarButton5Click(Sender: TObject);
begin
  SavePictureDialog1.DefaultExt:='bmp';
  if SavePictureDialog1.Execute then
  begin
    if dxTabContainerDockSite1.ActiveChild = dxDockPanel1 then
      ImgView321.Bitmap.SaveToFile(SavePictureDialog1.FileName)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel2 then
      ImgView322.Bitmap.SaveToFile(SavePictureDialog1.FileName)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel3 then
      ImgView323.Bitmap.SaveToFile(SavePictureDialog1.FileName)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel4 then
      ImgView324.Bitmap.SaveToFile(SavePictureDialog1.FileName)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel5 then
      ImgView325.Bitmap.SaveToFile(SavePictureDialog1.FileName)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel6 then
      ImgView326.Bitmap.SaveToFile(SavePictureDialog1.FileName)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel7 then
      ImgView327.Bitmap.SaveToFile(SavePictureDialog1.FileName)
  end;
end;

procedure TForm1.dxBarButton9Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.dxBarLargeButton3Click(Sender: TObject);
begin
  with ClipBoard do
  begin
    if dxTabContainerDockSite1.ActiveChild = dxDockPanel1 then
      Assign(ImgView321.Bitmap)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel2 then
      Assign(ImgView322.Bitmap)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel3 then
      Assign(ImgView323.Bitmap)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel4 then
      Assign(ImgView324.Bitmap)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel5 then
      Assign(ImgView325.Bitmap)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel6 then
      Assign(ImgView326.Bitmap)
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel7 then
      Assign(ImgView327.Bitmap);
  end;
end;

procedure TForm1.dxBarLargeButton4Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.dxBarLargeButton5Click(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.dxBarLargeButton8Click(Sender: TObject);
begin
    if dxTabContainerDockSite1.ActiveChild = dxDockPanel1 then
    begin
      ImgView321.Bitmap.Rotate270;
      ImgView321.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel2 then
    begin
      ImgView322.Bitmap.Rotate270;
      ImgView322.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel3 then
    begin
      ImgView323.Bitmap.Rotate270;
      ImgView323.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel4 then
    begin
      ImgView324.Bitmap.Rotate270;
      ImgView324.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel5 then
    begin
      ImgView325.Bitmap.Rotate270;
      ImgView325.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel6 then
    begin
      ImgView326.Bitmap.Rotate270;
      ImgView326.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel7 then
    begin
      ImgView327.Bitmap.Rotate270;
      ImgView327.Refresh;
    end
end;

procedure TForm1.dxBarLargeButton9Click(Sender: TObject);
begin
    if dxTabContainerDockSite1.ActiveChild = dxDockPanel1 then
    begin
      ImgView321.Bitmap.Rotate90;
      ImgView321.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel2 then
    begin
      ImgView322.Bitmap.Rotate90;
      ImgView322.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel3 then
    begin
      ImgView323.Bitmap.Rotate90;
      ImgView323.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel4 then
    begin
      ImgView324.Bitmap.Rotate90;
      ImgView324.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel5 then
    begin
      ImgView325.Bitmap.Rotate90;
      ImgView325.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel6 then
    begin
      ImgView326.Bitmap.Rotate90;
      ImgView326.Refresh;
    end
    else if dxTabContainerDockSite1.ActiveChild = dxDockPanel7 then
    begin
      ImgView327.Bitmap.Rotate90;
      ImgView327.Refresh;
    end
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Max := StrToInt(Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TempBitmap := TBitmap.Create;
  TempBitmap.Width := 257;
  TempBitmap.Height := 257;
  TempBitmap.PixelFormat := pf24bit;
end;

procedure TForm1.ImgView321MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  s: Single;
begin
  s := TImgView32(Sender).Scale * 1.1;
  if s > 20 then s := 20;
    TImgView32(Sender).Scale := s;
end;

procedure TForm1.ImgView321MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  s: Single;
begin
  s := TImgView32(Sender).Scale / 1.1;
  if s < 0.2 then s := 0.2;
    TImgView32(Sender).Scale := s;
end;

procedure TForm1.RzGroup1Items0Click(Sender: TObject);
var
  m, n: Integer;
  X, Y: Single;
  a, b, c, d, e, f, g, h, i, j: Integer;
  pRGB: pRGBTriple;
begin
  dxTabContainerDockSite1.ActiveChild := dxDockPanel1;
  Energy := 0;
  hv := ImgView321.Width div 2 - 137;
  hz := ImgView321.Height div 2 - 137;
   for m :=0 to 256 do