graphwin.pas.~88~

这是我用Delphi和Matlab写的一个程序

unit GraphWin;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus, Jpeg, StereoImg,
  CustomizeDlg, ExtDlgs, BuildStaticModel;

type
  //  程序启动后默认取值为dtLine
  TDrawingTool = (dtNull, dtLine, dtRectangle, dtEllipse, dtRoundRect);

  T3DPoint = record
    X: Real; //  世界坐标系中的坐标
    Y: Real; //  世界坐标系中的坐标
    Z: Real; //  世界坐标系中的坐标
    //  立体图像对I1的坐标
    I1X: Integer;
    I1Y: Integer;
    //  立体图像对I2的坐标
    I2X: Integer;
    I2Y: Integer;
  end;

  TCube = record
    //  立方体的中心坐标
    cX: Real;
    cY: Real;
    cZ: Real;
    hLen: Real; //  半边长
    vertex: array[0..7] of T3DPoint; //  定义立方体的八个顶点
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    LineButton: TSpeedButton;
    RectangleButton: TSpeedButton;
    EllipseButton: TSpeedButton;
    RoundRectButton: TSpeedButton;
    PenButton: TSpeedButton;
    BrushButton: TSpeedButton;
    PenBar: TPanel;
    BrushBar: TPanel;
    SolidPen: TSpeedButton;
    DashPen: TSpeedButton;
    DotPen: TSpeedButton;
    DashDotPen: TSpeedButton;
    DashDotDotPen: TSpeedButton;
    ClearPen: TSpeedButton;
    PenWidth: TUpDown;
    PenSize: TEdit;
    StatusBar1: TStatusBar;
    ScrollBox1: TScrollBox;
    Image: TImage;
    SolidBrush: TSpeedButton;
    ClearBrush: TSpeedButton;
    HorizontalBrush: TSpeedButton;
    VerticalBrush: TSpeedButton;
    FDiagonalBrush: TSpeedButton;
    BDiagonalBrush: TSpeedButton;
    CrossBrush: TSpeedButton;
    DiagCrossBrush: TSpeedButton;
    PenColor: TSpeedButton;
    BrushColor: TSpeedButton;
    ColorDialog1: TColorDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    miStereo: TMenuItem;
    miCube: TMenuItem;
    miProc: TMenuItem;
    mi2DTo3D: TMenuItem;
    StereoImg: TStereoImg;
    miCrossEntropy: TMenuItem;
    ComboBox1: TComboBox;
    MoveRight1: TMenuItem;
    MoveLeft1: TMenuItem;
    MoveRight21: TMenuItem;
    miMergeJPS: TMenuItem;
    OpenPicDlg: TOpenPictureDialog;
    miMAXScript: TMenuItem;
    miCreateScript: TMenuItem;
    HandButton: TSpeedButton;
    Convert1: TMenuItem;
    Movingpixelswithoutstretch1: TMenuItem;
    procedure HandButtonClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LineButtonClick(Sender: TObject);
    procedure RectangleButtonClick(Sender: TObject);
    procedure EllipseButtonClick(Sender: TObject);
    procedure RoundRectButtonClick(Sender: TObject);
    procedure PenButtonClick(Sender: TObject);
    procedure BrushButtonClick(Sender: TObject);
    procedure SetPenStyle(Sender: TObject);
    procedure PenSizeChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SetBrushStyle(Sender: TObject);
    procedure PenColorClick(Sender: TObject);
    procedure BrushColorClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure miCubeClick(Sender: TObject);
    procedure mi2DTo3DClick(Sender: TObject);
    procedure miCrossEntropyClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure MoveRight1Click(Sender: TObject);
    procedure MoveLeft1Click(Sender: TObject);
    procedure MoveRight21Click(Sender: TObject);
    procedure miMergeJPSClick(Sender: TObject);
    procedure miCreateScriptClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    BrushStyle: TBrushStyle;
    PenStyle: TPenStyle;
    PenWide: Integer;
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    W, U: T3DPoint; //  立体直线的两个端点
    Pd, Od: Real; //  Pd>0是正视差，pd<0是负视差
    DrawingTool: TDrawingTool;
    CurrentFile: string;
    procedure SaveStyles;
    procedure RestoreStyles;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  end;

var
  Form1: TForm1;
  sCube: TCube;
  index: Integer;

implementation

uses BMPDlg, Clipbrd, unParaSet, unCrossEntropy, unRanVar;

{$R *.dfm}

const
  h = 3.25;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True; //  绘图
  Image.Canvas.MoveTo(X, Y); //  画笔移到鼠标处
  Origin := Point(X, Y); //  记录下当前点作为起始点
  MovePt := Origin; //  记录下当前点作为目标点
  StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [X, Y]);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, Point(X, Y), pmCopy);
    Drawing := False;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing then
  begin
    //  画图
    DrawShape(Origin, MovePt, pmNotXor);
    MovePt := Point(X, Y); //  记录下当前点作为目标点
    DrawShape(Origin, MovePt, pmNotXor);
  end;
  StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [X, Y]);
end;

procedure TForm1.LineButtonClick(Sender: TObject);
begin
  DrawingTool := dtLine;
end;

procedure TForm1.RectangleButtonClick(Sender: TObject);
begin
  DrawingTool := dtRectangle;
end;

procedure TForm1.EllipseButtonClick(Sender: TObject);
begin
  DrawingTool := dtEllipse;
end;

procedure TForm1.RoundRectButtonClick(Sender: TObject);
begin
  DrawingTool := dtRoundRect;
end;

procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  with Image.Canvas do
  begin
    Pen.Mode := AMode;
    case DrawingTool of
      dtLine:
        begin
          Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
          Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
        end;
      dtRectangle: Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
          BottomRight.Y);
      dtEllipse: Image.Canvas.Ellipse(TopLeft.X, TopLeft.Y, BottomRight.X,
          BottomRight.Y);
      dtRoundRect: Image.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
          BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
          (TopLeft.Y - BottomRight.Y) div 2);
    end;
  end;
end;

procedure TForm1.PenButtonClick(Sender: TObject);
begin
  PenBar.Visible := PenButton.Down;
end;

procedure TForm1.BrushButtonClick(Sender: TObject);
begin
  BrushBar.Visible := BrushButton.Down;
end;

procedure TForm1.SetPenStyle(Sender: TObject);
begin
  with Image.Canvas.Pen do
  begin
    if Sender = SolidPen then
      Style := psSolid
    else
      if Sender = DashPen then
        Style := psDash
      else
        if Sender = DotPen then
          Style := psDot
        else
          if Sender = DashDotPen then
            Style := psDashDot
          else
            if Sender = DashDotDotPen then
              Style := psDashDotDot
            else
              if Sender = ClearPen then
                Style := psClear;
  end;
end;

procedure TForm1.PenSizeChange(Sender: TObject);
begin
  Image.Canvas.Pen.Width := PenWidth.Position;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := nil; //  先初始化为空
  try
    Bitmap := TBitmap.Create;
    Bitmap.Width := 1600; //  两幅800*600
    Bitmap.Height := 600;
    Image.Picture.Graphic := Bitmap;
  finally
    Bitmap.Free;
  end;

end;

procedure TForm1.SetBrushStyle(Sender: TObject);
begin
  with Image.Canvas.Brush do
  begin
    if Sender = SolidBrush then
      Style := bsSolid
    else
      if Sender = ClearBrush then
        Style := bsClear
      else
        if Sender = HorizontalBrush then
          Style := bsHorizontal
        else
          if Sender = VerticalBrush then
            Style := bsVertical
          else
            if Sender = FDiagonalBrush then
              Style := bsFDiagonal
            else
              if Sender = BDiagonalBrush then
                Style := bsBDiagonal
              else
                if Sender = CrossBrush then
                  Style := bsCross
                else
                  if Sender = DiagCrossBrush then
                    Style := bsDiagCross;
  end;
end;

procedure TForm1.PenColorClick(Sender: TObject);
begin
  ColorDialog1.Color := Image.Canvas.Pen.Color;
  if ColorDialog1.Execute then
    Image.Canvas.Pen.Color := ColorDialog1.Color;
end;

procedure TForm1.BrushColorClick(Sender: TObject);
begin
  ColorDialog1.Color := Image.Canvas.Brush.Color;
  if ColorDialog1.Execute then
    Image.Canvas.Brush.Color := ColorDialog1.Color;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin