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

📄 graphwin.pas.~93~

📁 这是我用Delphi和Matlab写的一个程序
💻 ~93~
📖 第 1 页 / 共 2 页
字号:
🔍
12 
    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.mi2DTo3DClick(Sender: TObject);
var
  i, j, k: Integer; //  循环变量
  tmpS: string;
  Dir, Fold: string;
begin
  with StereoImg do
  begin
    //  选择原图像
    lImg := TBitmap.Create;
    if OpenDialog1.Execute then
    begin
      CurrentFile := OpenDialog1.FileName;
      lImg.LoadFromFile(CurrentFile);
      Dir := ExtractFileDir(CurrentFile);
      Fold := Dir + '\2DTo3D';
      if not DirectoryExists(Fold) then
        mkDir(Fold);
      //  生成右眼视图
      // Produce_rImg;
      for k := 1 to 10 do
      begin
        Produce_rImg(index);
        {  保存生成的右眼视图  }
        case index of
          0: CurrentFile := Fold + '\junyun' + IntToStr(M) + '_' + IntToStr(N) +
            '_' + IntToStr(100 + k) + '.bmp';
          1: CurrentFile := Fold + '\zhengtai' + IntToStr(M) + '_' + IntToStr(N)
            + '_' + IntToStr(100 + k) + '.bmp';
          2: CurrentFile := Fold + '\sanjiao' + IntToStr(M) + '_' + IntToStr(N)
            +
              '_' + IntToStr(100 + k) + '.bmp';
          3: CurrentFile := Fold + '\fenduan' + IntToStr(M) + '_' + IntToStr(N)
            +
              '_' + IntToStr(100 + k) + '.bmp';
          4: CurrentFile := Fold + '\hist' + IntToStr(M) + '_' + IntToStr(N) +
            '_' + IntToStr(100 + k) + '.bmp';
        end;
        rImg.SaveToFile(CurrentFile);
      end;
    end;
    //  显示随机变量矩阵
    fmRanVar := TfmRanVar.Create(Self);
    with fmRanVar do
    begin
      reKmn.Lines.Clear;
      for i := 0 to M - 1 do
      begin
        tmpS := '';
        for j := 0 to N - 1 do
          tmpS := tmpS + FloatToStr(Kmn[i, j]) + '     ';
        reKmn.Lines.Add(tmpS);
        reKmn.Lines.Add('');
      end;
      ShowModal;
      Free;
    end;
    {  以下代码将两幅图像合成一副bmp  }
    with Image, 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;
    //  释放所占资源
    lImg.Free;
    rImg.Free; //  用Free就算没有创建也不出错
  end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  index := ComboBox1.ItemIndex;
end;

//将左图向左移得到右图

procedure TForm1.MoveLeft1Click(Sender: TObject);
var
  left: Integer;
  lImg, rImg, tImg: TBitmap;
  Dir, Fold: string;
  // FillColor:TColor;
begin
  lImg := TBitmap.Create;
  rImg := TBitmap.Create;
  tImg := TBitmap.Create;
  if OpenDialog1.Execute then
  begin
    CurrentFile := OpenDialog1.FileName;
    tImg.LoadFromFile(CurrentFile);
    Dir := ExtractFileDir(CurrentFile);
    Fold := Dir + '\MoveLeft';
    if not DirectoryExists(Fold) then
      mkDir(Fold);
    lImg.Assign(tImg);
    rImg.Width := tImg.Width;
    rImg.Height := tImg.Height;
    rImg.PixelFormat := tImg.PixelFormat;
    for left := 1 to 40 do
    begin
      //left:= StrtoInt(InputBox('Move Left','Please Input the piexl number','0'));
      rImg.Canvas.CopyRect(Rect(0, 0, rImg.Width - left, rImg.Height),
        tImg.Canvas, Rect(left, 0, tImg.Width, tImg.Height));
      rImg.Canvas.Brush.Color := clblack; //用黑色填充最右边
      lImg.Canvas.Brush.Color := clblack;
      rImg.Canvas.FillRect(Rect(rImg.Width - left, 0, rImg.Width, rImg.Height));
      lImg.Canvas.FillRect(Rect(lImg.Width - left, 0, lImg.Width, lImg.Height));
      //分别保存左右图
      CurrentFile := Fold + '\left' + IntToStr(left) + '.bmp';
      lImg.SaveToFile(CurrentFile);
      CurrentFile := Fold + '\right' + IntToStr(left) + '.bmp';
      rImg.SaveToFile(CurrentFile);
      //lImg.Assign(tImg);
    end;
  end;
  //  以下代码将两幅图像合成一副bmp
  with Image do
  begin
    //  重新确定Image宽和高，StereoImg的lImg和rImg宽和高都是一样的
      //Picture.Bitmap.Width:= lImg.Width + rImg.Width;
    Width := lImg.Width + rImg.Width;
    Height := lImg.Height;
    Canvas.Draw(0, 0, lImg);
    Canvas.Draw(lImg.Width, 0, rImg);
  end;
  lImg.Free;
  rImg.Free;
  tImg.Free;
end;

procedure TForm1.MoveRight21Click(Sender: TObject);
var
  right: Integer;
  lImg, rImg, tImg: TBitmap;
  Dir, Fold: string;
begin
  lImg := TBitmap.Create;
  rImg := TBitmap.Create;
  tImg := TBitmap.Create;
  if OpenDialog1.Execute then
  begin
    CurrentFile := OpenDialog1.FileName;
    tImg.LoadFromFile(CurrentFile);
    Dir := ExtractFileDir(CurrentFile);
    Fold := Dir + '\MoveRight2';
    if not DirectoryExists(Fold) then
      mkDir(Fold);
    //right:= StrtoInt(InputBox('Move Right','Please Input the piexl number','0'));
    for right := 1 to 40 do
    begin
      lImg.Width := tImg.Width - right;
      lImg.Height := tImg.Height;
      lImg.PixelFormat := tImg.PixelFormat;
      rImg.Width := tImg.Width - right;
      rImg.Height := tImg.Height;
      rImg.PixelFormat := tImg.PixelFormat;
      lImg.Canvas.CopyRect(Rect(0, 0, lImg.Width, lImg.Height), tImg.Canvas,
        Rect(0, 0, tImg.Width - right, tImg.Height));
      rImg.Canvas.CopyRect(Rect(0, 0, rImg.Width, rImg.Height), tImg.Canvas,
        Rect(right, 0, tImg.Width, tImg.Height));
      //分别保存左右图
      CurrentFile := Fold + '\left' + IntToStr(right) + '.bmp';
      lImg.SaveToFile(CurrentFile);
      CurrentFile := Fold + '\right' + IntToStr(right) + '.bmp';
      rImg.SaveToFile(CurrentFile);
    end;
  end;
  {  以下代码将两幅图像合成一副bmp  }
  with Image do
  begin
    //  重新确定Image宽和高，StereoImg的lImg和rImg宽和高都是一样的
    Picture.Bitmap.Width := lImg.Width + rImg.Width;
    //Width := lImg.Width + rImg.Width;
    Picture.Bitmap.Height := lImg.Height;
    Canvas.Draw(0, 0, lImg);
    Canvas.Draw(lImg.Width, 0, rImg);
  end;
  lImg.Free;
  tImg.Free;
  rImg.Free;
end;

procedure TForm1.MoveRight1Click(Sender: TObject);
var
  right: Integer;
  lImg, rImg, tImg: TBitmap;
  Dir, Fold: string;
  // FillColor:TColor;
begin
  lImg := TBitmap.Create;
  rImg := TBitmap.Create;
  tImg := TBitmap.Create;
  if OpenDialog1.Execute then
  begin
    CurrentFile := OpenDialog1.FileName;
    tImg.LoadFromFile(CurrentFile);
    Dir := ExtractFileDir(CurrentFile);
    Fold := Dir + '\MoveRight';
    if not DirectoryExists(Fold) then
      mkDir(Fold);
    rImg.Assign(tImg);
    //lImg.Width:=tImg.Width;
    //lImg.Height:=tImg.Height;
    //lImg.PixelFormat:=tImg.PixelFormat;
    lImg.Width := tImg.Width;
    lImg.Height := tImg.Height;
    lImg.PixelFormat := tImg.PixelFormat;
    for right := 1 to 40 do
    begin
      lImg.Canvas.CopyRect(Rect(right, 0, lImg.Width, lImg.Height), tImg.Canvas,
        Rect(0, 0, tImg.Width - right, tImg.Height));
      rImg.Canvas.Brush.Color := clblack; //用黑色填充最右边
      lImg.Canvas.Brush.Color := clblack;
      rImg.Canvas.FillRect(Rect(0, 0, right, rImg.Height));
      lImg.Canvas.FillRect(Rect(0, 0, right, lImg.Height));
      //分别保存左右图
      CurrentFile := Fold + '\left' + IntToStr(right) + '.bmp';
      lImg.SaveToFile(CurrentFile);
      CurrentFile := Fold + '\right' + IntToStr(right) + '.bmp';
      rImg.SaveToFile(CurrentFile);
      //lImg.Assign(tImg);
    end;
  end;
  //  以下代码将两幅图像合成一副bmp
  with Image do
  begin
    //  重新确定Image宽和高，StereoImg的lImg和rImg宽和高都是一样的
      //Picture.Bitmap.Width:= lImg.Width + rImg.Width;
    Width := lImg.Width + rImg.Width;
    Height := lImg.Height;
    Canvas.Draw(0, 0, lImg);
    Canvas.Draw(lImg.Width, 0, rImg);
  end;
  lImg.Free;
  rImg.Free;
  tImg.Free;
end;

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

  with StereoImg do
  begin
    {  借用StereoImg控件暂存两幅图像  }
    lImg := TBitmap.Create;
    rImg := TBitmap.Create;

    {  选择左眼视图  }
    if OpenPicDlg.Execute then
      lImg.LoadFromFile(OpenPicDlg.FileName);

    {  选择右眼视图  }
    if OpenPicDlg.Execute then
      rImg.LoadFromFile(OpenPicDlg.FileName);

    {  将两幅图像合成一副图像  }
     //  判断图像大小是否都是800*600
    if (lImg.Height = 600) and (lImg.Width = 800) and (lImg.Height = rImg.Height)
      and (lImg.Width = rImg.Width) then
      with Image, 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('No image selected or improper image selected! Both left image and right image must be 800*600!', mtError, [mbOk], 0);

    {  释放借用的变量  }
    lImg.Free;
    rImg.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);
  fmConvert.ShowModal;
  fmConvert.Free;
end;

end.
12

⌨️ 快捷键说明

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