程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 第五章-Delphi圖形圖像編程(二)(1)

第五章-Delphi圖形圖像編程(二)(1)

編輯:Delphi

畫直線時,用戶只有在松開鼠標才能看見直線,對直線的變化不能進行實時觀測。這是因為鼠標移動時程序沒有進行某種應。Delphi定義了OnMouseMove事件來響應鼠標移動。以下代碼可使用戶隨時觀測直線的變化: 

  procedure TForm1.FormMouseMove(Sender:Tobject)

begin

Drowto(X,Y);

Moveto(origin);

end. 

origin是起始點。

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; 

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved