home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / test / tformnew.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-13  |  14.7 KB  |  662 lines
  1. Program TFormnew;
  2.  
  3. Uses
  4.  
  5.   VTypesu,
  6.   VInu,
  7.   VGenu,
  8.   VCRTu,
  9.   VStringu,
  10.   vuiwinu,
  11.   vuiwidgu,
  12.   vuiformu;
  13.  
  14. VAR
  15.  
  16.    GlobalTest : BOOLEAN;
  17.    F          : ARRAY[0..30] of TFormNode;
  18.    S          : ARRAY[1..4] of ST80;
  19.    M          : TMenu;
  20.    M1         : TMenu50;
  21.    B          : BYTE;
  22.    Start      : BYTE;
  23.    Retcode    : INTEGER;
  24.    HexMode    : BOOLEAN;
  25.  
  26. {------------------------------------------------------}
  27.  
  28.  
  29. Procedure GetFillPattern(     Start       : ST80;
  30.                               X           : BYTE;
  31.                               Y           : BYTE;
  32.                               FC          : BYTE;
  33.                               BC          : BYTE;
  34.                               ReadPattern : BOOLEAN;
  35.                           var HexMode     : BOOLEAN;
  36.                           var Pattern     : STRING  );
  37.  
  38. Type
  39.  
  40.   TMyBytes = Array[1..32] of BYTE;
  41.   PMyBytes = ^TMyBytes;
  42.  
  43. VAR
  44.    Halfway : BOOLEAN;
  45.    BitNum  : BYTE;
  46.    Bytes   : PMyBytes;
  47.    Ch      : CHAR;
  48.    Ch1     : CHAR;
  49.    Loopy   : BYTE;
  50.    Test    : BOOLEAN;
  51.    S       : ST80;
  52.    OldInfo : ST80;
  53.    OldMsg  : ST80;
  54.    Len     : BYTE;
  55.  
  56.    {==================================}
  57.    Procedure MoveCursor;
  58.    BEGIN
  59.  
  60.      If ( HexMode ) AND ( Halfway ) Then
  61.        GotoXY( X + 2 + ( BitNum ) * 3, Y )
  62.      Else If HexMode Then
  63.        GotoXY( X + 1 + ( BitNum ) * 3, Y )
  64.      Else GotoXY( X + 51 + Bitnum, Y );
  65.  
  66.    END;   { Of MoveCursor }
  67.    {==================================}
  68.    Procedure WriteScreen;
  69.    VAR
  70.       Loopy  : BYTE;
  71.       Ch     : CHAR;
  72.  
  73.    BEGIN
  74.      S := '';
  75.  
  76.      For Loopy := 1 to 16 Do
  77.        If ( Loopy - 1 = Len ) AND
  78.                ( BitNum = Len ) AND
  79.                ( Halfway ) Then
  80.        BEGIN
  81.          S := S + ' ' + ByteToHex( Bytes^[Loopy] );
  82.  
  83.          S[Length( S )] := '-'
  84.        END   { Of Then }
  85.        Else If Loopy > Len Then
  86.          S := S + ' --'
  87.        Else
  88.          S := S + ' ' + ByteToHex( Bytes^[Loopy] );
  89.  
  90.      S := S + ' │ ';
  91.  
  92.      For Loopy := 1 to 16 Do
  93.      BEGIN
  94.        Ch := Chr( Bytes^[Loopy] );
  95.  
  96.        If Ord( Ch ) in [1..254] Then
  97.          S := S + Ch
  98.        Else
  99.          S := S + '.';
  100.      END;   { Of For }
  101.  
  102.      WFastWrite( X, Y, FC, BC, S );
  103.  
  104.      MoveCursor;
  105.    END;   { Of WriteScreen }
  106.    {===============================}
  107.  
  108. BEGIN
  109.   BitNum  := 0;
  110.   Halfway := FALSE;
  111.   OldInfo := '';
  112.   OldMsg  := '';
  113.   Ch      := #255;
  114.   Ch1     := #255;
  115.   Len     := Length( Start );
  116.  
  117.  
  118. (*
  119.   For Loopy := 2 to 80 Do
  120.     OldInfo := OldInfo + Vid_Mem^[WinEnv.LastRow - 1, Loopy].Ch;
  121.  
  122.   For Loopy := 2 to 80 Do
  123.     OldMsg := OldMsg + Vid_Mem^[WinEnv.LastRow, Loopy].Ch;
  124. *)
  125.  
  126.   OldInfo := '';
  127.   OldMsg  := '';
  128.  
  129.   GetMem( Bytes, 16 );
  130.  
  131.   For Loopy := 1 to Length( Start ) Do
  132.     Bytes^[Loopy] := Ord( Start[Loopy] );
  133.  
  134.   For Loopy := Length( Start ) + 1 to 16 Do
  135.     Bytes^[Loopy] := 0;
  136.  
  137.   WriteScreen;
  138.  
  139.   If NOT ReadPattern Then
  140.   BEGIN
  141.     Pattern := Start;
  142.  
  143.     Freemem( Bytes, 16 );
  144.  
  145.     Exit;
  146.   END;   { Of Then }
  147.  
  148.   WInfoMsg( Pad( 'If no pattern is entered, a null string will be returned',
  149.                  79, ONCENTER, ' ' ), BLUE, CYAN );
  150.  
  151.   WMessage( '<Insert>=Hex/ASCII Toggle|' +
  152.             '<Enter>=Accept  <ESC>=Abort', WHITE, BLUE );
  153.  
  154.   Repeat
  155.     MoveCursor;
  156.  
  157.     Ch := WReadKey;
  158.  
  159.     Case Ord( Ch ) of
  160.  
  161.       8 :
  162.       BEGIN
  163.         If BitNum = Len Then
  164.         BEGIN
  165.           If Halfway Then
  166.             Bytes^[Len + 1] := 0
  167.           Else If Len <> 0 Then
  168.           BEGIN
  169.             Bytes^[Len] := 0;
  170.             Dec( BitNum );
  171.             Dec( Len );
  172.           END   { Of Then }
  173.         END   { Of Then }
  174.         Else If BitNum = 0 Then
  175.         BEGIN
  176.           Bytes^[Len] := 0;
  177.           Dec( Len );
  178.           BitNum := Len;
  179.         END   { Of Then }
  180.         Else WinEnv.KeyBuff := #0 + #75;
  181.  
  182.         Halfway := FALSE;
  183.  
  184.         WriteScreen;
  185.       END;    { Of BackSpace }
  186.  
  187.       Key_Tab:
  188.       BEGIN
  189.  
  190.         If HexMode Then
  191.         BEGIN
  192.           HexMode         := FALSE;
  193.           CH              := Chr( 255 );
  194.           WinEnv.EventKey := 255;
  195.         END;
  196.  
  197.       END;   { Of Tab }
  198.  
  199.  
  200.       0 :
  201.       BEGIN
  202.  
  203.         Ch1 := WReadKey;
  204.  
  205.         Case Ord( Ch1 ) of
  206.  
  207.  
  208.           Key_Left:
  209.           BEGIN
  210.             HalfWay := FALSE;
  211.  
  212.             If BitNum <> 0 Then
  213.               Dec( BitNum );
  214.           END;   { Of Left }
  215.  
  216.           Key_Right:
  217.           BEGIN
  218.             Halfway := FALSE;
  219.  
  220.             If ( BitNum <> 15 ) AND ( BitNum <> Len ) Then
  221.               Inc( BitNum )
  222.             Else If ( BitNum = Len ) AND ( BitNum = 15 ) Then
  223.               BitNum := 0;
  224.  
  225.           END;   { Of Right }
  226.  
  227.           Key_Home:
  228.           BEGIN
  229.             Halfway := FALSE;
  230.             BitNum  := 0;
  231.           END;   { Of Home }
  232.  
  233.           Key_End:
  234.           BEGIN
  235.             Halfway := FALSE;
  236.             BitNum  := Len;
  237.  
  238.             If BitNum > 15 Then
  239.               BitNum := 15;
  240.           END;   { Of End }
  241.  
  242.           Key_ShiftTab:
  243.           BEGIN
  244.  
  245.             If Not HexMode Then
  246.             BEGIN
  247.               HexMode            := TRUE;
  248.               CH1                := Chr( 255 );
  249.               WinEnv.EventKey    := 255;
  250.               WinEnv.EventExtKey := 255;
  251.             END;
  252.  
  253.           END;   { Of shift-tab }
  254.  
  255.  
  256.         END;   { Of Tab }
  257.       END;   { Of Extended Characters }
  258.     END;   { Of Case }
  259.  
  260.     {---------------------------------------------}
  261.     { This next If/Then/Else statement is written }
  262.     { because I have yet to figure out how to do  }
  263.     { a damned 'NOT in' statement.                }
  264.     {---------------------------------------------}
  265.  
  266.     If ( NOT HexMode ) AND ( Ch in [#8,#9,#13,#27,#0] ) Then
  267.     Else If HexMode Then
  268.     Case Upcase( Ch ) of
  269.       '0'..'9',
  270.       'A'..'F' :
  271.       BEGIN
  272.         If Halfway = FALSE Then
  273.         BEGIN
  274.           If Ch in ['0'..'9'] Then
  275.             Loopy := Ord( Ch ) - 48
  276.           Else
  277.             Loopy := Ord( Upcase( Ch ) ) - 55;
  278.  
  279.           Bytes^[Bitnum + 1] :=
  280.                 ( Bytes^[Bitnum + 1] MOD 16 ) + ( Loopy * 16 );
  281.  
  282.           Halfway := TRUE;
  283.  
  284.           WriteScreen;
  285.         END   { Of Then }
  286.         Else
  287.         BEGIN
  288.           If Ch in ['0'..'9'] Then
  289.             Loopy := Ord( Ch ) - 48
  290.           Else
  291.             Loopy := Ord( Upcase( Ch ) ) - 55;
  292.  
  293.           Bytes^[Bitnum + 1] :=
  294.                 ( ( Bytes^[Bitnum + 1] DIV 16 ) * 16 ) + Loopy;
  295.  
  296.           If BitNum = Len Then
  297.             Inc( Len );
  298.  
  299.           If BitNum <> 15 Then
  300.             Inc( BitNum )
  301.           Else
  302.             BitNum := 0;
  303.  
  304.           Halfway := FALSE;
  305.           WriteScreen;
  306.         END;   { Of Else }
  307.  
  308.         MoveCursor;
  309.       END;   { Of Normal characters }
  310.     END   { Of Case }
  311.     Else If Ch <> #27 Then
  312.     BEGIN
  313.  
  314.       If Ch<>#255 Then
  315.       BEGIN
  316.  
  317.         If (Ch=#8) and (Len>0) Then
  318.           Dec( Len )
  319.         Else
  320.         BEGIN
  321.  
  322.           Bytes^[Bitnum + 1] := Ord( Ch );
  323.  
  324.           If BitNum = Len Then
  325.             Inc( Len );
  326.  
  327.           If BitNum <> 15 Then
  328.             Inc( BitNum )
  329.           Else
  330.             BitNum := 0;
  331.  
  332.         END;
  333.  
  334.         WriteScreen;
  335.  
  336.       END; { if ch<>255 }
  337.     END;   { Of Else }
  338.  
  339.     WFlushKeyBuf;
  340.   Until ( Ch = #27 ) OR
  341.         ( Ch = #13 ) OR
  342.         ( ( WinEnv.Events ) AND
  343.           ( ( Ord( Ch1 ) in [ {Key_Up,Key_Down,}
  344.                              Key_PgUp,Key_PgDn,
  345.                              Key_F2..Key_F10,
  346.                              Key_ShiftTab] ) OR
  347.             ( Ch = #9 ) ) );
  348.  
  349.   If ( Ch = #0 ) Then
  350.   BEGIN
  351.     WinEnv.EventKey    := 0;
  352.     WinEnv.EventExtKey := Ord( Ch1 );
  353.   END   { Of Then }
  354.   Else
  355.   BEGIN
  356.     WinEnv.EventKey    := Ord( CH );
  357.     WinEnv.EventExtKey := 0;
  358.   END;   { Of Else }
  359.  
  360.   S    := '';
  361.   Test := FALSE;
  362.  
  363.   If Ch = #27 Then
  364.     S := #27
  365.   Else
  366.     For Loopy := 1 to Len Do
  367.       S := S + Chr( Bytes^[Loopy] );
  368.  
  369.   Freemem( Bytes, 16 );
  370.  
  371.   WInfoMsg( OldInfo, BLUE,  CYAN );
  372.   WMessage( OldMsg,  WHITE, BLUE );
  373.  
  374.   Pattern := S;
  375. END;   { Of GetFillPattern }
  376.  
  377.  
  378.  
  379.  
  380. Procedure GrabPattern(            Msg    : LONGINT;
  381.                                   FMA    : POINTER;
  382.                                   Node   : BYTE          ); Far;
  383.  
  384. Var
  385.    Test : BOOLEAN;
  386.    FC   : BYTE;
  387.    BC   : BYTE;
  388.    Temp : STRING;
  389.  
  390.    FM   : PForm;
  391.  
  392. BEGIN
  393.  
  394.  
  395.   FM := FMA;
  396.  
  397.   Test := (msg = fnpmRead );
  398.  
  399.   If Test Then
  400.   BEGIN
  401.     FC := WHITE;
  402.     BC := WHITE;
  403.  
  404.     WCursorBIG;
  405.   END   { Of Then }
  406.   Else
  407.   BEGIN
  408.     FC := WHITE;
  409.     BC := BLUE;
  410.   END;   { Of Else }
  411.  
  412.   GetFillPattern( FM^[Node].Proc.S,
  413.                   FM^[Node].X,
  414.                   FM^[Node].Y,
  415.                   FC, BC, Test, HexMode, Temp );
  416.  
  417.   If Temp <> #27 Then
  418.     FM^[Node].Proc.S := Temp;
  419.  
  420.   WCursorOFF;
  421. END;   { Of GrabPattern }
  422.  
  423.  
  424. {------------------------------------------------------}
  425.  
  426.  
  427.  
  428. Function GetSearchItems : BOOLEAN;
  429. VAR
  430.    Z1     : BYTE;
  431.    Z2     : BYTE;
  432.    FC1    : BYTE;
  433.    FC2    : BYTE;
  434.    Master : BYTE;
  435.  
  436.    FP     : PFormMax;
  437.  
  438. BEGIN
  439.  
  440.  
  441.   WNew( 3, 4, 77, 20, WHITE, BLUE, WHITE, WHITE, 'Search For Data' );
  442.  
  443.   {----------------------------------------}
  444.   { Setup associated variables and records }
  445.   {----------------------------------------}
  446.  
  447.   M1[1]   := 'Jons Partition            ';
  448.   M1[2]   := 'Bills Partition           ';
  449.   M1[3]   := 'Steves Partition          ';
  450.   M1[4]   := 'No Paritition             ';
  451.   M1[5]   := 'Jons Partition            ';
  452.   M1[6]   := 'Bills Partition           ';
  453.   M1[7]   := 'Steves Partition          ';
  454.   M1[8]   := 'No Paritition             ';
  455.   M1[9]   := 'Jons Partition            ';
  456.   M1[10]   := 'Bills Partition           ';
  457.   M1[11]   := 'Steves Partition          ';
  458.   M1[12]   := 'No Paritition             ';
  459.   M1[13]   := 'Jons Partition            ';
  460.   M1[14]   := 'Bills Partition           ';
  461.   M1[15]   := 'Steves Partition          ';
  462.   M1[16]   := 'No Paritition             ';
  463.   M1[17]   := 'Jons Partition            ';
  464.   M1[18]   := 'Bills Partition           ';
  465.   M1[19]   := 'Steves Partition          ';
  466.   M1[20]   := 'No Paritition             ';
  467.  
  468.   B       := 20;
  469.  
  470.   HexMode := TRUE;
  471.   start   := 1;
  472.  
  473.   {-------------------}
  474.   { Allocate the form }
  475.   {-------------------}
  476.  
  477.   FP := WFormNew( 50 );
  478.  
  479.   {----------------}
  480.   { Build the form }
  481.   {----------------}
  482.  
  483.   WFormAddBegin( FP, 0,0, white,blue, white,white, TRUE );
  484.  
  485.     WFormAddSetBegin( FP, TRUE, 0 );
  486.       WFormAddRadioB( FP, 03,02, -1,-1, -1,-1, 0,0, TRUE, 00, TRUE  );
  487.       WFormAddRadioB( FP, 03,03, -1,-1, -1,-1, 0,0, TRUE, 00, FALSE );
  488.       WFormAddText(   FP, 30,03, -1,-1, -1,-1, 0,0, TRUE, -1,
  489.                           40, 'RESULTS.TXT', NIL                    );
  490.     WFormAddSetEnd(   FP );
  491.  
  492.     WFormAddProc( FP, 03,06, -1,-1, -1,-1, 0,0, TRUE, 0, GrabPattern, 70,1 );
  493.  
  494.     WFormAddSetBegin( FP, TRUE, 0 );
  495.       WFormAddRadioB( FP, 03,08, -1,-1, -1,-1, 0,0, TRUE, 00, TRUE  );
  496.       WFormAddRadioB( FP, 03,09, -1,-1, -1,-1, 0,0, TRUE, 00, FALSE );
  497.       WFormAddListBox(FP, 30,09, -1,-1, -1,-1, 0,0, TRUE, -1,
  498.                           @M1, B, 1, 2, 0, 1, '' );
  499.     WFormAddSetEnd(   FP   );
  500.  
  501.     WFormAddSetBegin( FP, TRUE, 0 );
  502.       WFormAddXBox(   FP, 03,12, -1,-1, -1,-1, 0,0, TRUE, 0, TRUE );
  503.       WFormAddXBox(   FP, 03,13, -1,-1, -1,-1, 0,0, TRUE, 0, TRUE );
  504.       WFormAddXBox(   FP, 03,14, -1,-1, -1,-1, 0,0, TRUE, 0, TRUE );
  505.     WFormAddSetEnd(   FP );
  506.  
  507.     WFormAddButton(   FP, 38,13, blue,cyan, -1,-1, 0,0, TRUE, 0,
  508.                           2, 'F2 = Accept ', NIL, fsEnter        );
  509.     WFormAddButton(   FP, 58,13, blue,cyan, -1,-1, 0,0, TRUE, 0,
  510.                           2, 'F3 = Abort  ', NIL, fsEscape       );
  511.  
  512.   WFormAddEnd(   FP );
  513.  
  514.   {-------------------}
  515.   { Write out headers }
  516.   {-------------------}
  517.  
  518.   WFastWrite( 7,2, YELLOW,BLUE, 'Show results on Screen' );
  519.  
  520.   WFastWrite( 7,3, YELLOW,BLUE, 'Write results to' );
  521.  
  522.   WFastWrite( 3,5, YELLOW,BLUE, 'String to search for' );
  523.  
  524.   WFastWrite( 7,8, YELLOW,BLUE, 'Search entire device' );
  525.  
  526.   WFastwrite( 7,9, YELLOW,BLUE, 'Search partition' );
  527.  
  528.   WFastwrite( 7,12, YELLOW,BLUE, 'Case sensitive search' );
  529.   WFastwrite( 7,13, YELLOW,BLUE, 'Fuzzy/Soundex search' );
  530.   WFastwrite( 7,14, YELLOW,BLUE, 'First 16 byte search' );
  531.  
  532.   {-------------}
  533.   { Do the Form }
  534.   {-------------}
  535.  
  536.   WMessage('Use the <TAB>, <SHIFT>-TAB, and Arrow keys to move.  <ENTER> to accept', white, blue );
  537.  
  538.   WFormDraw( FP );
  539.  
  540.   WFormRead( FP, start, retcode );
  541.  
  542.  
  543. (*
  544.   WEventsOn;
  545.  
  546.   Repeat
  547.  
  548.     WFormRead( FP, start, retcode );
  549.  
  550.     WInfoMsg('key='+intToStr(WinEnv.EventKey)+
  551.              ' extkey='+IntToStr(WinEnv.EventKey)+
  552.              ' mb='+IntToStr(WinEnv.EventButtons), blue, cyan );
  553.  
  554.  
  555.   Until RetCode<>fsNone;
  556.  
  557.   WEventsOff;
  558. *)
  559.  
  560.   WGemDialogBox('[1][Form Return Code='+IntToStr(retcode)+'][ok]');
  561.  
  562.   {---------------------}
  563.   { Dispose of the form }
  564.   {---------------------}
  565.  
  566.   WFormDispose( FP );
  567.  
  568.   GetSearchItems :=  RetCode <> fsEscape;
  569.  
  570. END;
  571.  
  572. {----------------------------------------------------------------}
  573.  
  574. Procedure Initialize;
  575.  
  576. VAR
  577.  
  578.   S     : ST80;
  579.   Loopy : INTEGER;
  580.  
  581. BEGIN
  582.  
  583.   S := '';
  584.   For Loopy := 1 to ParamCount Do
  585.   BEGIN
  586.     If Pos( '/hi', LowerString( ParamStr( Loopy ) ) ) <> 0 Then
  587.       S := S + 'HIREZ,';
  588.     If Pos( '/shi', LowerString( ParamStr( Loopy ) ) ) <> 0 Then
  589.       S := S + 'SUPER-REZ,';
  590.     If Pos( '/m', LowerString( ParamStr( Loopy ) ) ) <> 0 Then
  591.       S := S + 'B/W,';
  592.     If Pos( '/keepscreen', LowerString( ParamStr( Loopy ) ) ) <> 0 Then
  593.       S := S + 'KEEPSCREEN,';
  594.   END;
  595.  
  596.   S := 'KHITS=1,MOUSE,LOOK=1,CLOCK,' + S;
  597.  
  598.   If (CrtIsVga) and (ScreenRows=25) Then
  599.   BEGIN
  600.  
  601.     WOpen( '▒', black, blue, S+'WIDGETFONT' );
  602.  
  603.     WinEnv.Look := 1;
  604.  
  605.     WLoadBlueGrayPalette;
  606.  
  607.     {DoNormalSetWins;}
  608.  
  609. {    WSet('BORDER=9'); }
  610.  
  611.   END
  612.   ELSE
  613.   BEGIN
  614.  
  615.     WOpen( '▒', black, blue, S);
  616.  
  617.     WinEnv.Look := 2;
  618.  
  619.     {DoNormalSetWins;}
  620.  
  621.   END;
  622.  
  623.  
  624.   WSubmitDefKeys;
  625.  
  626.   {WSubmitKeyProc( #0, #65, Addr( DosShell ), 'DOS Shell' );}
  627.  
  628.   WPrgNameMsg( 'FormTest 0.0.1|│ Date 00/00/00 │ Time 00:00:00 AM',
  629.                BLUE, CYAN );
  630.  
  631.  
  632.   WInfoMsg( ' ', WHITE, CYAN );
  633.   WMessage( 'Scanning for devices|<Please wait>', WHITE, BLUE );
  634.  
  635.   {------------------------------------------------------------}
  636.   { Submit help procedure, help file name, and help file page. }
  637.   {------------------------------------------------------------}
  638.  
  639. (*
  640.   WSubmitHelpProc( Addr( WOldHelp ) );
  641.   WSubmitKeyProc( #0, #59, Addr( F1W_Help ), 'Help!' );
  642. *)
  643.  
  644.   WinEnv.Help     := 1;
  645.   WinEnv.HelpFile := 'SSTUTIL.HLP';
  646.  
  647.   WCursorOFF;
  648. END;   { Of Initialize }
  649.  
  650.  
  651.  
  652. BEGIN
  653.  
  654.   Initialize;
  655.  
  656.   While GetSearchItems Do;
  657.  
  658.   WClose;
  659.  
  660. END. blue, cyan );
  661.  
  662.