home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / ptgenr2.zip / BBGUI.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-01  |  6KB  |  109 lines
  1. (* This file was mangled by Mangler 1.32 (c) Copyright 1993-1994 by Berend de Boer *)
  2. { Created : 1993-09-22
  3.  
  4. BBGui is a generic user interface which provides simple i/o services to low
  5. level programs. BBGui is adaptable to any gui as Windows or TurboVision. As
  6. is, it only provides a stdio/dos interface.
  7.  
  8.  
  9. Last changes :
  10. 93-12-08  Made Beep public. Beep removed from BBUtil
  11. 93-12-16  Added a portable Delay routine to BBGui
  12.           Added a portable Pause function which should give up a time slice
  13. 93-12-31  Added PrintWarning
  14. 94-03-17  Added BeepOff and BeepOn to turn beeping on and off
  15. 94-05-02  Added OpenProgressDlg and CloseProgressDlg to show a running
  16.           percentage (use SetProgressDlg)
  17. 94-05-16  Adapted to the Windows environment
  18. }
  19.  
  20.  
  21.  
  22.  
  23.  
  24. {$IFDEF MSDos}
  25. {$F+,O+,D-}
  26. {$ENDIF}
  27.  
  28. {S-,R-,Q-,I-}
  29. unit BBGui;
  30.  
  31. interface
  32.  
  33.  
  34. {* TurboVision constants *}
  35. const
  36.   cmYes = 12;
  37.   cmNo = 13;
  38.  
  39.  
  40. type
  41.   CloseProgressDlgType = procedure;
  42.   DelayType = procedure(MS : word);
  43.   FatalErrorType = procedure(const s : string; AHelpCtx : word);
  44.   InfoBoxType = procedure(const s : string; AHelpCtx : word);
  45.   OpenProgressDlgType = procedure(const ATitle : string; ATotal : longint);
  46.   PauseType = procedure;
  47.   PrintErrorType = procedure(const s : string; AHelpCtx : word);
  48.   PrintWarningType = procedure(const s : string; AHelpCtx : word);
  49.   SetProgressDlgType = procedure(Position : longint);
  50.   UserAnswerType = function(const s : string; AHelpCtx : word) : word;
  51.  
  52.  
  53. procedure Beep;
  54. procedure BeepOff;
  55. procedure BeepOn;
  56. procedure DosDelay(MS : word);
  57. procedure NoPause;
  58. procedure TextCloseProgressDlg;
  59. procedure TextFatalError(const s : string; AHelpCtx : word);
  60. procedure TextInfoBox(const s : string; AHelpCtx : word);
  61. procedure TextOpenProgressDlg(const ATitle : string; ATotal : longint);
  62. procedure TextPrintError(const s : string; AHelpCtx : word);
  63. procedure TextPrintWarning(const s : string; AHelpCtx : word);
  64. procedure TextSetProgressDlg(Position : longint);
  65. function  TextUserAnswer(const s : string; AHelpCtx : word) : word;
  66.  
  67.  
  68.  
  69. const
  70.   CloseProgressDlg : CloseProgressDlgType = TextCloseProgressDlg;
  71.   Delay : DelayType = DosDelay;
  72.   FatalError : FatalErrorType = TextFatalError;
  73.   InfoBox : InfoBoxType = TextInfoBox;
  74.   OpenProgressDlg : OpenProgressDlgType = TextOpenProgressDlg;
  75.   Pause : PauseType = NoPause;
  76.   PrintError : PrintErrorType = TextPrintError;
  77.   PrintWarning : PrintWarningType = TextPrintWarning;
  78.   SetProgressDlg : SetProgressDlgType = TextSetProgressDlg;
  79.   UserAnswer : UserAnswerType = TextUserAnswer;
  80.  
  81.  
  82.  
  83.  IMPLEMENTATION USES {$IFDEF Windows}STRINGS , WINAPI , WINPROCS , {$ENDIF}BBERROR , BBFILE , BBUTIL ;
  84. CONST O1l111O01III:BOOLEAN=TRUE;O1l1l1011OO1:STRING ='';OlI10I0lI1:LONGINT=0 ;O1010Ol0l00O1:LONGINT=0 ;
  85. {$IFDEF Windows}PROCEDURE BEEP ;BEGIN IF O1l111O01III THEN MESSAGEBEEP ($FFFF );END ;{$ELSE}PROCEDURE BEEP ;ASSEMBLER;
  86. ASM {} MOV AL , O1l111O01III{} CMP AL , 0 {} JE @@nobeep {} MOV DL , 07h {} MOV AH , 02h {} INT 21h {} @@nobeep : {} END;
  87. {$ENDIF}PROCEDURE BEEPOFF ;BEGIN O1l111O01III := FALSE ;END ;PROCEDURE BEEPON ;BEGIN O1l111O01III := TRUE ;END ;
  88. PROCEDURE DOSDELAY (MS:WORD);{$IFNDEF Windows}FUNCTION O10OIl1l1OIll :LONGINT ;BEGIN O10OIl1l1OIll := MEML [ SEG0040 :$6C
  89. ] ;END ;{$ENDIF}VAR O1011l1l0llI0:LONGINT;O1010I1I0l1O0:LONGINT;BEGIN O1011l1l0llI0 := O10OIl1l1OIll ;O1010I1I0l1O0 :=
  90. O1011l1l0llI0 + ROUND ((MS / (1000 / 18.2 )));REPEAT PAUSE ;UNTIL O10OIl1l1OIll >= O1010I1I0l1O0 ;END ;PROCEDURE NOPAUSE
  91. ;BEGIN END ;PROCEDURE TEXTCLOSEPROGRESSDLG ;BEGIN O1l1l1011OO1 := '';END ;PROCEDURE TEXTFATALERROR (CONST S:STRING ;
  92. AHELPCTX:WORD);BEGIN PRINTERROR (S , AHELPCTX );HALT (1 );END ;PROCEDURE TEXTINFOBOX (CONST S:STRING ;AHELPCTX:WORD);
  93. {$IFDEF Windows}VAR OIOI1l01I01:ARRAY [ 0 .. 255 ]  OF CHAR;{$ENDIF}BEGIN {$IFDEF Windows}MESSAGEBOX (0 , STRPCOPY
  94. (OIOI1l01I01 , S ), 'Information', MB_OK + MB_ICONINFORMATION );{$ELSE}WRITELN (S );{$ENDIF}END ;
  95. PROCEDURE TEXTPRINTERROR (CONST S:STRING ;AHELPCTX:WORD);VAR O100llIl00IOl:WORD;{$IFDEF Windows}OIOI1l01I01:ARRAY [ 0 ..
  96. 255 ]  OF CHAR;{$ENDIF}BEGIN ASM {} MOV O100llIl00IOl, BP {} END;BEEP ;{$IFDEF Windows}MESSAGEBOX (0 , STRPCOPY
  97. (OIOI1l01I01 , S ), NIL , MB_OK );{$ELSE}WRITELN (S );{$ENDIF}LOGERROR ('Error: '+ S );IF @ DUMPSTACK <> NIL THEN
  98. DUMPSTACK (NIL , O100llIl00IOl );END ;PROCEDURE TEXTOPENPROGRESSDLG (CONST ATITLE:STRING ;ATOTAL:LONGINT);BEGIN WRITELN
  99. (ATITLE , ' 0%');O1l1l1011OO1 := ATITLE ;O1010Ol0l00O1 := 0 ;END ;PROCEDURE TEXTSETPROGRESSDLG (POSITION:LONGINT);
  100. BEGIN IF O1l1l1011OO1 <> ''THEN BEGIN IF POSITION >= OlI10I0lI1 THEN WRITELN (CR , O1l1l1011OO1 , ' 100%')ELSE BEGIN IF
  101. (POSITION - O1010Ol0l00O1 )>= 0.025 * OlI10I0lI1 THEN BEGIN WRITELN (CR , O1l1l1011OO1 , ' ', (POSITION * 100 )DIV
  102. OlI10I0lI1 , '%');O1010Ol0l00O1 := POSITION ;END ;END ;END ;END ;PROCEDURE TEXTPRINTWARNING (CONST S:STRING ;
  103. AHELPCTX:WORD);{$IFDEF Windows}VAR OIOI1l01I01:ARRAY [ 0 .. 255 ]  OF CHAR;{$ENDIF}BEGIN BEEP ;
  104. {$IFDEF Windows}MESSAGEBOX (0 , STRPCOPY (OIOI1l01I01 , S ), NIL , MB_OK + MB_ICONEXCLAMATION );{$ELSE}WRITELN (S );
  105. {$ENDIF}LOGERROR ('Warning: '+ S );END ;FUNCTION TEXTUSERANSWER (CONST S:STRING ;AHELPCTX:WORD):WORD ;
  106. VAR OOlIll10O1ll:STRING ;BEGIN WRITELN (S );REPEAT READLN (OOlIll10O1ll );UNTIL (OOlIll10O1ll <> '')AND (UPCASE
  107. (OOlIll10O1ll [ 1 ] )IN [ 'Y', 'N'] );IF UPSTR (OOlIll10O1ll [ 1 ] )='Y'THEN TEXTUSERANSWER := CMYES ELSE TEXTUSERANSWER
  108. := CMNO ;END ;END .
  109.