unit Step44;
//******************************************************************/
//*                (c)                     */
//*                -, 1991, 1996                     */
//*                 -   5.x                      */
//******************************************************************/
//*                                                    */
//*                                                                */
//* 1.                              - DrawTxtDB           */
//* 2.  Cursor  Placement           - DrawRectCallBack,   */
//*                                            DrawRectNULL        */
//*                                          - <step4_1.pas>       */
//* 3.                     - EnterInteger        */
//* 4.                        - SelectFileName      */
//* 5.                          - WriteSlideStep      */
//* 6.                        - TestShowDialog      */
//*                                          - <step4_2.pas>       */
//* 7.      - TaskAccess          */
//* 8.                 - WorkRelativePath    */
//* 9.            - WorkSystemPath      */
//*                                                                */
//******************************************************************/

interface

  procedure LIBRARYENTRY( comm: WORD  ); Pascal;
  function  LIBRARYID   : Cardinal;      Pascal;

//-------------------------------------------------------------------------------
//   
// ---
  procedure DrawTxtDB;
  procedure EnterInteger;
  procedure ChoiceFileName;
  procedure TestPumpWaitingMessages;
  procedure WorkSystemPath;
  procedure WorkRelativePath;
  procedure WriteSlideStep;

implementation

uses Windows,  Sysutils, LtDefine, LibTool, step4_1, LibDB, LDefin2D;

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

//----------------------------------------------------------------------------------------
//   
//---
procedure  LIBRARYENTRY( comm : Word ); pascal;
begin
  case comm of
   1:  DrawTxtDB();             //   
   2:  begin                    // Placement, Cursor  (   step4_1.pas )
       if ( YesNo('  CallBack?') = 1 ) then
         DrawRectCallBack()
       else
         DrawRectNULL();
       end;
   3:  EnterInteger;            //   
   4:  ChoiceFileName;          //   
   5:  begin                    //  
//       TestDrawBitmap;
       end;
   6:  WriteSlideStep();        //   
   7:  begin                    //  
//        TestShowDialog();
       end;
   9:  TestPumpWaitingMessages; //     
   10: WorkRelativePath;        //     
   11: WorkSystemPath;          //    
  end; {case}
end;

//-------------------------------------------------------------------------------
//   
//---
procedure EnterInteger;
var
  h1  : LongInt; //   
  buf : String;
begin
  //     -100000..100000
  //   10000
  if ( ReadLong( ' ', 10000, -100000, 100000, h1 ) > 0 ) then
  begin
    buf := Format( 'h = %d', [h1] );
    ksMessage( PChar(buf) );
  end
  else
    ksMessage( '' );
end;

//------------------------------------------------------------------------------
//  
//---
procedure ChoiceFileName;
var
  name : array [0..255] of Char;
  size : Cardinal;
begin
  //  
  size := ksChoiceFile( '*.cdw',
                        '(*.cdw)|*.cdw|(*.frw)|*.frw|  (*.*)|*.*|',
                        name, 255, 1);
  if ( size > 0 ) then
    ksMessage(name)
  else
    ksMessage('');
end;

//------------------------------------------------------------------------------
//   
//---
procedure TestPumpWaitingMessages;
var
  i, j : Integer;

begin
  EnableTaskAccess( 0 ); //    
  for  i:=0 to 10000 do
  begin
    LineSeg( 0, i, 20, i, 1 );
    j := i div 100;
    if j <> 0 then
    begin
      //     
      //      
      PostThreadMessage( GetCurrentThreadId(), 0, 0, 0 );
      PumpWaitingMessages(); //   100    
                             //   Windows    
                             // ,     
    end;
  end;
  EnableTaskAccess( 1 ); //    
end;

//------------------------------------------------------------------------------
//      
//        , 
//      .
//---
procedure DrawTxtDB;
type
  //  
  UserData = record
    dr, l : Double;
    f     : SmallInt;
  end;

  //   1
  UserData1 = record
    d     : Double;
    l     : Double;
  end;

var
  name :array [0..255] of Char; //    
  s   : array [0..22]  of Char; //   
  bd,                           //   
  r1, r2, r3 : Reference;       // 
  tmpD: UserData1;              //  
  b   : UserData;               //  
  i :  Integer;
  buf : string;
begin
  //     
  if ( ksChoiceFile( '*.loa',' (*.loa)|*.loa|  (*.*)|*.*|', name, 255, 0 ) > 0 ) then
  begin
    //  ,   
    bd := CreateDB('TXT_DB');
    //       (    -   )
    if ( ConnectDB( bd, name) > 0 ) then
    begin
      //   -      
      //      double   int;      
      //  ,     >=   Relation
      r1 := Relation( bd );
        RDouble( 'dr' );//    ,
        RDouble( 'L' ); //       
        RInt ('');
      EndRelation();
      //          
      //        
      r2 := Relation( bd );
        RChar( 'L', 20, 0 ); //   (   20 )
      EndRelation();

      //   -    
      //        
      DoStatement( bd, r1, '1 2 3' ); //  dr - 1, L - 2,   -3
                                      // (    
                                      //  ,   
                                      //   -"" )

      DoStatement( bd, r2, '2' );     //     2  

      //     
      // ConditionTxt(   bd, r1, "Index1000 = 2" ); //   2
      i := 1;
      while( i > 0 ) do
      begin
        i := ReadRecord( bd, r1, Addr(b) ); //         b
        if ( i > 0 ) then
        begin
          buf := Format( 'dr=%4.1f l=%4.1f f=%d', [b.dr, b.l, b.f] );
          ksMessage( PChar(buf) );
        end;
      end;
      ksMessage( ' ' );
      i := 1;
      while ( i > 0 ) do
      begin
        i := ReadRecord( bd, r2, Addr(s) ); // C 
        if i > 0 then
          ksMessage( s );
      end;
      ksMessage( ' ' );
      //    
      r3 := Relation( bd );
        RDouble( ''  );
        RDouble( 'L' );
      EndRelation;
      //  
      DoStatement( bd, r3, '1 2' );
      //   (       L  100  120
      Condition(   bd, r3, 'L=100 || L=120' ); //  
      i := 1;
      while ( i > 0 ) do
      begin
        i := ReadRecord( bd, r3, Addr(tmpD) ); //  
        if ( i > 0 ) then
        begin
          buf := Format( 'd=%4.1f ', [ tmpD.d]);
          ksMessage( PChar(buf));
        end;
      end;
    end;
    //  ,   
    //    ,    
    DeleteDB( bd );
  end;
end;

//------------------------------------------------------------------------------
//      (     )
//---
procedure WriteSlideStep;
var
  info    : RequestInfo;            //  
  x, y    : double;                 // 
  name    : array [0..255] of char; // 
  slideID : integer;                //  

begin
  //    
  if ( ksSaveFile( '*.rc', nil, nil, name, 255, 0 ) > 0 )  then
  begin
     info.commands := '   '; // 

     info.title        := nil; //      
     info.prompt       := nil; //    
     info.cursor       := nil; //       
     info.callBack     := nil; //     
     info._dynamic     := 0;   //    1- , 0-
     info.commInstance := 0;   // Instance ,     

     //    -      
     if ( ksCursor( Addr(info), x, y, nil ) <> 0 ) then
     begin
       if ( ReadInt( '  ', 100, 0, 32000, slideID ) > 0 ) then
       begin
         //  
         if (WriteSlide( name, slideID, x,  y  ) = 0 ) then
           Error('  ');
         ClearGroup(0);        //  
       end;
     end;
  end;
end;


//---------------------------------------------------------------------------------
//     
//---
procedure WorkRelativePath;
var
  mainName : array [0..255] of Char; //     
  fileName : array [0..255] of Char; //     
  relName  : array [0..255] of Char; //  
  fullName : array [0..255] of Char; //     
  mess     : string;

begin
  //   
  if ( ksChoiceFile( '*.*', '  (*.*)|*.*|', mainName, 255, 0 ) > 0 ) then
  begin
    if ( ksChoiceFile( '*.*', '  (*.*)|*.*|', fileName, 250, 0 ) > 0 ) then
    begin
      // 
      ksGetRelativePathFromFullPath( mainName, //     
                                     fileName, //     
                                     relName,  // ()     (        )
                                     250 );    //  

      mess := '  : ';
      mess := mess + mainName;
      ksMessage( PChar(mess) );
      mess := '  : ';
      mess := mess + fileName;
      ksMessage( PChar(mess) );

      mess := '  : ';
      mess := mess + relName ;
      ksMessage( PChar(mess) );

      // 
      ksGetFullPathFromRelativePath( mainName, //     
                                     relName,  //     (        )
                                     fullName, // ()     
                                     250 );    //  

      mess := '  : ';
      mess := mess + mainName;
      ksMessage( PChar(mess) );
      mess := '  : ';
      mess := mess + relName ;
      ksMessage( PChar(mess) );
      mess := '  : ';
      mess := mess + fullName;
      ksMessage( PChar(mess) );

    end;
  end;
end;

//------------------------------------------------------------------------------
//    
//---
procedure  WorkSystemPath;
var
  info          : RequestInfo;             //  
  typeCatalog,j : Integer;                 //  
  fileName      : array [0..255] of Char;  //  
  buf           : PChar;                   //  
  mess          : String;                  // 
  relName       : array [0..255] of Char;  // 
  catalogName   : array [0..5]   of PChar; //  

begin
  catalogName[0] := '  ';
  catalogName[1] := ' '       ;
  catalogName[2] := '  ';
  catalogName[3] := ' '    ;
  catalogName[4] := 'INI-';

  //      
  info.cursor       := nil; //       
  info.callBack     := nil; //     
  info._dynamic     := 0;   //    1- , 0-
  info.commInstance := 0;   // Instance ,     

  //   
  info.title    := '   ';
  //    !
  info.commands := '! ! ! ! !INI-';
  // 
  info.prompt   := '  ';
  buf           := 'user.ttt';

  repeat
    j := CommandWindow( Addr(info) );        //  
    if ( j > 0 ) then
    begin
      case j of
        2 :  typeCatalog := sptLIBS_FILES;   //    
        3 :  typeCatalog := sptTEMP_FILES;   //     
        4 :  typeCatalog := sptCONFIG_FILES; //     
        5 :  typeCatalog := sptINI_FILE;     //    INI- 
        else typeCatalog := sptSYSTEM_FILES; //    
      end;
      // 
      ksGetFullPathFromSystemPath( buf ,          //    (    )
                                   fileName,      // ()    
                                   250,           //  
                                   typeCatalog ); //    . ksSystemPath
      mess := '    user.ttt - ';
      mess := mess + catalogName[j -1];
      mess := mess + ' : ';
      mess := mess + fileName ;
      ksMessage( PChar(mess) );

      // 
      ksGetRelativePathFromSystemPath( fileName,      //    
                                       relName,       // ()    (    )
                                       250,           //  
                                       typeCatalog ); //    . ksSystemPath
     mess := '    ';
     mess := mess + fileName;
     mess := mess + catalogName[j -1];
     mess := mess + ' : ';
     mess := mess + relName;
     ksMessage( PChar(mess) );

    end;
  until ( j = -1 );
end;

end.
