http://www.cnread.net/cnread1/dnwl/cxsj/delphi/jcjc/015.htm 畫直線時，用戶只有在鬆開鼠標才能看見直線，對直線的變化不能進行實時觀測。這是因為鼠標移動時程序沒有進行某種應。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; 5.3 圖像對像概述 5.3.1 TGraphic對像 TGraphic對象是TBitmap ,TIcon,Tmetafile對象的基類。如果知道圖像的具體類型( 如位圖， 圖標元文件) ， 則應將圖像貯存在相應類型的對象中( 如TBitmap,TIcon,Tmetafile)，否則應該使用可貯存任何圖像類型的TPicture對象。 5.3.2 TPicture對像 TPicture對象可以保存位圖、圖標或元文件。Graphic屬性中包括圖像的類型；圖像的高度和寬度分別定義在Height,Width屬性中；調用LoadFromFile方法，可以從文件中裝載一幅圖像： procedure TForm1.FormCreate(Sender: TObject); begin BitBtn1.Glyph.LoadFromFile('TARTAN.BMP'); end; 要保存一個位圖，則要用SaveToFile方法；要把圖像複製到剪切板，可以調用TClipboard對象的Assign方法。 5.3.3 TImage部件 TImage部件用以在窗體中顯示圖像，它的Picture 屬性保存著要顯示的圖像， 這是一個TPicture對象。AutoSize,Stretch屬性是用來調節部件與圖像的大小的。當AutoSize 為真值時，TImage部件將根據它所包含的圖像的大小來調整自身的大小；當AutoSize為假值時，不論圖像有多大，部件將保持設計時的大小。如果部件比圖像小， 那麼只有一部分圖像是可見的。當Stretch為真值時，位圖像將根據部件的大小調整自身的大小，當部件大小改變時，元文件也做相應變化。Stretch屬性對圖標沒有作用。 5.3.4 TBitmap Object(位圖對像) 位圖對像包含一個位圖圖像，有HBITMAP,HPALETE句柄，可自動管理調色板。位圖對象也有畫布屬性。位圖的Palette屬性用來控制位圖的顏色映射，它包括256種可顯示的顏色。 如果應用程序用前景色繪製位圖，Palette 屬性的顏色將被加入Windows系統調色板，其它顏色被映射到系統調色板已存在的顏色。如果應用程序用自己的顏色繪製位圖，而其它程序已佔有系統調色板，位圖的顏色將被映射到系統調色板中。 如果Monochrome屬性設置成假，位圖將顯示成彩色，反之顯示成黑白色。 調用Draw和StretchDraw方法可在畫布上繪製位圖。 5.4 圖像對象的應用 本章例程中，單擊（文件|瀏覽）菜單項，將彈出一個圖像瀏覽窗體。如果用戶在窗體中選擇文件列表框的圖形文件，窗體右上角的圖像部件上將出現此文件所代表的圖像；若選擇「雕刻效果」按鈕中檢查框，窗體中的加速按鈕和位圖按鈕上將出現位圖。 以下代碼是將圖像文件裝載至圖像部件上： procedure TImageForm.FileListBox1Click(Sender: TObject); var FileExt: string[4]; begin FileExt := UpperCase(ExtractFileExt(FileListBox1.Filename)); if (FileExt = '.BMP') or (FileExt = '.ICO') or (FileExt = '.WMF') then begin Image1.Picture.LoadFromFile(FileListBox1.Filename); Label1.Caption := ExtractFilename(FileListBox1.Filename); if (FileExt = '.BMP') then begin Label1.Caption := Label1.Caption Format(' (%d x %d)', [Image1.Picture.Height, Image1.Picture.Width]); ViewForm.Image1.Picture.Bitmap := Image1.Picture.Bitmap; ViewAsGlyph(FileExt); end; if FileExt = '.ICO' then Icon := Image1.Picture.Icon; if FileExt = '.WMF' then ViewForm.Image1.Picture.Metafile := Image1.Picture.Metafile; end; end; 這個過程首先判斷文件類型，如果是圖像文件，則將圖像裝載至圖像部件上，並在標籤上列出文件名稱。如果是位圖文件，還將顯示其大小。 在加速按鈕和位圖按鈕中顯示位圖的代碼如下： procedure TImageForm.CheckBox1Click(Sender: TObject); begin ViewAsGlyph(UpperCase(ExtractFileExt(FileListBox1.Filename))); end; procedure TImageForm.ViewAsGlyph(const FileExt: string); begin if CheckBox1.Checked and (FileExt = '.BMP') then begin SpeedButton1.Glyph := Image1.Picture.Bitmap; SpeedButton2.Glyph := Image1.Picture.Bitmap; SpinEdit1.Value := SpeedButton1.NumGlyphs; BitBtn1.Glyph := Image1.Picture.Bitmap; BitBtn2.Glyph := Image1.Picture.Bitmap; end; end; 窗體中有一個檢查框用來檢驗圖像部件的Strecth 屬性的效果。當此檢查框被選中時，Stretch設成真值，圖像將根據部件大小調整自身大小。代碼如下： procedure TImageForm.StretchCheckClick(Sender: TObject); begin Image1.Stretch := StretchCheck.Checked; end; 在這個窗體中，用戶可以在屏幕和打印紙上調整圖像部件的大小、位置。調整圖像的代碼如下： procedure TViewForm.SpinEdit1Change(Sender: TObject); begin IMage1.Height:=105 SpinEdit1.Value*5; IMage1.Width:=105 SpinEdit1.Value*5; end; procedure TViewForm.SpinEdit2Change(Sender: TObject); begin Image1.Left:=40 SpinEdit2.Value*20; end; procedure TViewForm.SpinEdit3Change(Sender: TObject); begin Image1.Top:=96 SpinEdit3.Value*10; 當用戶按下標有「全尺寸」字樣的按鈕時，另一個窗體將顯示。 圖像打印代碼如下： procedure TViewForm.Button1Click(Sender: TObject); begin Printer.BeginDoc; Printer.Canvas.Draw(Trunc(1.5*Image1.Left),Trunc(1.5*Image1.Top), Image1.Picture.Graphic); Printer.EndDoc; end;