计算机等级考试二级Delphi辅导知识：Delphi图形图像编程_第3页

　5.2.3 绘图功能的实现
　　绘图软件常根据用户的要求改变绘图工具。Graphex.dpr例程中，当用户按下某个按钮时，可选择绘图工具中的画笔或画刷，在程序类型说明部分定义了五种绘图工具。
　　type
　　TDrawingTool = (dtLine,dtRectangle,dtEllips,dtRoundRect,dtPolygon);　
　　当选中某种按钮，则选中了相应的绘图工具，如：　
　　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.PolygonButtonClick(Sender: TObject);
　　begin
　　DrawingTool :=dtPolygon;
　　end;　
　　DrawShape过程定义了每种绘图工具的动作：　
　　procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
　　begin
　　with Image.Canvas do
　　begin
　　Pen.Mode := AMode;
　　case DrawingTool of
　　dtLine: begin
　　MoveTo(TopLeft.X, TopLeft.Y);
　　LineTo(BottomRight.X, BottomRight.Y);
　　end;
　　dtRectangle: Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
　　dtEllipse: Ellipse(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
　　dtRoundRect: RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y,
　　(TopLeft.X - BottomRight.X) div 2, (TopLeft.Y - BottomRight.Y) div 2);
　　dtPolygon:Polygon([Point(0,0),TopLeft,BottomRight]); end;
　　end;
　　end;　
　　程序刚运行时，只有一个工具栏。当用户单击画笔和画刷时，则出现相应的工具栏，如图5.4。其代码如下：　
　　procedure TForm1.PenButtonClick(Sender: TObject);
　　begin
　　PenBar.Visible := PenButton.Down;
　　end;　
　　procedure TForm1.BrushButtonClick(Sender: TObject);
　　begin
　　BrushBar.Visible := BrushButton.Down;
　　end;
　　在设计绘图程序时，还要解决一些问题。如为了在鼠标移动时能观测图形的变化，我们定义了OnMouseMove事件。但会出现这样的现象，当鼠标进入绘图区时，用户未按下鼠标键，画布上却出现绘制的图形，这是我们不希望看到的。其原因是没有对鼠标按钮是否按下进行判断。因此在窗体对象中定义了drawing的域，当鼠标按钮按下时，drawing 设置成真值。只有drawing为真，鼠标移动才执行绘图功能；当鼠标键松开时，drawing设置成假，鼠标移动将不执行绘图动作。
　　另外一个问题是， 我们希望得到的是鼠标按钮按下和松开这两点所形成的图形，但OnMouseMove却把鼠标轨迹上各点与起始点所形成的所有图形画在屏幕上，这同样是我们不希望看到的，为了解决这些问题，程序定义了鼠标的三个事件：　
　　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;
　　OriginPanel.Caption := Format('Origin: (%d, %d)', [X, Y]);
　　end;　
　　procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
　　Shift: TShiftState; X, Y: Integer);
　　begin
　　if Drawing then
　　DrawShape(Origin, Point(X, Y), pmCopy);
　　Drawing := False;
　　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;　
　　MovePt用来记录鼠标当前位置。当下次鼠标移动时， 就能在上次鼠标绘制的图形上画一个形状、大小一样的图形，并把画笔颜色设置成PmNotXor，使上次绘制的图形颜色变成了屏幕颜色，从而达到“橡皮擦”的效果。
　　将画笔、画刷的Style属性设置成用户希望的值，可实现对画笔和画刷风格的选择。　
　　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;　
　　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;