Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Grafik: 3D-Rahmen und Linien zeichnen
PRFellow - Vorlage
Beispiele für die Funktion DrawEdge
Autor: Thomas Hölzer
3D-Rahmen und Linien zeichnen (SetAutoPaint und %wmPaint beachten!)
Declare BevelRect#
Def DrawEdge(4) !USER32,DrawEdge
Proc DrawBevel
Parameters x%,y%,x1%,y1%,BorderStyle%
Dim BevelRect#,16
Word BevelRect#,0=x%
Word BevelRect#,4=y%
Word BevelRect#,8=@add(x%,x1%)
Word BevelRect#,12=@add(y%,y1%)
DrawEdge(%hdc,BevelRect#,BorderStyle%,15)
DrawEdge(%hdc2,BevelRect#,BorderStyle%,15)
Dispose BevelRect#
EndProc
Proc Line3D
Parameters x%,y%,l%,horizontal% 0= vert, 1 = horiz
Dim BevelRect#,16
Word BevelRect#,0=x%
Word BevelRect#,4=y%
Word BevelRect#,8=0
Word BevelRect#,12=add(y%,l%)
If horizontal%
Word BevelRect#,8=add(x%,l%)
Word BevelRect#,12=0
EndIf
DrawEdge(%hdc,BevelRect#,6,add(horizontal%,1))
DrawEdge(%hdc2,BevelRect#,6,add(horizontal%,1))
Dispose BevelRect#
EndProc
Proc BevelLowered
Parameters x%,y%,x1%,y1%
DrawBevel x%,y%,x1%,y1%,2
EndProc
Proc BevelLoweredEx
Parameters x%,y%,x1%,y1%
DrawBevel x%,y%,x1%,y1%,10
EndProc
Proc BevelRaised
Parameters x%,y%,x1%,y1%
DrawBevel x%,y%,x1%,y1%,4
EndProc
Proc BevelRaisedEx
Parameters x%,y%,x1%,y1%
DrawBevel x%,y%,x1%,y1%,5
EndProc
Proc FrameLowered
Parameters x%,y%,x1%,y1%
DrawBevel x%,y%,x1%,y1%,6
EndProc
Proc FrameRaised
Parameters x%,y%,x1%,y1%
BevelRaised x%,y%,x1%,y1%
BevelLowered add(x%,1),add(y%,1),sub(x1%,2),sub(y1%,2)
EndProc
Beispielprogramm
Declare exit%
Proc Paint
Cls @rgb(192,192,192)
BevelLowered 5,5,100,100
DrawText 10,110,BevelLowered
BevelLoweredEx 110,5,100,100
DrawText 115,110,BevelLoweredEx
BevelRaised 215,5,100,100
DrawText 230,110,BevelRaised
BevelRaisedEx 320,5,100,100
DrawText 325,110,BevelRaisedEx
FrameLowered 425,5,100,100
DrawText 435,110,FrameLowered
FrameRaised 530,5,100,100
DrawText 540,110,FrameRaised
Line3D 100,150,100,0
DrawText 10,160,Line3D ,,,0
Line3D 200,150,100,1
DrawText 200,160,Line3D ,,,1
EndProc
SetTrueColor 1
WindowStyle $3F
Window 0,0-640,480
UseFont ,15,0,0,0,0
TextColor 0,-1
SetAutoPaint 2
WindowTitle Beispiele für 3D-Rahmen und Linien (Ende mit rechter Maustaste)
Paint
WhileNot exit%
WaitInput
IF %wmPaint
Paint
ELSEIF @equ(%mousekey,2)
inc exit%
href='./../../function-references/XProfan/endif/'>ENDIF
Wend