Manipulate[
DynamicModule[{ppts,spts,plt},
Grid[{{
(* Profile curve *)
Labeled[LocatorPane[Dynamic[pts],
Dynamic[Graphics[{BSplineCurve[ppts,SplineDegree->2],Dashed,Orange,Line[ppts]},PlotRange->{{0,1},{0,1}},Frame->True,FrameTicks->None,GridLines->Automatic,GridLinesStyle->LightGray,AspectRatio->2.5,ImageSize->{100,250}]],LocatorAutoCreate->{2,∞}],Style["profile curve","Label"],Top],
Dynamic[
ppts=If[sorted,SortBy[pts,Last],pts];
spts=Table[Append[#,Last[p]]&/@(First[p] cpts),{p,ppts}];
plt=Graphics3D[{
If[mesh,
(* Draw control meshes *)
{FaceForm[],EdgeForm[Gray],Polygon[spts],Gray,Line[Transpose[spts]],Red,PointSize[Medium],Point/@spts},{}],
FaceForm[frontc,backc],Opacity[op],Specularity[White,spec],
(* NURBS Surface *)
BSplineSurface[spts,SplineClosed->{False,True},SplineDegree->2,SplineKnots->{Automatic,k},SplineWeights->Table[w,{Length[pts]}]]},
PlotRange->{{-1,1},{-1,1},{0,1}},BoxRatios->{1,1,1.25},ImageSize->{300,300},Boxed->False]]
},{" ",Button["Nagy méret",CreateWindow[DocumentNotebook[Dynamic[Show[plt,ImageSize->{600,600}]]],WindowSize->{650,650}]]}}]
],
Style["Tervezzünk serleget",Large, Bold],
Style["http://demonstrations.wolfram.com/PottersWheel/"],
Delimiter,
"None"->{{pts,{{0.5,0},{0.2,0.25},{0.5,0.5},{0.8,0.75},{.5,1}}},{0,0},{1,1},ControlType->None},
Row[{
Column[{Control[{{sorted,True},ControlType->None}],
Control[{{mesh,False},ControlType->None}]},Right],
Spacer[20],
Column[{Control[{{frontc,Yellow,"Külső szín"},Yellow,ImageSize->Tiny}],
Control[{{backc,Blue,"Belső szín"},Blue,ImageSize->Tiny}]},Right],
Spacer[20],
Column[{Control[{{op,1,"Átlátszóság"},0,1,ImageSize->Tiny}],Control[{{spec,0,"Fényesség"},0,100,ImageSize->Tiny}]}]
}],
Delimiter,Style["Új mintapont / pont megszüntetése: Alt-Klikk"],
Initialization:>(cpts={{0,-1},{-1,-1},{-1,1},{0,1},{1,1},{1,-1}};
w={1,.5,.5,1,.5,.5};
k={0,0,0,1/4,1/2,1/2,3/4,1};)
]