u_main.~pas

对绘图工作者

unit U_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, ImgList, StdActns, ActnList, ExtCtrls;

type
  TF_main = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileNewItem: TMenuItem;
    FileOpenItem: TMenuItem;
    FileSaveItem: TMenuItem;
    FileSaveAsItem: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    ActionList1: TActionList;
    FileNew1: TAction;
    FileOpen1: TAction;
    FileSave1: TAction;
    FileSaveAs1: TAction;
    FileExit1: TAction;
    ImageList1: TImageList;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    StatusBar: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    b_line: TToolButton;
    ToolButton3: TToolButton;
    b_curve: TToolButton;
    ToolButton4: TToolButton;
    b_retangle: TToolButton;
    ToolButton6: TToolButton;
    b_roundRetangle: TToolButton;
    ToolButton8: TToolButton;
    b_polygon: TToolButton;
    ToolButton10: TToolButton;
    b_ellipse: TToolButton;
    ToolButton12: TToolButton;
    b_round: TToolButton;
    ToolBar2: TToolBar;
    b_boundFill: TToolButton;
    ToolButton17: TToolButton;
    b_floodFill: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    b_cardinal: TToolButton;
    ToolButton24: TToolButton;
    b_bazier: TToolButton;
    b_retangleCut: TToolButton;
    ToolButton29: TToolButton;
    ToolButton30: TToolButton;
    b_transform: TToolButton;
    ToolButton34: TToolButton;
    ToolBar3: TToolBar;
    b_getColor: TToolButton;
    ToolButton37: TToolButton;
    ToolButton41: TToolButton;
    b_setColor: TToolButton;
    ToolButton43: TToolButton;
    b_erase: TToolButton;
    ToolButton45: TToolButton;
    b_clean: TToolButton;
    ColorDialog1: TColorDialog;
    draw: TMenuItem;
    D_rePaint: TMenuItem;
    D_backup: TMenuItem;
    Image1: TImage;
    PaintBox1: TPaintBox;
    procedure FileNew1Execute(Sender: TObject);
    procedure FileOpen1Execute(Sender: TObject);
    procedure FileSave1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
    procedure b_lineClick(Sender: TObject);
    procedure b_curveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure b_retangleClick(Sender: TObject);
    procedure b_roundRetangleClick(Sender: TObject);
    procedure b_polygonClick(Sender: TObject);
    procedure b_ellipseClick(Sender: TObject);
    procedure b_roundClick(Sender: TObject);
    procedure b_cardinalClick(Sender: TObject);
    procedure b_bazierClick(Sender: TObject);
    procedure b_boundFillClick(Sender: TObject);
    procedure b_floodFillClick(Sender: TObject);
    procedure b_retangleCutClick(Sender: TObject);
    procedure b_transformClick(Sender: TObject);
    procedure b_setColorClick(Sender: TObject);
    procedure b_getColorClick(Sender: TObject);
    procedure b_eraseClick(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure D_rePaintClick(Sender: TObject);
    procedure D_backupClick(Sender: TObject);
  private
    { Private declarations }
    xFrom,yFrom,xTo,yTo: integer;//起点的x,y,终点的x,y
    polygonFirst:boolean;//开始画多边形
    downBegin:boolean;//开始按下
    curveNum: integer;//输入曲线上的点数

    downButton: TToolButton;//当前已经下陷的按钮
    procedure setButtonDown(b: TToolButton);//设置按钮下陷  
  public
    { Public declarations }
  end;

var
  F_main: TF_main;
  drawRect,backupRect:TRect;//画图区域和备份区域
  setRect,destRect:TRect;//选定区域,目标区域


implementation
  uses u_function{提供一些画图的函数},u_setCurve{曲线设置对话框},
        u_setTransform{设置坐标变换};

{$R *.dfm}

{**************************************************
*辅助函数部分
*****************************************************}
procedure TF_main.setButtonDown(b: TToolButton);//设置按钮下陷
begin
    downButton.Down:=false;//弹起上次按钮
    downButton :=b;//记录当前按钮
    downButton.Down:= true;//按下当前按钮
end;

{**************************************************
*系统函数部分
*****************************************************}
{初始化}
procedure TF_main.FormCreate(Sender: TObject);
begin
    downButton :=b_line;//默认为画直线
    setButtonDown(downButton);//按钮下陷
    PaintBox1.Canvas.Pen.Color:= clBlack;//默认为黑色
    StatusBar.Color := clBlack;   //状态栏的颜色与画笔颜色一样
    //pmXor表示画笔颜色Xor画布颜色，pmNotXor表示与pmXor颜色相反
    PaintBox1.Canvas.Pen.Mode := pmNotXor ;
    
    drawRect := PaintBox1.ClientRect; //画图区域
    backupRect := Image1.ClientRect ; //备份区域
end;

{**************************************************
*文件操作部分
***************************************************}
{新建文件}
procedure TF_main.FileNew1Execute(Sender: TObject);
begin
  clear;//清空绘图区
end;
{打开文件}
procedure TF_main.FileOpen1Execute(Sender: TObject);
begin
  backup; //暂存图像
  OpenDialog.Filter:= '位图文件|*.bmp';
  if OpenDialog.Execute then //打开打开对话框
  begin
    openfile(OpenDialog.FileName);    //从指定位置载入图像
  end
  else
    repaint;//如果没有打开图像要重画原来的图像
end;
{保存文件}
procedure TF_main.FileSave1Execute(Sender: TObject);
begin
  backup; //暂存图像
  SaveDialog.Filter:= '位图文件|*.bmp';
  if SaveDialog.Execute then   //打开保存对话框
  begin
    repaint;//重画
    saveFile(SaveDialog.FileName+'.bmp'); //保存图像到指定位置
  end;
end;
{退出}
procedure TF_main.FileExit1Execute(Sender: TObject);
begin
  Close;
end;

{**********************************************************
* 画图菜单部分
************************************************************}
{及时刷新}
procedure TF_main.D_rePaintClick(Sender: TObject);
begin
  rePaint;//重画
end;
{暂存图像}
procedure TF_main.D_backupClick(Sender: TObject);
begin
  backup;//暂存
end;

{**************************************************
*按钮事件部分：选择画图类型
***************************************************}
{画直线}
procedure TF_main.b_lineClick(Sender: TObject);
begin
  setButtonDown(b_line);  //按钮下陷
end;
{画曲线}
procedure TF_main.b_curveClick(Sender: TObject);
begin
   setButtonDown(b_curve);//按钮下陷
end;
{画矩形}
procedure TF_main.b_retangleClick(Sender: TObject);
begin
    setButtonDown(b_retangle);  //按钮下陷
end;
{画圆角矩形}
procedure TF_main.b_roundRetangleClick(Sender: TObject);
begin
    setButtonDown(b_roundRetangle);  //按钮下陷
end;
{画多边形}
procedure TF_main.b_polygonClick(Sender: TObject);
begin
    setButtonDown(b_polygon);  //按钮下陷
    polygonFirst:= true; //开始画多边形
end;
{画椭圆}
procedure TF_main.b_ellipseClick(Sender: TObject);
begin
    setButtonDown(b_ellipse);  //按钮下陷
end;
{画圆}
procedure TF_main.b_roundClick(Sender: TObject);
begin
    setButtonDown(b_round);  //按钮下陷
end;


{画插值曲线}
procedure TF_main.b_cardinalClick(Sender: TObject);
begin
    setButtonDown(b_cardinal);  //按钮下陷
    backup;//暂时备份
    f_setCurve.Show;//显示曲线设置对话框
    repaint;//刷新
    curveNum:= 0;//初始时无输入点
end;
{画逼近曲线}
procedure TF_main.b_bazierClick(Sender: TObject);
begin
    setButtonDown(b_bazier);  //按钮下陷
    backup;//暂时备份
    f_setCurve.Show;//显示曲线设置对话框
    repaint;//刷新
    curveNum:= 0;//初始时无输入点
end;
{边界填充}
procedure TF_main.b_boundFillClick(Sender: TObject);
begin
    setButtonDown(b_boundFill);  //按钮下陷

end;
{泛滥填充}
procedure TF_main.b_floodFillClick(Sender: TObject);
begin
    setButtonDown(b_floodFill);  //按钮下陷

end;
{多边形裁剪}
procedure TF_main.b_retangleCutClick(Sender: TObject);
begin
    setButtonDown(b_retangleCut);  //按钮下陷
end;

{坐标变换}
procedure TF_main.b_transformClick(Sender: TObject);
begin
    setButtonDown(b_transform);  //按钮下陷
    backup;//暂时备份
    f_setTransform.Show; //设置坐标变换
    repaint;//恢复
end;

{设置颜色}
procedure TF_main.b_setColorClick(Sender: TObject);
begin
//    setButtonDown(b_setColor);  //按钮下陷
    backup;//暂存图像
    {设定当前颜色}
    ColorDialog1.Execute;  //颜色对话框
    PaintBox1.Canvas.Pen.Color :=ColorDialog1.Color;  //设置画笔颜色
    StatusBar.Color := PaintBox1.Canvas.Pen.Color;   //状态栏的颜色与画笔颜色一样
    repaint;//重画
end;
{获得指定点的颜色}
procedure TF_main.b_getColorClick(Sender: TObject);
begin
    setButtonDown(b_getColor);  //按钮下陷
end;