graphwin.~pas

Delphi basic program. Basic programing guide for delphi language. Several samples are giving.

unit GraphWin;

interface

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

type
  TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
  TForm1 = class(TForm)
    Panel1: TPanel;
    LineButton: TSpeedButton;
    RectangleButton: TSpeedButton;
    EllipseButton: TSpeedButton;
    RoundRectButton: TSpeedButton;
    PenButton: TSpeedButton;
    BrushButton: TSpeedButton;
    PenBar: TPanel;
    SolidPen: TSpeedButton;
    DashPen: TSpeedButton;
    DotPen: TSpeedButton;
    DashDotPen: TSpeedButton;
    DashDotDotPen: TSpeedButton;
    ClearPen: TSpeedButton;
    PenWidth: TUpDown;
    PenSize: TEdit;
    StatusBar1: TStatusBar;
    ScrollBox1: TScrollBox;
    PenColor: 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;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    V1: TMenuItem;
    H1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    A1: TMenuItem;
    BrushBar: TPanel;
    SolidBrush: TSpeedButton;
    ClearBrush: TSpeedButton;
    HorizontalBrush: TSpeedButton;
    VerticalBrush: TSpeedButton;
    FDiagonalBrush: TSpeedButton;
    BDiagonalBrush: TSpeedButton;
    CrossBrush: TSpeedButton;
    DiagCrossBrush: TSpeedButton;
    BrushColor: TSpeedButton;
    Image: TImage;
    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 ToolBar1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    BrushStyle: TBrushStyle;
    PenStyle: TPenStyle;
    PenWide: Integer;
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    DrawingTool: TDrawingTool;
    CurrentFile: string;
    procedure SaveStyles;
    procedure RestoreStyles;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  end;

var
  Form1: TForm1;

implementation

uses BMPDlg, Clipbrd, about;

{$R *.dfm}


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;
  //显示PenBar与否
end;

procedure TForm1.BrushButtonClick(Sender: TObject);
begin
  BrushBar.Visible := BrushButton.Down;
  //显示BrushBar与否
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
  Form1.StatusBar1.Panels[2].Text:=DateToStr(date);
  //调用显示日期
  Bitmap := nil;
  try
    Bitmap := TBitmap.Create;
    Bitmap.Width := 200;
    Bitmap.Height := 200;
    Image.Picture.Graphic := Bitmap;
    //设置程序启动后默认的新BMP图象的大小
  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
  Close;
  //菜单退出命令
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    CurrentFile := OpenDialog1.FileName;
    SaveStyles;
    Image.Picture.LoadFromFile(CurrentFile);
    RestoreStyles;
  end;
  //打开文件命令
end;

procedure TForm1.Save1Click(Sender: TObject);
begin
  if CurrentFile <> EmptyStr then
    Image.Picture.SaveToFile(CurrentFile)
  else SaveAs1Click(Sender);
  //保存文件命令
end;

procedure TForm1.Saveas1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    CurrentFile := SaveDialog1.FileName;
    Save1Click(Sender);
  end;
  //文件另存为命令
end;

procedure TForm1.New1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
//新建文件命令
  with NewBMPForm do
  begin
    ActiveControl := WidthEdit;
    WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
    HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
    if ShowModal <> idCancel then
    //打开BMP图象大水设置对话框
    begin
      Bitmap := nil;
      try
        Bitmap := TBitmap.Create;
        Bitmap.Width := StrToInt(WidthEdit.Text);
        Bitmap.Height := StrToInt(HeightEdit.Text);
        SaveStyles;
        Image.Picture.Graphic := Bitmap;
        RestoreStyles;
        CurrentFile := EmptyStr;
      finally
        Bitmap.Free;
      end;
    end;
  end;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  Clipboard.Assign(Image.Picture);
  //复制菜单命令
end;

procedure TForm1.Cut1Click(Sender: TObject);
var
  ARect: TRect;
begin
  Copy1Click(Sender);
  with Image.Canvas do
  begin
    CopyMode := cmWhiteness;
    ARect := Rect(0, 0, Image.Width, Image.Height);
    CopyRect(ARect, Image.Canvas, ARect);
    CopyMode := cmSrcCopy;
  end;
  //剪切菜单命令
end;

procedure TForm1.Paste1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Assign(Clipboard);
      Image.Canvas.Draw(0, 0, Bitmap);
    finally
      Bitmap.Free;
    end;
  end;
//粘贴菜单命令
end;

procedure TForm1.SaveStyles;
begin
  with Image.Canvas do
  begin
    BrushStyle := Brush.Style;
    PenStyle := Pen.Style;
    PenWide := Pen.Width;
  end;
end;

procedure TForm1.RestoreStyles;
begin
  with Image.Canvas do
  begin
    Brush.Style := BrushStyle;
    Pen.Style := PenStyle;
    Pen.Width := PenWide;
  end;
end;

procedure TForm1.ToolBar1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  if X<60 then
    ToolBar1.Align:=alLeft
  else if X>Form1.Width-60 then
    ToolBar1.Align:=alRight
  else if Y<60 then
    ToolBar1.Align:=alTop
  else if Y>Form1.Height-60   then
    ToolBar1.Align:=alBottom;
    //动态拖动常用工具栏
end;

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:=(Source=ToolBar1) and ((x<60) or (x>Width-60)
    or (y<60) or (y>Height-60));
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Form1.N2.Checked := NOT Form1.N2.Checked;
  if Form1.N2.Checked = true then
    ToolBar1.Visible := true
  else
    ToolBar1.Visible := false;
  //常用工具栏的显示与否
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  Form1.N3.Checked := NOT Form1.N3.Checked;
  if Form1.N3.Checked = true then
    Panel1.Visible := true
  else
    Panel1.Visible := false;
  //基本图形工具栏的显示与否
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  Form1.N4.Checked := NOT Form1.N4.Checked;
  if Form1.N4.Checked = true then
    PenBar.Visible := true
  else
    PenBar.Visible := false;
  //线型工具栏的显示与否
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  Form1.N5.Checked := NOT Form1.N5.Checked;
  if Form1.N5.Checked = true then
    BrushBar.Visible := true
  else
    BrushBar.Visible := false;
    //纹理工具栏的显示与否
end;

procedure TForm1.A1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
  //显示关于对话框
end;

procedure TForm1.ImageMouseDown(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('开始位置: (%d, %d)', [X, Y]);
  //在状态栏上显示画笔起点

end;

procedure TForm1.ImageMouseMove(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('当前位置: (%d, %d)', [X, Y]);
  //显示鼠标的当前位置

end;

procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, Point(X, Y), pmCopy);
    //如果在画图状态，则按选择的默认的基本图形画图
    Drawing := False;
    //复位画图标志
  end;

end;

end.