## Τρίτη, 6 Μαρτίου 2018

### Revision 51 (Version 9.0)

1) New object Information

Declare AnObject Information
With AnObject,"IsServer" as IsServer, "CodepageOEM" as CodepageOEM\$
Print IsServer
Print CodepageOEM\$
Declare AnObject Nothing

code dor this object from Dragokas, vbforums.com

2) New object Math (for now only Vectors are useful)
Code for Math object by Elroy, from VbForums.com

Video from an old  example: http://bit.ly/2oOf479
This example has an addition: When we click in user form 3D object blinks.

Title "3D Graphics", 0 ' 0  to hide console
Set FAST !
\\ by api
Structure VecType {
x As Double
y As Double
z As Double
}
\\ Program
Structure Variables {
vRot1 As VecType
vRot2 As VecType
vRot3 As VecType
vRot4 As VecType
vBase As VecType
vAxis As VecType
}
Buffer Clear Var as Variables
\\ utility function
=Var(0,a\$)
}
VecOff=Lambda Var, VecType (a\$, b\$) -> {
=Var(0, a\$, VecType(b\$)!)
}
Class cLine {
X1, Y1, X2, Y2, color
Module Render (z){
If z>=0 then {
Move .X1, .Y1
Width 3 {Draw to .X2, .Y2, .color}
Circle Fill #aa33cc, z/40+200
} else {
Move .X2, .Y2
Circle Fill #aa33cc, z/40+200
Width 3 {Draw to .X1, .Y1, .color}
}
}
Class:
Module cLine (.color){
If Match("NNNN") Then Read .X1, .Y1, .X2, .Y2
}
}

vBase.x=VecOff("vBase","x")
vBase.y=VecOff("vBase","y")
vBase.z=VecOff("vBase","z")
vRot1.x=VecOff("vRot1","x")
vRot1.y=VecOff("vRot1","y")
vRot1.z=VecOff("vRot1","z")
vRot2.x=VecOff("vRot2","x")
vRot2.y=VecOff("vRot2","y")
vRot2.z=VecOff("vRot2","z")
vRot3.x=VecOff("vRot3","x")
vRot3.y=VecOff("vRot3","y")
vRot3.z=VecOff("vRot3","z")
vRot4.x=VecOff("vRot4","x")
vRot4.y=VecOff("vRot4","y")

Form 80,40
Refresh 100
Declare Alfa Form
With Alfa, "Title", "Demo1"
\\ a string to hold static background
screen\$=""
disp=false
Inventory Depth
aLine=Each(Depth)
Method Math, "RotVectMult", 4, vRot1, vAxis, vRot1, dAngle
Push Eval(Var, vBase.y as double), Eval(Var, vBase.x as double)
\\ x is in top, y is after x
Over 2, 2 \\  copy two times from second, so double two top
Push Eval(Var, vRot4.x as double)+Number : Over 1, 2 \\ copy 2 times top only
Push Eval(Var, vRot4.y as double)+Number : Over 1, 2
Over 2, 4 \\ now original 2 values copied 4 times
Line1.X2 = Eval(Var, vRot1.x as double)+Number
Line1.Y2 = Eval(Var, vRot1.y as double)+Number
Line2.X2 = Eval(Var, vRot2.x as double)+Number
Line2.Y2 = Eval(Var, vRot2.y as double)+Number
Line3.X2 = Eval(Var, vRot3.x as double)+Number
Line3.Y2 = Eval(Var, vRot3.y as double)+Number
Inventory Depth ' clear Depth, then make keys as numbers
Append Depth, Eval(Var, vRot1.z as double):=1, Eval(Var, vRot2.z as double):=2, Eval(Var, vRot3.z as double):=3
Sort Depth as number
} As Compute
Group All\$ {
Private:
Dim Base 1, A\$(3)
Public:
n=1
Set (.n) {
}
Value {
=.A\$(.n)
}
}
Layer Alfa {
Window 12, 10000, 8000;
\\Form 40, 20
Line1=cline(#0000FF, scale.x/2, scale.y/2, scale.x/2, scale.y/2-2220 )
Line2=cline(#FF0000, scale.x/2, scale.y/2, scale.x/2-2340, scale.y/2-60 )
Line3=cline(#00FF00, scale.x/2, scale.y/2, scale.x/2-780, scale.y/2-1200 )
All\$(1)=Weak\$(Line1.Render)
All\$(2)=Weak\$(Line2.Render)
All\$(3)=Weak\$(Line3.Render)
Declare Math Math
Method Math, "Vector", vBase,scale.x/2-1500, scale.y/2+1500, 1500 '  -1000
Method Math, "Vector", vRot1, Line1.X2, Line1.Y2, -1000
Method Math, "Vector", vRot2, Line2.X2, Line2.Y2, -1200
Method Math, "Vector", vRot3, Line3.X2, Line3.Y2, 1700
Method Math, "Vector", vRot4, Line1.X1, Line1.Y1, 0
Method Math,  "VecDiffMult", 4, vRot1, vBase, vRot1
Inventory Depth=Eval(Var, vRot1.z as double):=1, Eval(Var, vRot2.z as double):=2, Eval(Var, vRot3.z as double):=3
Sort Depth as number
Method Math, "Vector", vAxis, -.8, 1.6, .3
Method Math, "UnitVect", vAxis
dAngle =11
Pen 0
Cls 7
Move 0,0
Cursor 0, Height-1
Cls 7, Height-1
Copy scale.x, scale.y to screen\$
Profiler
Cursor 0,Height
Refresh 0 ' reset internal counter
Move 0,0
Copy 0,0 use screen\$
Part {
aLine=Each(Depth)
while aline {
All.n=eval(aLine)
Call All\$, Val(eval\$(Depth, aLine^))
}
} As disp
Print Over \$(7), Str\$(Now , "hh:mm:ss" )
Refresh
} As PlayThis
}
if state then {disp~} else disp=false
State=False
Function Alfa.Click {
State~
If State then {
} else {
}
}
Method Alfa, "Show", 1
Declare Alfa Nothing
Declare Math Nothing

These are the functions of Math object:Methods

Vector *A_Vector, x As Double, y As Double, z As Double
MakeLineFrom2Vec *A_Vector, *B_Vector, *C_LineType
MakeQuaterion  *A_QuatType, w As Double, x As Double, y As Double, z As Double
VecString *A_Vector Return String

UnitVect *A_Vector
NegateQuat *A_Quat, *Result_Quat

DotProduct *A_Vector, *B_Vector Return Result_Double
XProduct *A_Vector, *B_Vector, *Result_Vector
VecMagnitude *A_Vector Return Result_Double
VecDiviNum *A_Vector, Num_double, *Result_Vector
VecDiffNum *A_Vector, Num_double, *Result_Vector
VecMulNum *A_Vector, Num_double, *Result_Vector

VecAver *A_Vector, *B_Vector, *Result_Vector
VecDiff *A_Vector, *B_Vector, *Result_Vector
VecSumm *A_Vector, *B_Vector, *Result_Vector
RotVect *A_Vector, *B_Vector, *Result_Vector, Angle_double, Optional bDegrees_double=True

UnitVectMult N_Double, *A_Vector
NegateQuatMult N_Double, *A_Quat, *Result_Quat
VecDiviNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector
VecDiffNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector
VecMulNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector

VecAverMult N_Double, *A_Vector, *B_Vector, *Result_Vector
VecSummMult N_Double, *A_Vector, *B_Vector_const, *Result_Vector
VecDiffMult N_Double, *A_Vector, *B_Vector_const, *Result_Vector
RotVectMult N_Double, *A_Vector, *Axis_Vector_const, *Result_Vector, Angle_double, Optional bDegrees_double=True