📄 015.htm
字号:
<HTML><HEAD><meta http-equiv="Content-Type" content="text/html; charset=GB2312"><TITLE>-->DELPHI基础教程-->第五章 Delphi图形图像编程（二）</TITLE>
<META NAME="keywords" CONTENT=" DELPHI基础教程 第五章 Delphi图形图像编程（二）">
<META NAME="description" CONTENT=" - DELPHI基础教程 - 第五章 Delphi图形图像编程（二）">
<style>
<!--
#page {position:absolute; z-index:0; left:0px; top:0px}
.tt3 {font: 9pt/12pt "宋体"}
.tt2 {font: 12pt/15pt "宋体"}
a {text-decoration:none}
a:hover {color: blue;text-decoration:underline}
-->
</style>
</HEAD>
<body text="#000000" aLink=#9900ff link=#006699 vLink=#006699 background="bg.gif" leftmargin="3" topmargin="3" marginheight="3" marginwidth="3">
<TR>
<TD CLASS="tt3" VALIGN="top" width="8%" background="bg.gif"><strong><A HREF="016.htm" ><FONT style="FONT-SIZE: 9pt">后一页</font></A><BR>
<A HREF="014.htm" ><FONT style="FONT-SIZE: 9pt">前一页</font></A><BR>
<A HREF="index.html" ><FONT style="FONT-SIZE: 9pt">回目录</font></A><BR>
<A HREF="../../../../../index.htm"><FONT style="FONT-SIZE: 9pt">回首页</font></A><BR>
</strong>
</TD>
<TD class="tt2" background="bg.gif" width="84%"><center><B><FONT style="FONT-SIZE: 16.5pt" COLOR="#FF6666" FACE="楷体_GB2312">第五章 Delphi图形图像编程（二）</FONT></B></center>
<hr color="#EE9B73" size="1" width="94%">
<p><font face="宋体" lang="ZH-CN">
画直线时，用户只有在松开鼠标才能看见直线，对直线的变化不能进行实时观测。这是因为鼠标移动时程序没有进行某种应。</font>Delphi<font
face="宋体" lang="ZH-CN">定义了</font>OnMouseMove<font face="宋体" lang="ZH-CN">事件来响应鼠标移动。以下代码可使用户随时观测直线的变化： </p>
<p> </font> procedure TForm1.FormMouseMove(Sender:Tobject)</p>
<p>begin</p>
<p>Drowto(X,Y);</p>
<p>Moveto(origin);</p>
<p>end. </p>
<p>origin<font face="宋体" lang="ZH-CN">是起始点。</font> </p>
<p>5.2.3 <font face="宋体" lang="ZH-CN">绘图功能的实现</p>
<p> 绘图软件常根据用户的要求改变绘图工具。</font>Graphex.dpr<font
face="宋体" lang="ZH-CN">例程中，当用户按下某个按钮时，可选择绘图工具中的画笔或画刷，在程序类型说明部分定义了五种绘图工具。</p>
<p> type</p>
</font><p>TDrawingTool = (dtLine,dtRectangle,dtEllips,dtRoundRect,dtPolygon); </p>
<p><font face="宋体" lang="ZH-CN">当选中某种按钮，则选中了相应的绘图工具，如： </p>
</font><p>procedure TForm1.LineButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>DrawingTool := dtLine;</p>
<p>end; </p>
<p>procedure TForm1.RectangleButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>DrawingTool := dtRectangle;</p>
<p>end; </p>
<p>procedure TForm1.EllipseButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>DrawingTool := dtEllipse;</p>
<p>end; </p>
<p>procedure TForm1.RoundRectButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>DrawingTool := dtRoundRect;</p>
<p>end; </p>
<p>procedure TForm1.PolygonButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>DrawingTool :=dtPolygon;</p>
<p>end;<font face="宋体" lang="ZH-CN"> </p>
</font><p>DrawShape<font face="宋体" lang="ZH-CN">过程定义了每种绘图工具的动作： </p>
</font><p>procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);</p>
<p>begin</p>
<p>with Image.Canvas do</p>
<p>begin</p>
<p>Pen.Mode := AMode;</p>
<p>case DrawingTool of</p>
<p>dtLine: begin</p>
<p>MoveTo(TopLeft.X, TopLeft.Y);</p>
<p>LineTo(BottomRight.X, BottomRight.Y);</p>
<p>end;</p>
<p>dtRectangle: Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);</p>
<p>dtEllipse: Ellipse(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);</p>
<p>dtRoundRect: RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y,</p>
<p>(TopLeft.X - BottomRight.X) div 2, (TopLeft.Y - BottomRight.Y) div 2);</p>
<p>dtPolygon:Polygon([Point(0,0),TopLeft,BottomRight]); end;</p>
<p>end;</p>
<p>end; </p>
<p><font face="宋体" lang="ZH-CN"> 程序刚运行时，只有一个工具栏。当用户单击画笔和画刷时，则出现相应的工具栏，如图</font>5.4<font
face="宋体" lang="ZH-CN">。其代码如下： </p>
</font><p>procedure TForm1.PenButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>PenBar.Visible := PenButton.Down;</p>
<p>end; </p>
<p>procedure TForm1.BrushButtonClick(Sender: TObject);</p>
<p>begin</p>
<p>BrushBar.Visible := BrushButton.Down;</p>
<p>end;</p>
<p><font face="宋体" lang="ZH-CN">
在设计绘图程序时，还要解决一些问题。如为了在鼠标移动时能观测图形的变化，我们定义了</font>OnMouseMove<font
face="宋体" lang="ZH-CN">事件。但会出现这样的现象，当鼠标进入绘图区时，用户未按下鼠标键，画布上却出现绘制的图形，这是我们不希望看到的。其原因是没有对鼠标按钮是否按下进行判断。因此在窗体对象中定义了</font>drawing<font
face="宋体" lang="ZH-CN">的域，当鼠标按钮按下时，</font>drawing <font
face="宋体" lang="ZH-CN">设置成真值。只有</font>drawing<font face="宋体"
lang="ZH-CN">为真，鼠标移动才执行绘图功能；当鼠标键松开时，</font>drawing<font
face="宋体" lang="ZH-CN">设置成假，鼠标移动将不执行绘图动作。</font></p>
<p><font face="宋体" lang="ZH-CN">
另外一个问题是，</font> <font face="宋体"
lang="ZH-CN">我们希望得到的是鼠标按钮按下和松开这两点所形成的图形，但</font>OnMouseMove<font
face="宋体" lang="ZH-CN">却把鼠标轨迹上各点与起始点所形成的所有图形画在屏幕上，这同样是我们不希望看到的，为了解决这些问题，程序定义了鼠标的三个事件： </p>
</font><p>procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;</p>
<p>Shift: TShiftState; X, Y: Integer);</p>
<p>begin</p>
<p>Drawing := True;</p>
<p>Image.Canvas.MoveTo(X, Y);</p>
<p>Origin := Point(X, Y);</p>
<p>MovePt := Origin;</p>
<p>OriginPanel.Caption := Format('Origin: (%d, %d)', [X, Y]);</p>
<p>end; </p>
<p>procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;</p>
<p>Shift: TShiftState; X, Y: Integer);</p>
<p>begin</p>
<p>if Drawing then</p>
<p>DrawShape(Origin, Point(X, Y), pmCopy);</p>
<p>Drawing := False;</p>
<p>end; </p>
<p>procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,</p>
<p>Y: Integer);</p>
<p>begin</p>
<p>if Drawing then</p>
<p>begin</p>
<p>DrawShape(Origin, MovePt, pmNotXor);</p>
<p>MovePt := Point(X, Y);</p>
<p>DrawShape(Origin, MovePt, pmNotXor);</p>
<p>end;<font face="宋体" lang="ZH-CN"> </p>
</font><p>MovePt<font face="宋体" lang="ZH-CN">用来记录鼠标当前位置。当下次鼠标移动时，</font>
<font face="宋体" lang="ZH-CN">就能在上次鼠标绘制的图形上画一个形状、大小一样的图形，并把画笔颜色设置成</font>PmNotXor<font
face="宋体" lang="ZH-CN">，使上次绘制的图形颜色变成了屏幕颜色，从而达到“橡皮擦”的效果。</p>
<p> 将画笔、画刷的</font>Style<font face="宋体" lang="ZH-CN">属性设置成用户希望的值，可实现对画笔和画刷风格的选择。 </p>
</font><p>procedure TForm1.SetBrushStyle(Sender: TObject);</p>
<p>begin</p>
<p>with Image.Canvas.Brush do</p>
<p>begin</p>
<p>if Sender = SolidBrush then Style := bsSolid</p>
<p>else if Sender = ClearBrush then Style := bsClear</p>
<p>else if Sender = HorizontalBrush then Style := bsHorizontal</p>
<p>else if Sender = VerticalBrush then Style := bsVertical</p>
<p>else if Sender = FDiagonalBrush then Style := bsFDiagonal</p>
<p>else if Sender = BDiagonalBrush then Style := bsBDiagonal</p>
<p>else if Sender = CrossBrush then Style := bsCross</p>
<p>else if Sender = DiagCrossBrush then Style := bsDiagCross;</p>
<p>end; </p>
<p>procedure TForm1.SetPenStyle(Sender: TObject);</p>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -