graphic.pas

画图程序 通过DEPHI 实现画图板的功能

unit Graphic;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, ToolWin, ComCtrls, StdCtrls, Buttons, Jpeg,
  ImgList;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    miFile: TMenuItem;
    miNew: TMenuItem;
    miOpen: TMenuItem;
    miSave: TMenuItem;
    miSaveY: TMenuItem;
    miSaveZ: TMenuItem;
    N2: TMenuItem;
    miExit: TMenuItem;
    V1: TMenuItem;
    I1: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar4: TToolBar;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    BitBtn_line: TBitBtn;
    BitBtn_circle: TBitBtn;
    ColorBox1: TColorBox;
    Edit1: TEdit;
    BitBtn_rect: TBitBtn;
    BitBtn_ellips: TBitBtn;
    BitBtn_: TBitBtn;
    BitBtn_fill: TBitBtn;
    BitBtn_move: TBitBtn;
    BitBtn_del: TBitBtn;
    BitBtn_clear: TBitBtn;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    miTransportBmp: TMenuItem;
    miTransportJpeg: TMenuItem;
    N3: TMenuItem;
    miTransportSL: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    N1: TMenuItem;
    loadSL: TMenuItem;
    loadBmp: TMenuItem;
    loadJpeg: TMenuItem;
    Label1: TLabel;
    ImageList1: TImageList;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    H1: TMenuItem;
    A1: TMenuItem;
    D1: TMenuItem;
    L1: TMenuItem;
    R1: TMenuItem;
    E1: TMenuItem;
    C1: TMenuItem;
    N8: TMenuItem;
    F1: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
   
    procedure FormCreate(Sender: TObject);

    //procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
    //  Shift: TShiftState; X, Y: Integer);

    //procedure memo1MouseDown(Sender: TObject; Button: TMouseButton;
    //  Shift: TShiftState; X, Y: Integer);

    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure BitBtn_lineClick(Sender: TObject);
    procedure BitBtn_rectClick(Sender: TObject);
    procedure BitBtn_ellipsClick(Sender: TObject);
    procedure BitBtn_circleClick(Sender: TObject);

    procedure ColorBox1Change(Sender: TObject);
    procedure BitBtn_fillClick(Sender: TObject);
    procedure BitBtn_moveClick(Sender: TObject);
    procedure BitBtn_delClick(Sender: TObject);
    procedure BitBtn_clearClick(Sender: TObject);
    //-------------------------------------------------
    procedure drawLine(topLeft: TPoint; bottomRight: TPoint);//me
    procedure drawRect(topLeft: TPoint; bottomRight: TPoint);//me
    procedure drawEllips(topLeft,bottomRight:TPoint);
    procedure drawCircle(centreP,edgeP:TPoint);
    procedure preMove(myPoint:TPoint);
    procedure realMoveLine(myPoint:TPoint);
    procedure realMoveRect(myPoint:TPoint);
    procedure realMoveEllips(myPoint:TPoint);
    procedure realMoveCircle(myPoint:TPoint);
    procedure realClear;
    procedure preDel(myPoint:TPoint);
    procedure preFill(myPoint:TPoint);
    procedure saveToMyFile(outFileName:String);
    procedure loadFromMyFile(inFileName:string);

    function prepare(myPoint,firstPoint,secondPoint:TPoint):boolean;
    function prepareRect(myPoint,firstPoint,secondPoint:TPoint):boolean;
    function prepareEllips(myPoint,firstPoint,secondPoint:TPoint):boolean;
    function prepareCircle(myPoint,centrePoint,edgePoint:TPoint):boolean;

    //procedure BitBtn_Click(Sender: TObject);

    procedure miTransportBmpClick(Sender: TObject);
    procedure miTransportJpegClick(Sender: TObject);
    procedure miTransportSLClick(Sender: TObject);
    procedure loadSLClick(Sender: TObject);
    //procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure miExitClick(Sender: TObject);
    procedure miOpenClick(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure miNewClick(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure miSaveYClick(Sender: TObject);
    procedure miSaveZClick(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure F1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure ToolButton11Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);



  private
    { Private declarations }
  public
    { Public declarations }
  end;

type myDraw=(null,myLine,myRect,myEllips,myCircle); 
type pLine=^recordLine;
     recordLine=record
     originP,finalP:TPoint;
     lineColor:TColor;
     next:pLine;
     end;
type pRect=^recordRect;
     recordRect=record
     originP,finalP:TPoint;
     rectColor:TColor;
     fillColor:TColor;
     next:pRect;
     end;
type pEllips=^recordEllips;
     recordEllips=record
     originP,finalP:TPoint;
     ellipsColor:TColor;
     fillColor:TColor;
     next:pEllips;
     end;
type pCircle=^recordCircle;
     recordCircle=record
     centreP,edgeP:TPoint;
     circleColor:TColor;
     fillColor:TColor;
     next:pCircle;
     end;

var
  Form1: TForm1;
  drawing,filling,moving,deling: Boolean;
  movingLine,movingRect,movingEllips,movingCircle:Boolean;
  myDrawStart:myDraw;

  origin,movePt:TPoint;

  //intNumberLine: Integer;

  itsLine,firstLine,lastLine,dLine:pLine;
  itsRect,firstRect,lastRect,dRect:pRect;
  itsEllips,firstEllips,lastEllips,dEllips:pEllips;
  itsCircle,firstCircle,lastCircle,dCircle:pCircle;

implementation

uses Unit2;

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);
//var
//  fWidth:integer;
begin
  if(screen.Width =1024) then
  begin
    {fWidth:=width;
    scaled:=true;
    font.Size :=(width div fWidth)*font.Size ;
    BitBtn_clear.Left:=longint(bitbtn_clear.Left)*longint(screen.width)div 800;
    BitBtn_clear.Top :=longint(bitbtn_clear.Top )*longint(screen.height)div 600;

    ScaleBy(screen.Width ,800);
    Height:=longInt(Height)*longInt(Screen.height)div 600;
    Width:=longInt(Width)*longInt(Screen.width) div 800;
    }
    ToolBar4.Width:=999;
    ToolBar4.Height:=26;
    ToolBar4.Left :=9;
    ToolBar4.Top :=0;

    scrollBox1.Width:=856;
    ScrollBox1.Height :=621;
    ScrollBox1.Left :=5;
    ScrollBox1.Top :=35;

    Image1.Width :=841;
    Image1.Height :=606;
    Image1.Left :=5;
    Image1.Top :=5;

    Edit1.Width :=856;
    Edit1.Height :=21;
    edit1.Left :=5;
    edit1.Top :=665;

    Label1.Width :=136;
    Label1.Height :=21;
    Label1.Left :=875;
    label1.Top :=665;

    ColorBox1.Width :=146;
    ColorBox1.Height :=22;
    ColorBox1.Left :=870;
    ColorBox1.Top :=5;

    BitBtn_line.Width :=66;
    BitBtn_line.Height :=26;
    BitBtn_line.Left :=870;
    BitBtn_line.Top :=35;

    BitBtn_rect.Width :=66;
    BitBtn_rect.Height :=26;
    BitBtn_rect.Left :=870;
    BitBtn_rect.Top :=70;

    BitBtn_ellips.Width :=66;
    BitBtn_ellips.Height :=26;
    BitBtn_ellips.Left :=870;
    BitBtn_ellips.Top :=105;

    BitBtn_circle.Width :=66;
    BitBtn_circle.Height :=26;
    BitBtn_circle.Left:= 870;
    BitBtn_circle.Top :=140;

    BitBtn_fill.Width :=66;
    BitBtn_fill.Height :=26;
    BitBtn_fill.Left :=870;
    BitBtn_fill.Top :=175;

    BitBtn_move.Width :=66;
    BitBtn_move.Height :=26;
    BitBtn_move.Left :=870;
    BitBtn_move.Top :=210;

    BitBtn_del.Width :=66;
    BitBtn_del.Height :=26;
    BitBtn_del.Left :=870;
    BitBtn_del.Top:=245;

    BitBtn_clear.Width :=66;
    BitBtn_clear.Height :=26;
    BitBtn_clear.Left :=870;
    BitBtn_clear.Top :=280;

  end;

  //start_line:=false;

  image1.Canvas.Brush.Style:=bsClear;
  image1.Canvas.Pen.Color :=colorbox1.Selected;

  drawing:=false;
  filling:=false;
  moving:=false;
  deling:=false;

  movingLine:=false;
  movingRect:=false;
  movingEllips:=false;
  movingCircle:=false;

  edit1.Text :='请选择操作类型：选择下拉菜单或者操作按钮';

  new(itsLine);
  itsLine^.next:=nil;
  firstLine:=itsLine ;  //<<<<<<<<<<<<<
  lastLine:=itsLine;
  //firstLine^.originP:=Point(0,0);
  //firstLine^.finalP:=Point(0,0);

  new(itsRect);
  firstRect:=itsRect;
  lastRect:=itsRect;
  itsRect^.next:=nil;

  new(itsEllips);
  firstEllips:=itsEllips;
  lastEllips:=itsEllips;
  itsEllips^.next :=nil;

  new(itsCircle);
  firstCircle:=itsCircle;
  lastCircle:=itsCircle;
  itsCircle^.next :=nil;

end;

procedure TForm1.BitBtn_lineClick(Sender: TObject);
begin
  myDrawStart:=myLine;
  filling:=false;
  moving:=false;
  deling:=false;

  edit1.Text :='绘制直线：拾取起始点（按下鼠标左键）';
  //itsLine:=lastLine; //Now, no use.
  //start_line:=true;
  //canvas.MoveTo(50,50); // Wrong

  //image1.Canvas.Pen.Color :=clBlue;
end;

procedure TForm1.BitBtn_rectClick(Sender: TObject);
begin
  myDrawStart:=myRect;
  filling:=false;
  moving:=false;
  deling:=false;

  edit1.Text :='绘制矩形：拾取起始点（按下鼠标左键）';
end;

procedure TForm1.BitBtn_ellipsClick(Sender: TObject);
begin
  myDrawStart:=myEllips;
  filling:=false;
  moving:=false;
  deling:=false;

  edit1.Text :='绘制椭圆：拾取起始点（按下鼠标左键）';
end;

procedure TForm1.BitBtn_circleClick(Sender: TObject);
begin
  myDrawStart:=myCircle;
  //start_line:=false;
  filling:=false;
  moving:=false;
  deling:=false;

  edit1.Text :='绘制圆：拾取圆心（按下鼠标左键）';
end;





procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button=mbLeft then
  begin
    drawing:=true;
    image1.Canvas.Pen.Color :=colorbox1.Selected;
    origin:=Point(x,y);
    movePt:=origin;
    if moving=true then
    begin
      drawing:=false;

      premove(origin);
    end;
    if deling=true then
    begin
      drawing:=false;
      preDel(origin);
    end;
    if filling=true then
    begin
      drawing:=false;
      preFill(origin);
    end;

    if drawing=true then
    begin
      edit1.Text :='拾取终点：按住左键并且移动鼠标至终点再松开';
    end;

  end;
end;


procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then
begin
if drawing then
begin
  drawing:=false;

  edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
 {if start_line=true then
  begin
    intNumberLine:=intNumberLine+1;

  end;
 }
 case myDrawStart of
   myLine:
   begin
     //intNumberLine:=intNumberLine+1;
     new(itsLine^.next);
     itsLine:=itsLine^.next;
     //itsLine:=qLine;
     //itsLine:=itsLine^.next ;
     itsLine^.originP:=origin;
     itsLine^.finalP:=movePt;
     itsLine^.lineColor:=image1.Canvas.Pen.Color;
     //qLine:=itsLine^.next ;
     //new(qLine^.next);
     itsLine^.next :=nil;
     lastLine:=itsLine;
   end;
   myRect:
   begin
     new(itsRect^.next);
     itsRect:=itsRect^.next ;
     itsRect^.originP:=origin;
     itsRect^.finalP:=movePt;
     itsRect^.rectColor:=image1.Canvas.Pen.Color ;
     itsRect^.fillColor:=image1.Canvas.Brush.Color;
     itsRect^.next:=nil;
     lastRect:=itsRect;
   end;
   myEllips:
   begin
     new(itsEllips^.next);
     itsEllips:=itsEllips^.next ;
     itsEllips^.originP :=origin;
     itsEllips^.finalP :=movePt;
     itsEllips^.ellipsColor :=image1.Canvas.Pen.Color ;
     itsEllips^.fillColor :=image1.Canvas.Brush.Color ;
     itsEllips^.next :=nil;
     lastEllips:=itsEllips;
   end;
   myCircle:
   begin
     new(itsCircle^.next); //------------------Right
     itsCircle:=itsCircle^.next ;
     itsCircle^.centreP :=origin;
     itsCircle^.edgeP :=movePt;
     itsCircle^.circleColor :=image1.Canvas.Pen.Color ;
     itsCircle^.fillColor :=image1.Canvas.Brush.Color ;
     itsCircle^.next :=nil;
     lastCircle:=itsCircle;
   end;

 end;
end; 
end;

if movingLine then
begin
   movingLine:=false;   //<<<<<<<<  Right
   itsLine:=lastLine;
   edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
end;

if movingRect then
begin
  movingRect:=false;
  itsRect:=lastRect;
  edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
end;

if movingEllips then
begin
  movingEllips:=false;
  itsEllips:=lastEllips;
  edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
end;

if movingCircle then
begin
  movingCircle:=false;
  itsCircle:=lastCircle;
  edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
end;

end;


procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
label1.Caption:='坐标  ( '+intToStr(x)+' , '+intToStr(image1.Height-y)+' )';
if drawing then
 begin
 image1.Canvas.Pen.Mode :=pmNotXor;  //--------?????
 image1.Canvas.Brush.Style :=bsClear;//<<< !!!

 case myDrawStart of
   myLine:
   //if start_line=true then
   //with image1.Canvas do
     begin

     drawLine(origin,movePt);
     movePt:=Point(x,y);
     drawLine(origin,movePt);
     end;
   myRect:
     begin
     drawRect(origin,movePt);
     movePt:=Point(x,y);
     drawRect(origin,movePt);
     end;
   myEllips:
     begin
     drawEllips(origin,movePt);
     movePt:=Point(x,y);
     drawEllips(origin,movePt);
     end;