VFP 愛用者社區

[sunghsia]

****************************************************************************
*拷備至 *.PRG
****************************************************************************

ouserform=CREATEOBJECT("貝茲曲線")
ouserform.SHOW

DEFINE CLASS 貝茲曲線 AS form
CAPTION=[按住圓點拖著走，點擊視窗離開]
NAME=[Form1]

ADD OBJECT Shape1 AS 表單_Shape WITH ;
LEFT=40,;
TOP=124

ADD OBJECT Shape2 AS 表單_Shape WITH ;
LEFT=186,;
TOP=142

ADD OBJECT Shape3 AS 表單_Shape WITH ;
LEFT=94,;
TOP=32

PROCEDURE DESTROY
= ReleaseDC(hWnd, hDC)
ENDPROC

PROCEDURE CLICK
IF MESSAGEBOX("不在玩玩嗎! 要離開了哦？？",4+32+256)=6
CLEAR EVENTS
THIS.RELEASE
ENDIF
ENDPROC

PROCEDURE ACTIVATE
DECLARE INTEGER PolyBezier IN gdi32;
INTEGER hdc,;
STRING @ lppt,;
INTEGER cPoints

DECLARE INTEGER GetFocus IN user32
DECLARE INTEGER GetWindowDC IN user32 INTEGER
DECLARE INTEGER ReleaseDC IN user32 INTEGER , INTEGER


public hWnd , hDC, cPoints , point_moveX , point_moveY
hWnd = GetFocus()
hDC = GetWindowDC (hWnd)

this.drawstyle=2
this.繪圖
READ EVENTS
ENDPROC

PROCEDURE 繪圖
x1= this.shape1.left
y1= this.shape1.top
x2= this.shape2.left
y2= this.shape2.top
x3= this.shape3.left
y3= this.shape3.top

this.cls

this.forecolor=rgb(0,255,128)
this.line(x1+this.shape1.width/2 , y1+this.shape1.height/2 , x3+this.shape3.width/2 , y3+this.shape3.height/2) && 拉桿線
this.line(x3+this.shape3.width/2 , y3+this.shape3.height/2 , x2+this.shape2.width/2 , y2+this.shape2.height/2) && 拉桿線

cPoints = ; &&各圓點的X,Y位置
this.RECT(x1+7) + this.RECT(y1+27) +; && +7 和 +27 是因為 API 沒有加入 hWnd 的標題列高度和左邊框寬度, 所以自行配合曲線和圓點的位置
this.RECT(x3+7) + this.RECT(y3+27) +;
this.RECT(x2+7) + this.RECT(y2+27) +;
this.RECT(x2+7) + this.RECT(y2+27)

this.forecolor=0
= PolyBezier (hDC , @cPoints , 3)
ENDPROC

PROCEDURE RECT
PARAMETER lnValue
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
LOCAL b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2)/m1)
b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
ENDPROC
ENDDEFINE



DEFINE CLASS 表單_Shape AS SHAPE
BORDERCOLOR=8453888
* BORDERWIDTH=3
CURVATURE=90
HEIGHT=8
WIDTH=7
NAME=[Shape]

PROCEDURE MOUSEDOWN
LPARAMETERS nButton, nShift, nXCoord, nYCoord
point_moveX= nXCoord
point_moveY= nYCoord
ENDPROC

PROCEDURE MOUSEMOVE
LPARAMETERS nButton, nShift, nXCoord, nYCoord
if nButton=1
this.left = this.left + (nXCoord - point_moveX)
this.top = this.top + (nYCoord - point_moveY)
point_moveX = nXCoord
point_moveY = nYCoord
thisform.繪圖
endif
ENDPROC

PROCEDURE MOUSEUP
LPARAMETERS nButton, nShift, nXCoord, nYCoord
= PolyBezier (hDC , @cPoints , 4) &&在繪製一次, 因滑鼠放開時,有時曲線會消失
ENDPROC

ENDDEFINE

[garfield]

再多做幾種功能後,
組合一下,就可做成超強的小畫家了!

[sunghsia]

哇拷~~~~~~ 資料庫快變成了美術教室了~~ 看來要改行嚕><~
其實~偶而設計一些圖畫來滿足自己的成就感
也是一種不錯的心情,就因為是自己設計出來的感覺;真好
OK! 繼續邁向 AutoCad 的立體圖

[yoncen]

看來你可以寫股票程式了。。^_^