任意四邊形旋轉範例(回應jebilate) |
|
japhenchen
高階會員 發表:51 回覆:444 積分:184 註冊:2003-07-23 發送簡訊給我 |
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls,math; type TForm1 = class(TForm) StatusBar1: TStatusBar; procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCreate(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormActivate(Sender: TObject); private { Private declarations } procedure drawpoly; public { Public declarations } end; var Form1: TForm1; cx,cy:integer; x1,x2,x3,x4,y1,y2,y3,y4 : extended; currangle : extended; procedure shiftxy(var x,y:extended;ccx,ccy:integer;shiftangle:extended); implementation {$R *.dfm} procedure shiftxy(var x,y:extended;ccx,ccy:integer;shiftangle:extended); var newangle : extended ; diffxy : extended; begin // 重新計算新坐標點 // shiftxy(var x,y:extended;ccx,ccy:integer;shiftangle:extended); // x,y為傳值參數,就是想變更的坐標點,參照於ccx和ccy點做shiftangle角度旋轉 newangle:=arctan2(y-ccy,x-ccx) (shiftangle/(180*pi)); // 上面算出這個(x,y)點相對於(ccx,ccy)的相對角度,加上要轉動的角度即成新點角度 // arctan2是將斜率轉成相應的pi值,用法請見delphi函數說明和原始程式 diffxy:=sqrt(power((x-ccx),2) power((y-ccy),2)); // 算出(x,y)和(ccx,ccy)的絕對距離 x:=diffxy*cos(newangle) cx; y:=diffxy*sin(newangle) cy; // 也是三角函數(甭我解釋三角函數的算法吧....) end; procedure TForm1.drawpoly; var at1,at2,at3,at4,bx1,bx2,bx3,bx4,by1,by2,by3,by4: extended; begin if currangle<>0 then begin // 如果鍵盤事件轉動了圖,則重新計算四邊形四點新坐標 shiftxy(x1,y1,cx,cy,currangle); // 參照函數說明 shiftxy(x2,y2,cx,cy,currangle); shiftxy(x3,y3,cx,cy,currangle); shiftxy(x4,y4,cx,cy,currangle); currangle:=0; // 旋轉事件結束 end; with form1.Canvas do begin form1.Refresh; // 清除畫面,以下這段是畫出畫面的xy軸心參考線 pen.Width:=1; pen.Color:=clGray; moveto(cx,0); lineto(cx,form1.Height); moveto(0,cy); lineto(form1.width,cy); pen.Width:=1; // 以下這段是繪出中心參考點 pen.color:=clBlack; Ellipse(cx-3,cy-5,cx 5,cy 5); pen.Width:=2; // 以下這段是把四邊形繪出,round的用意是重新計算四點坐標時不四捨五入 pen.Color:=clRED; // 只在繪制時才做四捨五入的處理,避免因捨入而造成坐標誤差而變形 refresh; moveto(round(x1),round(y1)); lineto(round(x2),round(y2)); lineto(round(x3),round(y3)); lineto(round(x4),round(y4)); lineto(round(x1),round(y1)); end; end; procedure TForm1.FormCreate(Sender: TObject); begin // 設定中間點在畫面正中間(並分成四個象限) cx:=(form1.Width-50) div 2; cy:=(form1.Height-50) div 2; currangle:=0; // 隨機產生四點座標(四個象限各產生一個) randseed:=round(now*random(9999999999)); // 隨機種子數 randomize ; // 產生隨機 x1:=cx-random(cx); randseed:=round(now*random(9999999999)); randomize ; x2:=cx random(cx); randseed:=round(now*random(9999999999)); randomize ; x3:=cx random(cx); randseed:=round(now*random(9999999999)); randomize ; x4:=cx-random(cx); randseed:=round(now*random(9999999999)); randomize ; y1:=cy-random(cy); randseed:=round(now*random(9999999999)); randomize ; y2:=cy-random(cy); randseed:=round(now*random(9999999999)); randomize ; y3:=cy random(cy); randseed:=round(now*random(9999999999)); randomize ; y4:=cy random(cy); end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // 接受鍵盤事件 case key of VK_LEFT: //方向鍵左鍵 begin StatusBar1.Panels[0].Text:='Left'; currangle:=-10; // 四邊型繞著中心點逆時針轉10度 end; VK_RIGHT: begin StatusBar1.Panels[0].Text:='Right'; currangle:=10; // 順時針10度 end; end ; drawpoly; // 畫圖 end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // 接受滑鼠點擊事件,當用戶在畫面上點滑鼠左鍵,即改變旋轉中心點在滑鼠點擊的地方 if button in [mbLeft] then begin cx:=x; cy:=y; drawpoly; end; end; procedure TForm1.FormActivate(Sender: TObject); begin // 程式啟動則先畫預設的四邊型和中心點及xy參考線 drawpoly; end; end.許下第一千零一個願望 有一天幸福會聽我的話
附加檔案:79592_图
|
evens
一般會員 發表:3 回覆:3 積分:1 註冊:2002-03-19 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |