unit Step33a;
//******************************************************************/
//*               (c)                      */
//*                -, 1991, 1996                     */
//*                 -   5.x                      */
//******************************************************************/
//*                                              */
//*                       -a                                */
//* 1.                              - WorkContour            */
//* 2.               - TDemWork               */
//* 3.                         - DrawViewPointer        */
//* 4.                     - WorkStamp              */
//* 5.                             - TableWork              */
//* 6.                        - DrawEquidistant        */
//* 7.                              - DrawEllipse            */
//* 8.                           - DrawPolyline           */
//* 9.  Nurbs                             - DrawNurbs              */
//* 10.                        - WorkTolerance          */
//* 11.            - DrawSpecRough          */
//* 12.     - DrawInsFragment1       */
//* 13.         - DrawInsFragment2       */
//*                                                                */
//******************************************************************/

interface

//-------------------------------------------------------------------------------
//   
// ---
  procedure  LIBRARYENTRY( comm: WORD  ); Pascal;
  function   LIBRARYID   : Cardinal;      Pascal;
  procedure  WorkContour;
  procedure  TDemWork;
  procedure  DrawViewPointer;
  procedure  WorkStamp;
  procedure  TableWork;
  procedure  DrawEquidistant;
  procedure  DrawEllipse;
  procedure  DrawPolyline;
  procedure  DrawNurbs;
  procedure  WorkTolerance;
  procedure  DrawInsFragment1;
  procedure  DrawInsFragment2;

implementation

  uses Sysutils, LtDefine, LibTool, LDefin2D;

//----------------------------------------------------------------------------------------
//   
//---
function   LIBRARYID : Cardinal;  pascal;
begin
  LIBRARYID:=100;
end;

//----------------------------------------------------------------------------------------
//   
//---
procedure  LIBRARYENTRY( comm : Word  );  pascal;
begin

  case comm of
    1:  WorkContour();             // 
    2:  TDemWork();                //  
    3:  DrawViewPointer();         //  
    4:  WorkStamp();               //   
    5:  TableWork();               // 
    6:  DrawEquidistant();         // 
    7:  DrawEllipse();             // 
    8:  DrawPolyline();            // 
    9:  DrawNurbs();               // Nurbs
    10: WorkTolerance();           //  
    11: SpecRough( 2, 1, 'Rz40' ); //  
    12: DrawInsFragment1();        //    
    13: DrawInsFragment2();        //   
  end; {case}

end;

//-------------------------------------------------------------------------------
//  
//---
procedure WorkContour;
var
  _contour,              // 
   g      : Reference;   // 
begin
  if ( Contour( 1 ) > 0 ) then                       // 
  begin
    LineSeg( 20, 30, 50, 30, 1 );                    // 
    ArcByPoint( 50, 20, 10, 50, 30, 50, 10, -1, 1 ); // 

    // 
    Contour( 2 );
      LineSeg( 50, 10, 20, 10, 1 );                  // 
      ArcByPoint( 20, 20, 10, 20,10, 20, 30,-1, 1);  // 
    EndObj();

    _contour := EndObj();

    //  
    LightObj( _contour, 1 );
    ksMessage( '' );
    LightObj( _contour, 0 );

    //    
    g := NewGroup(0);
    EndGroup();
    AddObjGroup( g, _contour);

    //  
    MoveObj( g, 10, 10 );
    ksMessage( ' ' );

  end;
end;

//--------------------------------------------------------------------------------
//   
//      ,  A3
//---
procedure TDemWork;
var
  pGab : Reference; //     
  par  : RectParam; //  
begin

  pGab := CreateArray( RECT_ARR, nil );
  //     
  par.pBot.x:= 230; par.pBot.y := 65;
  par.pTop.x:= 415; par.pTop.y := 80;
  AddArrayItem( pGab, -1, Addr(par), SizeOf(RectParam ) ); //  
  par.pBot.x:= 45;  par.pBot.y := 15;
  par.pTop.x:= 230; par.pTop.y := 60;
  AddArrayItem( pGab, -1, Addr(par), sizeof(RectParam ) ); //  
  //     
  if( OpenTechnicalDemand( pGab, 0 ) > 0 ) then
  begin
    TextLine( NEW_LINE, 0, nil, '1111111' );
    TextLine( NEW_LINE, 0, nil, '2222222' );
    TextLine( NEW_LINE, 0, nil, '3333333' );
    TextLine( NEW_LINE, 0, nil, '4444444' );
    TextLine( NEW_LINE, 0, nil, '5555555' );
    TextLine( NEW_LINE, 0, nil, '6666666' );
    CloseTechnicalDemand( ); //  
  end;
end;

//------------------------------------------------------------------------------
//   
//---
procedure DrawViewPointer;
var
  par  : ViewPointerParam; //   
  par3 : TextItemParam ;   //   
  p    : Reference;        //  
  tip  : Integer;          // 
  buf  : String;

  //----------------------------------------------------------------------------------------
  //  
  procedure PrintPar1;
  var
    j, count : Integer;
  begin
    count := GetArrayCount( par.pTextItem ); //   
    for j:=0 to count-1 do
    begin
      GetArrayItem( par.pTextItem, j, Addr(par3), SizeOf(TextItemParam) );
      buf := Format('j=%d h=%5.1f  s=%s fontName=%s ',
                    [j, par3.font.height, par3.s, par3.font.fontName] );
      ksMessage(PChar(buf));
    end;
  end;

begin

  par.x1 := 55; par.y1 := 50;    //  ( ) 
  par.x2 := 40; par.y2 := 50;    //    
  par.xt := 40; par.yt := 52;    //  
  par._type := 0;                //    
  StrCopy( par.str, 'A' );       // 

  p := ViewPointer( Addr(par) ); //  " "
  if ( ExistObj( p ) > 0 ) then
  begin
    //  
    LightObj( p, 1 );
    ksMessage('  ');
    LightObj( p, 0 );

    //     " "
    FillChar( par, SizeOf(par), 0 );
    GetObjParam( p, Addr(par), SizeOf(par), ALLPARAM );
    tip := par._type;
    buf := Format( ' tip = %d x1 = %5.1f y1 = %5.1f x2 = %5.1f y2 = %5.1f xt = %5.1f yt = %5.1f ',
                     [tip, par.x1, par.y1, par.x2, par.y2, par.xt, par.yt]);
    ksMessage(PChar(buf));
    PrintPar1;
  end;
end;

//--------------------------------------------------------------------------------
//   
//---
procedure  WorkStamp;
begin

  if ( OpenStamp()>0 ) then
  begin
    ColumnNumber( 2 );     //    ,      
    //    
    TextLine( NEW_LINE,    //  ,    
              0,           //  
              nil,           //    
              '1111111' ); // 
    CloseStamp();
  end;

end;

//-------------------------------------------------------------------------------
//  
//---
procedure TableWork;
begin

  Table;
    //  
    LineSeg(50, 50, 90, 50, 1 );
    LineSeg(50, 40, 90, 40, 1 );
    LineSeg(50, 30, 90, 30, 1 );
    LineSeg(50, 50, 50, 30, 1 );
    LineSeg(70, 50, 70, 30, 1 );
    LineSeg(90, 50, 90, 30, 1 );
    //    
    ksText( 52, 48, 0, 5, 1, 0, '1' );
    ksText( 72, 48, 0, 5, 1, 0, '2' );
    ksText( 52, 38, 0, 5, 1, 0, '3' );
    ksText( 72, 38, 0, 5, 1, 0, '4' );
  EndObj;

end;

//--------------------------------------------------------------------------------
//  
//---
procedure DrawEquidistant;
var
  par  : EquidistantParam;
  info : RequestInfo;
  x, y : Double;
  j    : Integer;
  p1   : Reference;
begin


  par.side      := 2;     // ,     
                          // 0-  , 1-  , 2-  
  par.cutMode   := 0;     //    
                          // 0- , 1-  
  par.degState  := 0;     //     
                          // 0-  , 1-  
  par.radRight  := 5;     //  
  par.radLeft   := 3;     //  
  par.style     :=1;      //  
  info.commands := ' ';;
  info.title    := nil;   //      
  info.prompt   := nil;   //    
  info.cursor   := nil;   //       
  info.callBack := nil;   //     
  info._dynamic     := 0; //    1- , 0-
  info.commInstance := 0; // Instance ,     

 // 
  repeat
    j := ksCursor( Addr(info), x ,y, nil );
    if j <> 0 then
    begin
      par.geoObj := FindObj( x, y, 1e6 );
      if ExistObj( par.geoObj ) > 0 then
      begin
        p1 :=  Equidistant( Addr(par) ); //  
        if p1 <> 0 then                  //  
        begin
          LightObj( p1, 1 );             //  
          ksMessage( '' );
          LightObj( p1, 0 );
        end
        else
          MessageBoxResult();            //  
      end
      else
        Error( '  ' );
    end;
  until j = 0;
end;

//--------------------------------------------------------------------------------
//   
//---
procedure DrawEllipse;
var
  par : EllipseParam;          //  
  p   : Reference;             //  
begin
  par.xc    := 50;             //  
  par.yc    := 40;
  par.a     := 20;             //   
  par.b     := 10;
  par.ang   := 0;              // 
  par.style := 1;              //  
  p := ksEllipse( Addr(par) ); // 
  //  
  LightObj( p, 1 );
  ksMessage( '' );
  LightObj( p, 0 );
end;

//-------------------------------------------------------------------------------
//   
//---
procedure DrawPolyline;
type
  MathArr = array [0..4] of MathPointParam;
var
  par : PolylineParam; //  
  pr  : MathArr;       //  
  p   : Reference;     //  
  i   : Integer;
begin
  //   
  pr[0].x := 10; pr[0].y := 10;
  pr[1].x := 20; pr[1].y := 20;
  pr[2].x := 30; pr[2].y := 10;
  pr[3].x := 40; pr[3].y := 20;

  //      
  ksPolyline( 1 );
    for i := 0 to 3 do
    begin
      Point( pr[i].x, pr[i].y, 1 ); //    
      pr[i].y := pr[i].y + 10;      //      
    end;
  p := EndObj();

  LightObj( p, 1);
    ksMessage( '   ' );
  LightObj( p, 0);

  //     
  //   
  par.pMathPoint := CreateArray( POINT_ARR,  nil );

  //     
  for i := 0 to 3 do
    AddArrayItem( par.pMathPoint, -1, Addr(pr[i]), sizeof( MathPointParam ) );

  par.style := 2; //   - 2 -  

  //  
  p := _ksPolyline( Addr(par) );

  //  
  LightObj( p, 1);
  ksMessage( '  ' );
  LightObj( p, 0);

  //   
  DeleteArray( par.pMathPoint );
end;

//---------------------------------------------------------------------------------
//  Nurbs - 
//---
procedure DrawNurbs;
type
  NurbsArr = array [0..6] of NurbsPointParam;
var
  par : NurbsArr;  //    Nurbs-
  p   : Reference; //  
  i   : Integer;
begin
  //  
  par[0].x := 0;   par[0].y := 0;   par[0].weight := 1;
  par[1].x := 20;  par[1].y := 20;  par[1].weight := 1;
  par[2].x := 50;  par[2].y := 10;  par[2].weight := 1;
  par[3].x := 70;  par[3].y := 20;  par[3].weight := 1;
  par[4].x := 100; par[4].y := 0;   par[4].weight := 1;
  par[5].x := 50;  par[5].y := -50; par[5].weight := 1;

  //  Nurbs     
  Nurbs( 3, 1, 1 );
    for i:=0 to 5 do
      NurbsPoint( Addr(par[i]) ); //  Nurbs
  p := EndObj();

  //  Nurbs
  LightObj(p, 1 );
  ksMessage('NURBS');
  LightObj(p, 0 );

end;

//------------------------------------------------------------------------------
//  
//---
procedure WorkTolerance;
var
  par      : ToleranceParam; //   
  parPoint : MathPointParam; //  
  p        : Reference;      //  
  tip      : Integer;        // 
begin

  //  1- 
  par.branch1.arrowType  := 2;  //   ( 0 -  , 1 - , 2 -  )
  par.branch1.tCorner    := 1;  //   1  8,    ""  
  par.branch1.pMathPoint := CreateArray( POINT_ARR,  nil ); //   
  parPoint.x             := 40; //   
  parPoint.y             := 10;
  AddArrayItem( par.branch1.pMathPoint, -1, Addr(parPoint), SizeOf( parPoint ) );

  //  2- 
  par.branch2.arrowType  := 1;  //   ( 0 -  , 1 - , 2 -  )
  par.branch2.tCorner    := 5;  //   1  8,    ""  
  par.branch2.pMathPoint := CreateArray( POINT_ARR,  nil ); //   
  parPoint.x := 100; parPoint.y := 50; //    
  AddArrayItem( par.branch2.pMathPoint, -1, Addr(parPoint), SizeOf( parPoint ) );
  parPoint.x := 100; parPoint.y := 10; //    
  AddArrayItem( par.branch2.pMathPoint, -1, Addr(parPoint) , SizeOf( parPoint ) );

  par.x     := 40; //   
  par.y     := 40;
  par._type := 0;  //    ( 0 - , 1 -  )

  //      
  if(Tolerance( Addr(par) ) > 0) then
  begin
    //     
    // 1- 
    ColumnNumber( 1 );
    tip := 26;         // 
    TextLine( SPECIAL_SYMBOL, SPECIAL, Addr(tip), '' );

    // 2- 
    ColumnNumber( 2 );
    TextLine (NEW_LINE, 0, nil, '222' );

    // 3- 
    ColumnNumber( 3 );
    TextLine (NEW_LINE, 0, nil, '333' );

    // 11- 
    ColumnNumber( 11 );
    tip := 23;         // 
    TextLine ( SPECIAL_SYMBOL  ,SPECIAL, Addr(tip) ,'' );

    // 12- 
    ColumnNumber( 12 );
    TextLine (NEW_LINE  ,0, nil ,'444');

    // 13- 
    ColumnNumber( 13 );
    TextLine (NEW_LINE  ,0, nil ,'555');

    p := EndObj();    //     
    LightObj( p, 1 ); //  
    ksMessage( ' ' );
    LightObj( p, 0 );
  end;
  //   
  DeleteArray( par.branch2.pMathPoint );
  DeleteArray( par.branch1.pMathPoint );

end;

//--------------------------------------------------------------------------------
//    
//---
procedure  DrawInsFragment1;
var
  par     : PlacementParam; //   
  pDefFrg : Reference;      //      
  p       : Reference;      //  
begin

  //    
  pDefFrg := FragmentDefinition( 'c:\1.frw',  //   
                                     'frw1',  //  
                                         1 ); //   -   
                                              // 0-   , 1- 
  if( pDefFrg > 0 )  then
  begin
    par.xBase := 30; //   
    par.yBase := 40;
    par.ang   := 45; //  
    par.scale := 2;  // 
    //  " "
    p := InsertFragment( pDefFrg,     //    
                         0,           //    0 -    1-   
                         Addr(par) ); // 
    //  
    LightObj ( p, 1 );
    ksMessage( '  ' );
    LightObj ( p, 0 );
  end;
end;

//--------------------------------------------------------------------------------
//   
//---
procedure  DrawInsFragment2;
var
  par     : PlacementParam; //   
  pDefFrg : Reference;      //      
  p       : Reference;      //  
begin
  //    
  pDefFrg := 0;
  //   
  if( LocalFragmentDefinition( 'local' ) > 0 ) then
  begin
    //     
    LineSeg( 0, 0, 10, 0, 1 );
    LineSeg( 0, 0, 0, 10, 1 );
    ArcByPoint( 0, 0,   //  
                10,     //  
                10, 0,  //   
                0, 10,  //   
                -1,     //   
	  	          1 );    //   
    //     
    pDefFrg := CloseLocalFragmentDefinition();
  end;

  if( pDefFrg > 0 ) then
  begin
    par.xBase := 30; //   
    par.yBase := 40;
    par.ang   := 45; //  
    par.scale := 2 ; // 
    //   " "
    p := InsertFragment( pDefFrg,     //    
                         0,           //     0 -    1-   
                         Addr(par) ); //  
    //  
    LightObj ( p, 1 );
    ksMessage( '  ' );
    LightObj ( p, 0 );
  end;
end;

end.
