線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:4273
推到 Plurk!
推到 Facebook!

任意四邊形旋轉範例(回應jebilate)

 
japhenchen
高階會員


發表:51
回覆:444
積分:184
註冊:2003-07-23

發送簡訊給我
#1 引用回覆 回覆 發表時間:2005-10-10 10:44:45 IP:219.134.xxx.xxx 未訂閱
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

發送簡訊給我
#2 引用回覆 回覆 發表時間:2009-09-25 12:42:10 IP:60.250.xxx.xxx 訂閱
newangle:=arctan2(y-ccy,x-ccx) (shiftangle/(180*pi));


shiftangle/(180*pi )似乎有問題
應該是 shiftangle/180*pi

系統時間:2024-11-21 19:34:33
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!