unit step4_1;

interface
uses
  Windows,
  SysUtils,
  LDefin2D,
  ksConstTLB,
  ksAuto,
  Classes,
  Forms,
{$IFDEF __LIGHT_VERSION__}
  klTLB;
{$ELSE}
  ksTLB;
{$ENDIF}

  procedure LIBRARYENTRY( command: WORD  ); Pascal;
  function  LIBRARYID : Cardinal; Pascal;
  function  CallBackProcPlacement( comm : Integer; var x, y, ang : Double; rInfo, rPhan : PIDispatch;
                               _dynamic : Integer ) : Integer; stdcall;
  function CallBackProcCursor( comm     : Integer; var x, y : Double; rInfo, rPhan : PIDispatch;
                              _dynamic  : Integer ) : Integer; stdcall;
implementation
uses
  step4_3; {TestSlideDlg}

var
  kompas : KompasObject;
  doc    : ksDocument2D;
  _type, flag : integer;

//-------------------------------------------------------------------------------
//
// ---
procedure TestShowDialog;
var
  dlg : TTestSlideDlg;
begin
  Forms.Application.Handle := kompas.ksGetHWindow;
  kompas.ksEnableTaskAccess( 0 ); //    
	//   -     ,   
	dlg        := TTestSlideDlg.Create( Forms.Application );
  dlg.doc    := doc;
  dlg.kompas := kompas;
  dlg.ShowModal;                    //  
	kompas.ksEnableTaskAccess( 1 ); //    
  Forms.Application.Handle := 0;
end;

//-------------------------------------------------------------------------------
//
// ---
procedure DrawTxtDB;
type
userData = record
 dr, l :   double ;
 f     : SmallInt;
end;
userData1 = record
 d  :   double;
 l  :   double;
end;

var
  bd, r1, r2, r3 : reference;
  i              : Integer;
  buf            : string;
  libName        : string;
  con            : userData1;
  b              : userData;
  data           : ksDataBaseObject;
  par            : ksUserParam;
  item           : ksLtVariant;
  arr            : ksDynamicArray;

begin
  i := 1;
	data := ksDataBaseObject( kompas.DataBaseObject );
  par  := ksUserParam( kompas.GetParamStruct(ko_UserParam) );
  item := ksLtVariant( kompas.GetParamStruct(ko_LtVariant) );
	arr  := ksDynamicArray( kompas.GetDynamicArray(LTVARIANT_ARR) );
  if ( (par = nil) Or (item = nil) Or (data = nil) Or (arr = nil) ) then
		Exit;
	par.Init;
	par.SetUserArray( arr );
	item.Init;
	  item.doubleVal := 0;
	  arr.ksAddArrayItem( -1, item );
	item.Init;
  	item.doubleVal := 0;
		arr.ksAddArrayItem( -1, item );
  item.Init;
	  item.intVal := 0;
	  arr.ksAddArrayItem( -1, item );

	libName := kompas.ksChoiceFile( '*.loa', ' (*.loa)|*.loa|  (*.*)|*.*|', True );
  if ( libName <> '' ) then begin
    bd := data.ksCreateDB( 'TXT_DB' ); //  ,   
    //       (    -   )
    if ( data.ksConnectDB(bd, libName) <> 0 ) then begin
      r1 := data.ksRelation( bd );     //   -      
        data.ksRDouble( 'dr' );        //    ,
        data.ksRDouble( 'L'  );        //       
				data.ksRInt   ( ''   );
      data.ksEndRelation;

      //   -    (   
      //      )
      data.ksDoStatement( bd, r1, '1 2 3' );   //  dr - 1, L - 2,   -3
      while i <> 0 do begin
        i := data.ksReadRecord( bd, r1, par ); //         b
        if ( i <> 0 ) then begin
  				arr.ksGetArrayItem( 0, item );
					b.dr := item.doubleVal;
	  			arr.ksGetArrayItem( 1, item );
					b.l := item.doubleVal;
	  			arr.ksGetArrayItem( 2, item );
					b.f := item.intVal;
          buf := Format( 'DR = %g, L = %g, F = %d', [b.dr, b.l, b.f] );
          kompas.ksMessage( buf );
        end;
      end;
      kompas.ksMessage( 'end' );

			i := 1;
			arr.ksClearArray;
      item.Init;
	      item.strVal := '';
			  arr.ksAddArrayItem( -1, item );
      r2 := data.ksRelation( bd );       //   -      
 				data.ksRChar( '', 255, 0 );
      data.ksEndRelation;

      data.ksDoStatement( bd, r2, '2' ); //   -    (   
      while i <> 0 do begin
        i := data.ksReadRecord( bd, r2, par ); //         b
        if ( i <> 0 ) then begin
 					arr.ksGetArrayItem( 0, item );
					buf := Format( 'L = %s', [item.strVal] );
					kompas.ksMessage( buf );
        end;
      end;
      kompas.ksMessage( 'end' );

			i := 1;

			arr.ksClearArray;
      item.Init;
	      item.doubleVal := 0;
			  arr.ksAddArrayItem( -1, item );
      item.Init;
	      item.doubleVal := 0;
			  arr.ksAddArrayItem( -1, item );
      r3 := data.ksRelation( bd ); //   -      
 				data.ksRDouble( ''  );
				data.ksRDouble( 'L' );
      data.ksEndRelation;

      data.ksDoStatement( bd, r3, '1 2' ); //   -    (   
			data.ksCondition( bd, r3, 'L=100 || L=150' );
      while i <> 0 do begin
        i := data.ksReadRecord( bd, r3, par ); //         b
        if ( i <> 0 ) then begin
 					arr.ksGetArrayItem( 0, item );
          con.d := item.doubleVal;
					arr.ksGetArrayItem( 1, item );
					con.l := item.doubleVal;
					buf := Format( 'dr = %g, L = %g', [con.d, con.l] );
					kompas.ksMessage( buf );
        end;
      end;
      kompas.ksMessage( 'end' );
    end;
    data.ksDeleteDB( bd ); // ,   
  end;
end;

//-------------------------------------------------------------------------------
//
// ---
procedure WriteSlideStep;
var
  name    : string;
  info    : ksRequestInfo;
	x, y    : Double;
	slideID : LongInt;
begin
  //   
  name := kompas.ksSaveFile( '*.rc', '', '', false );
	if ( name <> '' ) then begin
	  info := ksRequestInfo( kompas.GetParamStruct(ko_RequestInfo) );
		if ( info <> nil ) then begin
			info.Init;
			info.commandsString := '   ';
	    //    -      
			if ( doc.ksCursor(info, x, y, Nil) <> 0 ) then begin
				if ( kompas.ksReadInt('  ', 100, 0, 32000, slideID) <> 0 ) then begin
					if ( kompas.ksWriteSlide(name, slideID, x,  y) = 0 ) then
						kompas.ksError( '  ' );
					doc.ksClearGroup( 0, true );
				end;
      end;
    end;
  end;
end;

//---------------------------------------------------------------------------------
//     
//----------------------------------------------------------------------------------
procedure WorkRelativePath;
var
  mainName, fileName, relName, fullName, mess : string;
begin
  //  
	mainName := kompas.ksChoiceFile( '*.*', '  (*.*)|*.*|', true );
	fileName := kompas.ksChoiceFile( '*.*', '  (*.*)|*.*|', true );
	if ( (mainName <> '') Or (fileName <> '') ) then begin
    //  
		relName := kompas.ksGetRelativePathFromFullPath( mainName,  //     
																										fileName ); //     

		mess := '  : ' + mainName + #13;
    mess := mess + '  : ' + fileName + #13;
    mess := mess + '  : ' + relName;
		kompas.ksMessage( mess );

    //  
		fullName := kompas.ksGetFullPathFromRelativePath( mainName,  //     
																											relName ); //     (        )
    mess := '  : ' + mainName + #13;
    mess := mess + '  : ' + relName + #13;
    mess := mess + '  : ' + fullName;
		kompas.ksMessage( mess );
	end;
end;

//---------------------------------------------------------------------------------
//    
//----------------------------------------------------------------------------------
procedure WorkSystemPath;
var
  catalogName    : array [0..5] of pChar;
  info           : ksRequestInfo;
  j, typeCatalog : Integer;
  buf            : PChar;
  fileName, mess, relName : string;
begin
  catalogName[0]  := '  ';
  catalogName[1]  := ' '       ;
  catalogName[2]  := '  ';
  catalogName[3]  := ' '    ;
  catalogName[4]  := 'INI-' ;

  //       
  info := ksRequestInfo( kompas.GetParamStruct(ko_RequestInfo) );
	if ( info <> nil ) then begin
		info.Init;
		info.title          := '  ';
		info.commandsString := '! ! ! ! !INI- ';
		info.prompt         := '  ';
		buf                 := 'user.ttt';
		repeat
			j := doc.ksCommandWindow( info );
			if ( j > 0 ) then begin
        typeCatalog := 0;
				case j of
					1 : typeCatalog := sptSYSTEM_FILES; //    
					2 : typeCatalog := sptLIBS_FILES  ; //    
					3 : typeCatalog := sptTEMP_FILES  ; //     
					4 : typeCatalog := sptCONFIG_FILES; //     
					5 : typeCatalog := sptINI_FILE    ; //    INI- 
        end;
				// 
				fileName := kompas.ksGetFullPathFromSystemPath( buf,           //    (    )
																		                    typeCatalog ); //    . ksSystemPath
				mess := '    user.ttt ' + #13 + catalogName[j - 1] + ' :' + #13 + fileName;
				kompas.ksMessage( mess );

				// 
				relName := kompas.ksGetRelativePathFromSystemPath( fileName,      //    
																		                       typeCatalog ); //    . ksSystemPath
				mess := '    ' + #13 + fileName + #13 + catalogName[j -1] + ' :' + #13 + relName;
				kompas.ksMessage( mess );
			end;
		until j <= 0;
	end;
end;

//------------------------------------------------------------------------------
//   ,   Cursor
// ---
function CallBackProcCursor( comm : Integer; var x, y : Double; rInfo, rPhan : PIDispatch;
                             _dynamic : Integer ) : Integer;  stdcall; Export;
var
  info : ksRequestInfo;
  phan : ksPhantom;
  t1   : ksType1;
begin
	info := ksRequestInfo( rInfo );
	phan := ksPhantom( rPhan );
	if ( (info <> nil) And (phan <> nil) ) then begin
		t1 := ksType1( phan.GetPhantomParam );
		case comm of
			1, 2  : _type := comm;
			-1    : begin //   
                doc.ksMoveObj( t1.gr, x, y );
                if ( Abs(t1.Angle) > 0.001 ) then
                  doc.ksRotateObj( t1.gr, x, y, t1.Angle );
                doc.ksStoreTmpGroup( t1.gr );
                doc.ksClearGroup( t1.gr, true );
              end;
		end;
//            
		if ( t1.gr <> 0 ) then
			doc.ksDeleteObj( t1.gr );
		t1.gr := doc.ksNewGroup( 1 );   //  

		if ( ((flag = 1) And (comm = 1)) Or ((flag = 2) And (comm = 2)) ) then
		  _type := 3;

//         
	  case _type of
		  1 : begin
            doc.ksCircle( 0, 0, 20, 1 );
            info.commandsString := '! ! ';
            flag := 1;
				  end;
			2 : begin
            doc.ksLineSeg( -10, 0,  10,  0,  1 );
            doc.ksLineSeg( 10,  0,  0,   20, 1 );
            doc.ksLineSeg( 0,   20, -10, 0,  1 );
            info.commandsString := '! ! ';
            flag := 2;
  				end;
			3 : begin
            doc.ksLineSeg( -10, 0,  10,  0,  1 );
            doc.ksLineSeg( 10,  0,  10,  20, 1 );
            doc.ksLineSeg( 10,  20, -10, 20, 1 );
            doc.ksLineSeg( -10, 20, -10, 0,  1 );
            info.commandsString := '! ! ';
            flag := 0;
          end;
		end;

		doc.ksEndGroup;
	end;
	Result := 1;
end;

//------------------------------------------------------------------------------
//   ,   Placement
// ---
function CallBackProcPlacement( comm : Integer; var x, y, ang : Double; rInfo, rPhan : PIDispatch;
                             _dynamic : Integer ) : Integer; stdcall; Export;
var
  info : ksRequestInfo;
  phan : ksPhantom;
  t1   : ksType1;
begin
	info := ksRequestInfo( rInfo );
	phan := ksPhantom( rPhan );
	if ( (info <> nil) And (phan <> nil) ) then begin
		t1 := ksType1( phan.GetPhantomParam );
		case comm of
			1, 2  : _type := comm;
			-1    : begin //   
                doc.ksMoveObj( t1.gr, x, y );
//   Cursor      
                if ( Abs(ang) > 0.001 ) then
                  doc.ksRotateObj( t1.gr, x, y, ang );
                doc.ksStoreTmpGroup( t1.gr );    //     
                doc.ksClearGroup( t1.gr, true );
              end;
		end;

//            
		if ( t1.gr <> 0 ) then
			doc.ksDeleteObj( t1.gr );
		t1.gr := doc.ksNewGroup( 1 );   //  

//         
	  if ( ((flag = 1) And (comm = 1)) Or ((flag = 2) And (comm = 2)) ) then
		  _type := 3;

	  case _type of
		  1 : begin
            doc.ksCircle( 0, 0, 20, 1 );
            info.commandsString := '! ! ';
            flag := 1;
				  end;
			2 : begin
            doc.ksLineSeg( -10, 0,  10,  0,  1 );
            doc.ksLineSeg( 10,  0,  0,   20, 1 );
            doc.ksLineSeg( 0,   20, -10, 0,  1 );
            info.commandsString := '! ! ';
            flag := 2;
  				end;
			3 : begin
            doc.ksLineSeg( -10, 0,  10,  0,  1 );
            doc.ksLineSeg( 10,  0,  10,  20, 1 );
            doc.ksLineSeg( 10,  20, -10, 20, 1 );
            doc.ksLineSeg( -10, 20, -10, 0,  1 );
            info.commandsString := '! ! ';
            flag := 0;
          end;
		end;

		doc.ksEndGroup;
	end;

	Result := 1;
end;

//-------------------------------------------------------------------------------
//
// ---
procedure DrawRectCallBack;
var
  phan      : ksPhantom;
  t1        : ksType1;
  info      : ksRequestInfo;
  x, y, ang : Double;
begin
  _type := 1;
	phan  := ksPhantom( kompas.GetParamStruct(ko_Phantom) );
	if ( phan <> nil ) then begin
		phan.Init;
		phan.phantom := 1;
		t1 := ksType1( phan.GetPhantomParam );
		if ( t1 <> nil ) then begin
			t1.Init;
			t1.scale_ := 1;
			t1.gr     := doc.ksNewGroup( 1 );   //  
		    doc.ksCircle( 0, 0, 20, 1 );
			doc.ksEndGroup;

			info := ksRequestInfo( kompas.GetParamStruct(ko_RequestInfo) );
			if ( info <> nil ) then begin
				info.Init;
				info.commandsString := '! ! ';
				//      Placement
				info.SetCallBackP( 'CALLBACKPROCPLACEMENT', HInstance, nil );
				doc.ksPlacement( info, x, y, ang, phan );

				t1.gr := doc.ksNewGroup( 1 );   //  
			    doc.ksCircle( 0, 0, 20, 1 );
				doc.ksEndGroup;

				//      Cursor
				info.SetCallBackC( 'CALLBACKPROCCURSOR', HInstance, nil );
				doc.ksCursor( info, x, y, phan );
			end;
		end;
	end;
end;

//-------------------------------------------------------------------------------
//
// ---
procedure DrawRectNULL;
var
  j         : Integer;
  phan      : ksPhantom;
  t1        : ksType1;
  info      : ksRequestInfo;
  x, y, ang : Double;
begin
  _type := 1;
  flag  := 1;
  j     := 1;
	phan  := ksPhantom( kompas.GetParamStruct(ko_Phantom) );
	if ( phan <> nil ) then begin
		phan.Init;
		phan.phantom := 1;
		t1          := ksType1( phan.GetPhantomParam );
		if ( t1 <> nil ) then begin
			t1.Init;
			t1.scale_ := 1;
			t1.gr     := 0;   //  

			info := ksRequestInfo( kompas.GetParamStruct(ko_RequestInfo) );
			if ( info <> nil ) then begin
				info.Init;
			  while j <> 0 do begin
					if ( t1.gr <> 0 ) then
						doc.ksDeleteObj( t1.gr );

					t1.gr := doc.ksNewGroup( 1 ); //  
					if ( ((flag = 1) And (j = 1)) Or ((flag = 2) And (j = 2)) ) then
						_type := 3;

          case _type of
            1 : begin
                  doc.ksCircle( 0, 0, 20, 1 );
                  info.commandsString := '! ! ';
                  flag := 1;
                end;
            2 : begin
                  doc.ksLineSeg( -10, 0,  10,  0,  1 );
                  doc.ksLineSeg( 10,  0,  0,   20, 1 );
                  doc.ksLineSeg( 0,   20, -10, 0,  1 );
                  info.commandsString := '! ! ';
                  flag := 2;
                end;
            3 : begin
                  doc.ksLineSeg( -10, 0,  10,  0,  1 );
                  doc.ksLineSeg( 10,  0,  10,  20, 1 );
                  doc.ksLineSeg( 10,  20, -10, 20, 1 );
                  doc.ksLineSeg( -10, 20, -10, 0,  1 );
                  info.commandsString := '! ! ';
                  flag := 0;
                end;
          end;

					doc.ksEndGroup;

					j := doc.ksPlacement( info, x, y, ang, phan );
//					j := doc.ksCursor( info, x, y, phan );
          case j of
            1, 2  : _type := j;
            -1    : begin //   
                      doc.ksMoveObj( t1.gr, x, y );
//                      if ( Abs(t1.Angle) > 0.001 ) then
//                        doc.ksRotateObj( t1.gr, x, y, t1.Angle );
      //   Cursor      
                      if ( Abs(ang) > 0.001 ) then
                        doc.ksRotateObj( t1.gr, x, y, ang );
                      doc.ksStoreTmpGroup( t1.gr );    //     
                      doc.ksClearGroup( t1.gr, true );
                    end;
          end;
				end;
			end;
		end;
	end;
end;

//------------------------------------------------------------------------------
// LibraryId
//---
function LIBRARYID: UINT; pascal;
begin
  Result := 10;
end;

//------------------------------------------------------------------------------
// LibraryEntry
//---
procedure LIBRARYENTRY( command: WORD ); pascal;
var
 h1, i : LongInt;
 buf   : string;
begin
  kompas := KompasObject( CreateKompasObject );

  if kompas <> nil then begin
    case command of
      1 : DrawTxtDB; //   
      3 : begin      //   
            if ( kompas.ksReadInt(' ', 10000, -100000, 100000, h1) <> 0 ) then begin
              buf := Format( 'h = %d', [h1] );
              kompas.ksMessage( buf );
            end
            else
              kompas.ksMessage( '' );
          end;
      4  : begin  //   
            buf := kompas.ksChoiceFile( '*.cdw', '', true );
            if ( buf <> '' ) then
              kompas.ksMessage( buf )
            else
              kompas.ksMessage( '' );
          end;
      9  : WorkRelativePath; //     

      else begin
        doc := ksDocument2D( kompas.ActiveDocument2D );
        if ( doc <> nil ) then begin
          case command of
            2  : begin //  
                   if ( kompas.ksYesNo('  CallBack?') > 0 ) then
                     DrawRectCallBack
                   else
                     DrawRectNULL;
                 end;
            6  : WriteSlideStep; //   
            7  : TestShowDialog; //   (    step4_3.cpp )
            8  : begin
                   kompas.ksEnableTaskAccess( 0 ); //   
                   for i := 0 to 9999 do begin
                     doc.ksLineSeg( 10, 10 + i, 20, 10 + i, 1 );
                     if ( (i div 100) = 0 ) then begin
                       //     
                       //      
                       PostThreadMessage( GetCurrentThreadId, 0, 0, 0 );
                       kompas.ksPumpWaitingMessages; //   100    
                                                     //   Windows    
                                                     // ,     
                     end;
                   end;
                   kompas.ksEnableTaskAccess( 1 ); //   
                 end;
            10 : WorkSystemPath; //    
          end;
          doc := nil;
        end;
      end;
      kompas.ksMessageBoxResult;
    end;
    kompas := nil;
  end;
end;

end.
