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

📄 unconvert.pas

📁 这是我用Delphi和Matlab写的一个程序
💻 PAS
字号:
unit unConvert;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs, Spin, StereoImg, GraphWin, Buttons;

type
  TfmConvert = class(TForm)
    lblP: TLabel;
    ImageI: TImage;
    lblQ: TLabel;
    lblI: TLabel;
    btnLoadP: TButton;
    btnLoadQ: TButton;
    OpenPicDlg: TOpenPictureDialog;
    ScrollBoxP: TScrollBox;
    ImageP: TImage;
    ScrollBoxQ: TScrollBox;
    ImageQ: TImage;
    ImageErms: TImage;
    lblE: TLabel;
    editIpq: TEdit;
    editErms: TEdit;
    sePixels: TSpinEdit;
    BakLbl: TLabel;
    MarkLbl: TLabel;
    StereoImg: TStereoImg;
    lblFront: TLabel;
    lblBack: TLabel;
    btnOK: TBitBtn;
    lblCrossBack: TLabel;
    lblCrossFront: TLabel;
    seN: TSpinEdit;
    procedure btnLoadPClick(Sender: TObject);
    procedure btnLoadQClick(Sender: TObject);
    procedure sePixelsChange(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    OriginP, OriginQ: TBitmap;          //  用于保存原图像
    procedure CreateImageP(Dis: TDistribution); //  生成ImageP
  public
    { Public declarations }
    Merge: Boolean;                     //  True: 执行Merge 功能
    Distribution: TDistribution;
    procedure CalCriteria;
    procedure MergeImage(var tmpImg: TStereoImg);
  end;

var
  fmConvert: TfmConvert;

implementation

{$R *.dfm}

procedure TfmConvert.btnOKClick(Sender: TObject);
begin
  //  向主界面传送立体图像对
  with StereoImg do
    if not (ImageP.Picture.Bitmap.Empty or ImageQ.Picture.Bitmap.Empty) then
    begin
      {  借用StereoImg }
      //  暂存到右图像
      rImg := nil;
      rImg := TBitmap.Create;
      rImg.Assign(ImageQ.Picture.Bitmap);

      //  暂存到左图像
      lImg := nil;
      lImg := TBitmap.Create;
      lImg.Assign(ImageP.Picture.Bitmap);

      MergeImage(StereoImg);

      {  释放借用的变量  }
      lImg.Free;
      rImg.Free;
    end
    else
      MessageDlg('Improper image selected or no image selected!', mtError,
        [mbOk], 0);
end;

procedure TfmConvert.btnLoadPClick(Sender: TObject);
begin
  if OpenPicDlg.Execute then
  begin
    ImageP.Picture.LoadFromFile(OpenPicDlg.FileName);

    if not ImageQ.Picture.Bitmap.Empty then
      CalCriteria;
  end;
end;

procedure TfmConvert.btnLoadQClick(Sender: TObject);
begin
  if OpenPicDlg.Execute then
  begin
    ImageQ.Picture.LoadFromFile(OpenPicDlg.FileName);
    {  对各种分布进行处理  }
    if not Merge then
      case Distribution of
        dMove:
          begin
            //  拷贝到左图像
            ImageP.Picture.Bitmap.Assign(ImageQ.Picture.Bitmap);

            //  保存一份原图像
            OriginP := nil;
            OriginQ := nil;
            OriginP := TBitmap.Create;
            OriginQ := TBitmap.Create;
            OriginP.Assign(ImageP.Picture.Bitmap);
            OriginQ.Assign(ImageQ.Picture.Bitmap);
          end;
        dUniform:
          CreateImageP(dUniform);
        dTriangular:
          CreateImageP(dTriangular);
        dPiecewise:
          CreateImageP(dPiecewise);
        dNormal:
          CreateImageP(dNormal);
      end;

    // P、Q都不空才可以计算评价指标
    if not ImageP.Picture.Bitmap.Empty then
      CalCriteria;
  end;
end;

procedure TfmConvert.CalCriteria;
var
  Y, X: Integer;                        //  循环变量
  xi: array[0..255] of Integer;
  //  数组xi的下标表示图像的灰度可能取的值,即:0-255;每个元素是图像中出现此灰度值的像素的个数

  pi, qi: array[0..255] of Single;
  //  数组pi和qi中的每一个元素是图像各灰度值对应的概率,下标表示灰度值

  Row, RowQ: PByteArray; //  A line of pixels. 指向TByteArray的指针
  Gray: Integer;                        //  像素点的灰度值
  Ipq: Single;                          //  交叉熵
  Erms: Single;                         //  灰度均方根误差
  Pij, Qij: Single;                     //  点(i, j)处的灰度值
  ImgHeight, ImgFormat: Boolean;
begin
  //  判断打开的图像是否符合要求
  ImgHeight := (ImageP.Height = 600) and (ImageQ.Height = 600) and (ImageP.Width
    = 800) and (ImageQ.Width = 800);
  ImgFormat := (ImageP.Picture.Bitmap.PixelFormat = pf24bit)
    and (ImageQ.Picture.Bitmap.PixelFormat = pf24bit);
  if ImgHeight and ImgFormat then
  begin
      {  借用StereoImg }
      //  暂存到右图像
    StereoImg.rImg := nil;
    StereoImg.rImg := TBitmap.Create;
    StereoImg.rImg.Assign(ImageQ.Picture.Bitmap);

      //  暂存到左图像
    StereoImg.lImg := nil;
    StereoImg.lImg := TBitmap.Create;
    StereoImg.lImg.Assign(ImageP.Picture.Bitmap);

    {  计算交叉熵  }
    {  对图像P各灰度值的像素的个数进行统计  }
    for Y := 0 to 255 do
      xi[Y] := 0;                       //  初始化

    with StereoImg.lImg do
      for Y := 0 to Height - 1 do
      begin
        Row := ScanLine[Y];             //  扫描一行

        for X := 0 to Width - 1 do
        begin
          // values must be less than 256, so "Round" is used.
          Gray := Round(Row[X * 3 + 2] * 0.3 + Row[X * 3 + 1] * 0.59 + Row[X *
            3] * 0.11);
          Inc(xi[Gray]);

          //  变为灰度图
          Row[X * 3 + 2] := Gray;
          Row[X * 3 + 1] := Gray;
          Row[X * 3] := Gray;
        end;
      end;

    //  求图像P各灰度值对应的概率
    for Y := 0 to 255 do
      pi[Y] := xi[Y] / 480000;

    {  对图像Q各灰度值的像素的个数进行统计  }
    for Y := 0 to 255 do
      xi[Y] := 0;                       //  初始化

    with StereoImg.rImg do
      for Y := 0 to Height - 1 do
      begin
        Row := ScanLine[Y];             //  扫描一行

        for X := 0 to Width - 1 do
        begin
          // values must be less than 256, so "Round" is used.
          Gray := Round(Row[X * 3 + 2] * 0.3 + Row[X * 3 + 1] * 0.59 + Row[X *
            3] * 0.11);
          Inc(xi[Gray]);

          //  变为灰度图
          Row[X * 3 + 2] := Gray;
          Row[X * 3 + 1] := Gray;
          Row[X * 3] := Gray;
        end;
      end;

    //  求图像Q各灰度值对应的概率
    for Y := 0 to 255 do
      qi[Y] := xi[Y] / 480000;

    //  按公式计算交叉熵
    Ipq := 0;
    for Y := 0 to 255 do
      if (pi[Y] <> 0) and (qi[Y] <> 0) then
        Ipq := Ipq + pi[Y] * Ln(pi[Y] / qi[Y]);

    {  显示交叉熵  }
    editIpq.Text := FloatToStr(Ipq);

    {  计算灰度均方根误差  }
    Erms := 0;                          //  初始化
    for Y := 0 to ImageP.Picture.Bitmap.Height - 1 do
    begin
      Row := ImageP.Picture.Bitmap.ScanLine[Y]; //  扫描一行
      RowQ := ImageQ.Picture.Bitmap.ScanLine[Y];

      for X := 0 to ImageP.Picture.Bitmap.Width - 1 do
      begin
        //  计算灰度值P(i,j)
        Pij := Row[X * 3];
        //  计算灰度值Q(i,j)
        Qij := RowQ[X * 3];
        Erms := Erms + Sqr(Pij - Qij);
      end;
    end;

    Erms := Sqrt(Erms / (ImageP.Picture.Bitmap.Height *
      ImageP.Picture.Bitmap.Width));
    {  显示灰度均方根误差  }
    editErms.Text := FloatToStr(Erms);

    //  释放资源
    StereoImg.rImg.Free;
    StereoImg.lImg.Free;
  end
  else
  begin
    //  清除图像
    ImageP.Picture.Bitmap := nil;
    ImageQ.Picture.Bitmap := nil;
    OriginP := nil;
    OriginQ := nil;

    if (not ImgHeight) then
      MessageDlg('Both Image P and Q must be 800*600!', mtError, [mbOk], 0)
    else
      if (not ImgFormat) then
        MessageDlg('Both Image P and Q must be 24bit!', mtError, [mbOk], 0);
  end;
end;

procedure TfmConvert.CreateImageP(Dis: TDistribution);
begin
  with StereoImg do
  begin
    M := sePixels.Value;
    N := seN.Value;

    {  按新的子块个数重新处理  }
    //  选择右眼视图
    rImg := nil;
    rImg := TBitmap.Create;
    rImg.Assign(ImageQ.Picture.Bitmap);

    //  生成左眼视图
    Produce_rImg(Dis);

    //  拷回ImageP
    ImageP.Picture.Bitmap.Assign(lImg);
  end;
end;

procedure TfmConvert.MergeImage(var tmpImg: TStereoImg);
begin
  with tmpImg do
  begin
    {  将两幅图像合成一副图像  }
    //  判断图像大小是否都是800*600
    if (lImg.Height = 600) and (lImg.Width = 800) and (lImg.Height = rImg.Height)
      and (lImg.Width = rImg.Width) then
      with Form1.Image.Picture.Bitmap, StereoImg do
      begin
        //  重新确定Image宽和高,StereoImg的lImg和rImg宽和高都是一样的
        Width := lImg.Width + rImg.Width;
        Height := lImg.Height;

        Canvas.Draw(0, 0, lImg);
        Canvas.Draw(lImg.Width, 0, rImg);
      end
    else
      MessageDlg('Improper image selected! Note that both left image and right image must be 800*600!', mtError, [mbOk], 0);
  end;
end;

procedure TfmConvert.sePixelsChange(Sender: TObject);
begin
  if ImageP.Picture.Bitmap.Empty or ImageQ.Picture.Bitmap.Empty then
  begin
    sePixels.Value := 0;                //  没有装载图像的情况
    seN.Value := 200;
  end
  else
  begin
    case Distribution of
      dMove:                            //  到达此处之前已装有图像
        begin
          //  恢复原始图像
          ImageP.Picture.Bitmap.Assign(OriginP);
          ImageQ.Picture.Bitmap.Assign(OriginQ);

          with ImageP do
          begin
            Canvas.CopyRect(Rect(sePixels.Value, 0, Width, Height), Canvas,
              Rect(0, 0, Width - sePixels.Value, Height));

            Canvas.Brush.Color := clBlack;
            ImageQ.Canvas.Brush.Color := clBlack;

            if sePixels.Value >= 0 then
            begin
              //  填充最左边
              Canvas.FillRect(Rect(0, 0, sePixels.Value, Height));
              ImageQ.Canvas.FillRect(Rect(0, 0, sePixels.Value, Height));
            end
            else
            begin
              //  填充最右边
              Canvas.FillRect(Rect(Width + sePixels.Value, 0, Width, Height));
              ImageQ.Canvas.FillRect(Rect(Width + sePixels.Value, 0, Width,
                Height));
            end;

          end;
        end;
      dUniform:
        CreateImageP(dUniform);
      dTriangular:
        CreateImageP(dTriangular);
      dPiecewise:
        CreateImageP(dPiecewise);
      dNormal:
        CreateImageP(dNormal);
    end;

    CalCriteria;
  end;
end;

end.

⌨️ 快捷键说明

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