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

📄 graphwin.pas

📁 这是我用Delphi和Matlab写的一个程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  begin
    Brush.Style := BrushStyle;
    Pen.Style := PenStyle;
    Pen.Width := PenWide;
  end;
end;

{  这个过程实现将点的世界坐标系转换为图像坐标系,即计算点的立体图像对  }

procedure ConvertWCSToICS(vPd (*屏幕到眼睛所在平面的距离*): Real; var
  p3D: T3DPoint);
begin
  //  算点p3D的立体图像对的坐标
  with p3D do
  begin
    I1X := Round(((X - h) * vPd / Z) * 28.35 + 1293.14);
    //  1293.14 = 400 +800 + 3.25 * 28.35
    I1Y := Round((Y * vPd / Z) * 28.35 + 300);
    I2X := Round(((X + h) * vPd / Z) * 28.35 + 307.86);
    //  400 - 3.25 * 28.35 = 307.86
    I2Y := I1Y;
  end;
end;

procedure DrawLine(var s3D, d3D: T3DPoint);
begin
  //  绘制s3D的I2和I1,绘成圆,外接正方形边长为4个像素
  with Form1.Image.Canvas do
  begin
    with s3D do
    begin
      Ellipse(I2X - 2, I2Y - 2, I2X + 2, I2Y + 2);
      //  左眼看到的点I2,绘制在左图
      Ellipse(I1X - 2, I1Y - 2, I1X + 2, I1Y + 2);
      //  右眼看到的点I1,绘制在右图
    end;

    //  绘制d3D的I2和I1,绘成圆,外接正方形边长为4个像素
    with d3D do
    begin
      Ellipse(I2X - 2, I2Y - 2, I2X + 2, I2Y + 2);
      //  左眼看到的点I2,绘制在左图
      Ellipse(I1X - 2, I1Y - 2, I1X + 2, I1Y + 2);
      //  右眼看到的点I1,绘制在右图
    end;

    //  连接s3D的I2和d3D的I2
    MoveTo(s3D.I2X, s3D.I2Y);
    LineTo(d3D.I2X, d3D.I2Y);
    //  连接s3D的I1和d3D的I1
    MoveTo(s3D.I1X, s3D.I1Y);
    LineTo(d3D.I1X, d3D.I1Y);
  end;
end;

procedure DrawPolygon(var s1_3D, s2_3D, s3_3D, s4_3D: T3DPoint);
begin
  with Form1.Image.Canvas do
  begin
    //  填充左眼看到的面
    Polygon([Point(s1_3D.I2X, s1_3D.I2Y), Point(s2_3D.I2X, s2_3D.I2Y),
      Point(s3_3D.I2X, s3_3D.I2Y), Point(s4_3D.I2X, s4_3D.I2Y)]);
    //  填充左眼看到的面
    Polygon([Point(s1_3D.I1X, s1_3D.I1Y), Point(s2_3D.I1X, s2_3D.I1Y),
      Point(s3_3D.I1X, s3_3D.I1Y), Point(s4_3D.I1X, s4_3D.I1Y)]);
  end;

end;

////////////////////////////////////////////////////////////////////////////////////////////////////
//  图像像素单位与厘米单位对应关系:1cm = 28.35px;h = 3.25cm;
//  默认值Pd = 40cm,Od = 80cm
//  这个过程绘制立体直线,端点分别是W和U。W在世界坐标系中的坐标默认为(5cm, 5cm, 80cm),
//  对应在α平面(计算机平面)内的立体图像对为I1(4.125, 2.5, 40),I2(0.875, 2.5, 40)。U在世界
//  坐标系中的坐标为(15, 15, 80),对应在α平面内的立体图像对为K1(9.125, 7.5, 40),
//  K2(5.875, 7.5, 40)。图片尺寸为800像素*600像素。布局为左图(左眼所见)/右图(右眼所见)
//  则:I1(4.125, 2.5, 40)通过4.125×28.35=116.94375,2.5×28.35=70.875,
//  得到I1(116.94375, 70.875)取整得I1(117, 71)再加上I1x+400+800=117+1200,I1y+300=371
//  得到I1(1317, 371),(右眼所见)
//  I2(0.875, 2.5, 40)通过0.875×28.35=24.806,2.5×28.35=70.875得到I2(24.806, 70.875)
//  取整得到I2(25, 71)再加上I2x+400=117+400,I2y+300=371坐标系平移得到I2(517, 363),(左眼所见) 。
//  K1(8.75, 7.5, 40)通过8.75×28.35=240.06,7.5×28.35=212.625得到K1(240.06, 212.625)
//  取整得到K1(240, 213)加上(1200,300)像素的坐标系平移量得K1(1440,513)
//  K2(6.25, 7.5, 40) 通过6.25×28.35=177.18,7.5×28.35=212.625得K2(177.18,212.625)
//  取整得K2(177,213)加(400,300)坐标系平移K2(577,513)。
////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////
//  负视差情形
//  图像像素单位与厘米单位对应关系:1cm = 28.35px;h = 3.25cm;
//  默认值Pd = 40cm,Od = 20cm
//  这个过程绘制立体直线,端点分别是W和U。W在世界坐标系中的坐标默认为(5cm, 5cm, 20cm),
//  对应在α平面(监视器屏幕)内的立体图像对为I1(6.75, 10, 40),I2(13.25, 10, 40)。U在世界
//  坐标系中的坐标为(15, 15, 20),对应在α平面内的立体图像对为K1(26.75, 30, 40),
//  K2(33.25, 30, 40)。图片尺寸为800像素*600像素。布局为左图(左眼所见)/右图(右眼所见)
//  则:I1(6.75, 10, 40)通过6.75×28.35=191.3625,10×28.35=283.5,
//  得到I1(191.3625, 283.5)取整得I1(191, 283)再加上I1x+400+800=191+1200,I1y+300=583
//  得到I1(1391, 583),(右眼所见)
//  I2(13.25, 10, 40)通过13.25×28.35=375.6375,10×28.35=283.5得到I2(375.6375, 283.5)
//  取整得到I2(376, 283)再加上I2x+400=376+400,I2y+300=583坐标系平移得到I2(767, 583),(左眼所见) 。
//  K1(26.75, 30, 40)通过26.75×28.35=757.025,30×28.35=850.5得到K1(757.025, 850.5)
//  取整得到K1(757, 850)加上(1200,300)像素的坐标系平移量得K1(1957,1150)
//  K2(33.25, 30, 40)通过33.25×28.35=942.6375,30×28.35=850.5得K2(942.6375,850.5)
//  取整得K2(943,850)加(400,300)坐标系平移K2(1343,1150)。
////////////////////////////////////////////////////////////////////////////////////////////////////

procedure TForm1.miCubeClick(Sender: TObject);
var
  i                 : Integer;          //  循环变量
begin
  OKBottomDlg := TOKBottomDlg.Create(Self);
  OKBottomDlg.ShowModal;
  OKBottomDlg.Free;

  if U.Z = 0 then
    Exit;

  //  清除画布
  FormCreate(Sender);
  //  保存原来的Styles
  SaveStyles;
  //  设置线型、颜色
  with Image.Canvas do
  begin

    Pen.Style := psSolid;
    Pen.Width := 3;
    Brush.Color := clGray;
  end;

  with sCube do
  begin
    //  计算立方体各顶点在世界坐标系中的坐标
    //  A
    with vertex[0] do
    begin
      X := cX - hLen;
      Y := cY - hLen;
      Z := cZ - hLen;
    end;
    //  B
    with vertex[1] do
    begin
      X := cX + hLen;
      Y := cY - hLen;
      Z := cZ - hLen;
    end;
    //  C
    with vertex[2] do
    begin
      X := cX + hLen;
      Y := cY + hLen;
      Z := cZ - hLen;
    end;
    //  D
    with vertex[3] do
    begin
      X := cX - hLen;
      Y := cY + hLen;
      Z := cZ - hLen;
    end;
    //  E
    with vertex[4] do
    begin
      X := cX - hLen;
      Y := cY - hLen;
      Z := cZ + hLen;
    end;
    //  F
    with vertex[5] do
    begin
      X := cX + hLen;
      Y := cY - hLen;
      Z := cZ + hLen;
    end;
    //  G
    with vertex[6] do
    begin
      X := cX + hLen;
      Y := cY + hLen;
      Z := cZ + hLen;
    end;
    //  H
    with vertex[7] do
    begin
      X := cX - hLen;
      Y := cY + hLen;
      Z := cZ + hLen;
    end;

    //  计算各点的立体图像对
    for i := 0 to 7 do
      ConvertWCSToICS(Pd, vertex[i]);

    {  填充各个面  }
    //  填充AEHD
    DrawPolygon(vertex[0], vertex[4], vertex[7], vertex[3]);
    //  填充BFGC
    DrawPolygon(vertex[1], vertex[5], vertex[6], vertex[2]);
    //  填充AEFB
    DrawPolygon(vertex[0], vertex[4], vertex[5], vertex[1]);
    //  填充DHGC
    DrawPolygon(vertex[3], vertex[7], vertex[6], vertex[2]);
  end;

  with Image.Canvas do
  begin

    //  算点W的立体图像对的坐标
    W.I1X := Round(((W.X - h) * Pd / W.Z) * 28.35 + 1293.14);
    //  1293.14 = 400 +800 + 3.25 * 28.35
    W.I1Y := Round((W.Y * Pd / W.Z) * 28.35 + 300);
    W.I2X := Round(((W.X + h) * Pd / W.Z) * 28.35 + 307.86);
    //  400 - 3.25 * 28.35 = 307.86
    W.I2Y := W.I1Y;

    U.I1X := Round(((U.X - h) * Pd / U.Z) * 28.35 + 1293.14);
    //  1293.14 = 400 +800 + 3.25 * 28.35
    U.I1Y := Round((U.Y * Pd / U.Z) * 28.35 + 300);
    U.I2X := Round(((U.X + h) * Pd / U.Z) * 28.35 + 307.86);
    //  400 - 3.25 * 28.35 = 307.86
    U.I2Y := U.I1Y;

    {  绘制I2和I1,绘成圆,外接正方形边长为4个像素  }
    //  左眼看到的点I2,绘制在左图
    Ellipse(W.I2X - 2, W.I2Y - 2, W.I2X + 2, W.I2Y + 2);
    //  右眼看到的点I1,绘制在右图
    Ellipse(W.I1X - 2, W.I1Y - 2, W.I1X + 2, W.I1Y + 2);

    {  绘制K2和K1  }
    //  左眼看到的点K2,绘制在左图
    Ellipse(U.I2X - 2, U.I2Y - 2, U.I2X + 2, U.I2Y + 2);
    //  右眼看到的点K1,绘制在右图
    Ellipse(U.I1X - 2, U.I1Y - 2, U.I1X + 2, U.I1Y + 2);

    //  连接I2和K2
    MoveTo(W.I2X, W.I2Y);
    LineTo(U.I2X, U.I2Y);

    //  连接I1和K1
    MoveTo(W.I1X, W.I1Y);
    LineTo(U.I1X, U.I1Y);
  end;

  //  恢复原来的Styles
  RestoreStyles;
end;

procedure TForm1.miGrayClick(Sender: TObject);
var
  X, Y              : Integer;          //  循环变量
  Row               : PByteArray; //  A line of pixels. 指向TByteArray的指针
  Gray              : Integer;          //  像素点的灰度值
begin
  with Image.Picture.Bitmap do
  begin
    if PixelFormat <> pf24bit then
    begin
      MessageDlg('当前图像不是24位的位图,程序将自动转换为24位的位图',
        mtWarning,
        [mbOK], 0);
      PixelFormat := pf24bit;
    end;

    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.
        try
          Gray := Round(Row[X * 3 + 2] * 0.3 + Row[X * 3 + 1] * 0.59 + Row[X *
            3] * 0.11);                 //  delphi中三原色排列顺序:RGB

          //  变为灰度图
          Row[X * 3 + 2] := Gray;
          Row[X * 3 + 1] := Gray;
          Row[X * 3] := Gray;
        except on E: Exception do
            MessageDlg(E.Message, mtError, [mbOk], 0);
        end;
      end;
    end;
  end;

  Image.Repaint;
end;

procedure TForm1.miNormalClick(Sender: TObject);
begin
  fmConvert := TfmConvert.Create(Self);

  //  禁用、使能相应的控件
  with fmConvert do
  begin
    Distribution := dNormal;            //  指定使用均匀分布
    btnLoadP.Visible := False;

    Caption := 'Normal Distribution';
    ShowModal;
    Free;
  end;
end;

procedure TForm1.miMergeImgClick(Sender: TObject);
begin
  fmConvert := TfmConvert.Create(Self);

  //  禁用、使能相应的控件
  with fmConvert do
  begin
    btnLoadP.Visible := True;
    sePixels.Visible := False;
    MarkLbl.Visible := False;
    BakLbl.Visible := False;
    seN.Visible := False;
    Merge := True;

    Caption := 'Merge Image';
    ShowModal;
    Free;                               //  用Free就算没有创建也不出错
  end;

end;

procedure TForm1.miAboutClick(Sender: TObject);
begin
  AboutBox := TAboutBox.Create(Self);

  with AboutBox do
  begin
    ShowModal;
    Free;
  end;
end;

procedure TForm1.miCreateScriptClick(Sender: TObject);
begin
  {  禁用Image的绘图功能  }
  Image.Enabled := False;

  {  打开生成静态立体图像对的脚本设置对话框  }
  fmStaticStereo := TfmStaticStereo.Create(Self);
  fmStaticStereo.ShowModal;
  fmStaticStereo.Free;
end;

procedure TForm1.HandButtonClick(Sender: TObject);
begin
  DrawingTool := dtNull;
end;

procedure TForm1.miMoveClick(Sender: TObject);
begin
  fmConvert := TfmConvert.Create(Self);

  //  禁用、使能相应的控件
  with fmConvert do
  begin
    Distribution := dMove;
    btnLoadP.Visible := False;

    with sePixels do
    begin
      MinValue := -13;
      MaxValue := 13;
      Value := 0;
    end;

    seN.Visible := False;
    MarkLbl.Caption := '图像右移像素:';
    MarkLbl.Visible := True;
    BakLbl.Caption := '图像右移像素:';
    BakLbl.Visible := True;
    lblCrossBack.Visible := False;
    lblCrossFront.Visible := False;

    Caption := 'Move Pixels without Stretch';
    ShowModal;
    Free;
  end;

end;

procedure TForm1.miPiecewiseClick(Sender: TObject);
begin
  fmConvert := TfmConvert.Create(Self);

  //  禁用、使能相应的控件
  with fmConvert do
  begin
    Distribution := dPiecewise;         //  指定使用均匀分布
    btnLoadP.Visible := False;

    Caption := 'Piecewise Uniform Distribution';
    ShowModal;
    Free;
  end;
end;

procedure TForm1.miRectificationClick(Sender: TObject);
var
  sCurDir           : string;
begin
  DM := TDM.Create(Self);

  try
    try
      {  打开默认的数据库  }
      //  获得数据库文件所在路径
      sCurDir := ExtractFilePath(Application.ExeName) + 'Data\Points.mdb;';
      //  连接数据库
      with DM.ADOTable do
      begin
        Active := False;
        ConnectionString :=
          'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sCurDir +
          'Persist Security Info=False';
        //  打开默认的表
        TableName := 'FtrPnts';
        Active := True;
      end;

      fmRectification := TfmRectification.Create(Self);
      fmRectification.ShowModal;
      fmRectification.Free;
    except on E: Exception do
        MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  finally
    DM.ADOTable.Active := False;
    DM.Free;
  end;

end;

procedure TForm1.miSaveClick(Sender: TObject);
begin
  Save1Click(Sender);
end;

procedure TForm1.miSplitClick(Sender: TObject);
begin
  if not Image.Picture.Bitmap.Empty then
  begin
    fmSplit := TfmSplit.Create(Self);

    //  当Autosize为True时, TImage随着TBitmap变
    with fmSplit.ImageP.Picture.Bitmap do
    begin
      //  先确定将要生成的图像的大小
      Width := Round(Image.Width / 2);
      Height := Image.Height;
      Canvas.CopyRect(Rect(0, 0, Width, Height), Image.Canvas, Rect(0, 0, Width,
        Height));
    end;

    with fmSplit.ImageQ.Picture.Bitmap do
    begin
      //  先确定将要生成的图像的大小
      Width := Image.Width - fmSplit.ImageP.Picture.Bitmap.Width;
      Height := Image.Height;
      Canvas.CopyRect(Rect(0, 0, Width, Height), Image.Canvas,
        Rect(fmSplit.ImageP.Width, 0, Image.Width, Height));
    end;

    fmSplit.ShowModal;
    fmSplit.Free;
  end
  else
    MessageDlg('Please select a stereo image in BMP format!', mtWarning, [mbOK],
      0);
end;

procedure TForm1.miTriangularClick(Sender: TObject);
begin
  fmConvert := TfmConvert.Create(Self);

  //  禁用、使能相应的控件
  with fmConvert do
  begin
    Distribution := dTriangular;        //  指定使用均匀分布
    btnLoadP.Visible := False;

    Caption := 'Triangular Distribution';
    ShowModal;
    Free;
  end;
end;

procedure TForm1.miUniformClick(Sender: TObject);
begin
  fmConvert := TfmConvert.Create(Self);

  //  禁用、使能相应的控件
  with fmConvert do
  begin
    Distribution := dUniform;           //  指定使用均匀分布
    btnLoadP.Visible := False;

    Caption := 'Uniform Distribution';
    ShowModal;
    Free;
  end;
end;

end.

⌨️ 快捷键说明

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