home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PSGUI130.ZIP / PGUIAPP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-01  |  13.1 KB  |  416 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║  PGUI Graphic    ║
  5.                                                       ║  App. Include    ║
  6.                                                       ║    Rev.  1.00    ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. Procedure InitVGA(VPath:String);
  12.  
  13. { ╔════════════════════════════════════════════════════════════════════════╗ }
  14. { ║   Setup VGA Mode using BGI driver in path VPath.                       ║ }
  15. { ╚════════════════════════════════════════════════════════════════════════╝ }
  16.  
  17. Var
  18.   Mode:Integer;
  19.   Driver:Integer;
  20.  
  21. Begin
  22.   Driver := VGA;
  23.   Mode := VGAHi;
  24.   InitGraph( Driver, Mode, VPath);
  25. End;
  26.  
  27. Procedure StandardScreen(Title:String);
  28.  
  29. { ╔════════════════════════════════════════════════════════════════════════╗ }
  30. { ║  Clears the screen and displays the header.                            ║ }
  31. { ╚════════════════════════════════════════════════════════════════════════╝ }
  32.  
  33. Begin
  34.   Mouse.Hide;
  35.   ClearDevice;
  36.   SetFillStyle(SolidFill,1);
  37.   Bar(0, 0, 639, 16);
  38.   SetColor(White);
  39.   SetBkColor(Black);
  40.   ShadeText(4, 4, Title);
  41.   Mouse.Show;
  42. End;
  43.  
  44. Procedure Box(X1,Y1,X2,Y2:Word;C1,C2,Thick:Byte);
  45. {Co-Ords,Box,Shadow,Box Thickness}
  46.  
  47. { ╔════════════════════════════════════════════════════════════════════════╗ }
  48. { ║  Draws a graphic box, coordinates X1,Y1 to X2,Y2, using the colours    ║ }
  49. { ║  C1 and C2.                                                            ║ }
  50. { ║                                                                        ║ }
  51. { ║  The box thickness is set by Thick and the box has a shadow.           ║ }
  52. { ║  The shadow is always 1 in thickness, deactivated by C2 = Background.  ║ }
  53. { ╚════════════════════════════════════════════════════════════════════════╝ }
  54.  
  55. Var
  56.   I      :Byte;
  57.   OldClr :Word;
  58.  
  59. Begin
  60.   OldClr:=GetColor;
  61.   SetColor(C2);
  62.   Line(X2+1,Y1+5,X2+1,Y2+1);
  63.   Line(X1+4,Y2+1,X2+1,Y2+1);
  64.   SetColor(C1);
  65.   For I:=1 to Thick do
  66.   Begin
  67.     Line(X1,Y1,X2,Y1);
  68.     Line(X2,Y1,X2,Y2);
  69.     Line(X2,Y2,X1,Y2);
  70.     Line(X1,Y2,X1,Y1);
  71.     Inc(X1);
  72.     Dec(X2);
  73.     Inc(Y1);
  74.     Dec(Y2);
  75.   End;
  76.   SetColor(OldClr);
  77. End;
  78.  
  79. Procedure ShadeText(X,Y:Word;T:String);
  80.  
  81. { ╔════════════════════════════════════════════════════════════════════════╗ }
  82. { ║  Displays the text at X,Y with a shadow.                               ║ }
  83. { ╚════════════════════════════════════════════════════════════════════════╝ }
  84.  
  85. Var
  86.   OldClr :Word;
  87.  
  88. Begin
  89.   OldClr:=GetColor;
  90.   SetColor(GetBkColor);
  91.   OutTextXY(X, Y, T);
  92.   SetColor(OldClr);
  93.   OutTextXY(X+2, Y+2, T);
  94. End;
  95.  
  96. Procedure GraphicSpace(X,Y,Spot:Word);
  97.  
  98. { ╔════════════════════════════════════════════════════════════════════════╗ }
  99. { ║   Displays a space character 'Spot' number of characters from    X,Y.  ║ }
  100. { ╚════════════════════════════════════════════════════════════════════════╝ }
  101.  
  102. Begin
  103.   SetFillStyle(SolidFill,GetBkColor);
  104.   Bar(X+(Spot*TextWidth(' ')),Y,X+(Spot*TextWidth(' '))+TextWidth(' '),Y+TextWidth(' '));
  105. End;
  106.  
  107. Procedure TwirlyCursor(X,Y,Spot:Word;Frame:Byte);
  108.  
  109. { ╔════════════════════════════════════════════════════════════════════════╗ }
  110. { ║   Draws the animated cursor at X,Y using frame number Frame.           ║ }
  111. { ╚════════════════════════════════════════════════════════════════════════╝ }
  112.  
  113. Var
  114.   CharSize:Word;
  115.  
  116. Begin
  117.   CharSize:=TextWidth(' ');
  118.   GraphicSpace(X,Y,Spot);
  119.   Case Frame Of
  120.       1:OutTextXY(X+(Spot*CharSize),Y,'-');
  121.       2:OutTextXY(X+(Spot*CharSize),Y,'/');
  122.       3:OutTextXY(X+(Spot*CharSize),Y,'|');
  123.       4:OutTextXY(X+(Spot*CharSize),Y,'\');
  124.       5:OutTextXY(X+(Spot*CharSize),Y,'-');
  125.       6:OutTextXY(X+(Spot*CharSize),Y,'/');
  126.       7:OutTextXY(X+(Spot*CharSize),Y,'|');
  127.       8:OutTextXY(X+(Spot*CharSize),Y,'\');
  128.   End;
  129. End;
  130.  
  131. Procedure LineCursor(X,Y,Spot:Word;OnOff:Boolean);
  132.  
  133. Var
  134.   Width,
  135.   OldClr   :Word;
  136.  
  137. Begin
  138.   OldClr:=GetColor;
  139.   If Not OnOff Then SetColor(GetBkColor);
  140.   Width:=X+Spot*TextWidth(' ')-1;
  141.   Line(Width,Y,Width,Y+TextHeight(' ')-2);
  142.   SetColor(OldClr);
  143. End;
  144.  
  145. Procedure CommentWindow(X,Y:Word;Comment:String);
  146.  
  147. Const
  148.   Head    = 'Comment';
  149.  
  150. Var
  151.   CWind   :GraphicWindow;
  152.   Dummy   :Byte;
  153.   NewY,
  154.   Width   :Word;
  155.   Done,
  156.   Held,
  157.   Doubled,
  158.   Special :Boolean;
  159.   Key     :Char;
  160.  
  161. Begin
  162.   Width:=TextWidth(Comment)+20;
  163.   If Width<TextWidth(Head)+20 Then
  164.     Width:=TextWidth(Head)+20;
  165.   CWind.Open(X,Y,X+Width,Y+52+3*TextHeight(Head),Yellow,Black,3,SolidFill,Black,True);
  166.   CWind.NewHeading(Head,CentreText,White,CloseDotFill,Blue);
  167.   CWind.CloseIcon(True);
  168.   CWind.HeadingIcon(True);
  169.   Mouse.Hide;
  170.   OutTextXY(X+10,Y+20+TextHeight(Head),Comment);
  171.   Mouse.Show;
  172.   Width:=(Width Div 2)-(TextWidth('Okay') Div 2);
  173.   NewY :=Y+30+2*TextHeight(Head);
  174.   CWind.Buttons.Create(X+Width,NewY,X+10+Width+TextWidth('Okay'),NewY+10+TextHeight('Okay'),
  175.                        2, Black, NIL, 'Okay', False, #13);
  176.   Done:=False;
  177.   Repeat
  178.     CWind.Buttons.WaitForClick(X, Y, Dummy, Held, Doubled, Special, Key);
  179.     If (Key=KeyCode(Key_Ctrl, Key_F5)) And
  180.        Held Then CWind.Drag;
  181.     Done:=CWind.CloseButtonNum=CWind.Buttons.Number;
  182.     Done:=Done Or ((Special=False) And (Key=#13));
  183.   Until Done;
  184.   CWind.Close;
  185. End;
  186.  
  187. Procedure EditString(X,Y:Word;MaxLets:Byte;Upper:Boolean;Var MainStr:String);
  188.  
  189. { ╔════════════════════════════════════════════════════════════════════════╗ }
  190. { ║   This will get a string at X,Y.  It destroys what is on the screen.   ║ }
  191. { ╚════════════════════════════════════════════════════════════════════════╝ }
  192.  
  193. Var
  194.   Ins             :Boolean;   {Boolean for the Insert Key Status}
  195.   C               :Char;      {Current Character}
  196.   Count,                      {Number Of Chars In String}
  197.   CurXPos         :Byte;      {Current X Position of Cursor}
  198.   FlashCount      :LongInt;
  199.   OldClr          :Word;
  200.   OnOff           :Boolean;
  201.  
  202. Begin
  203.   Mouse.Hide;
  204.   Ins:=False;                {The Insert key has not yet been pressed}
  205.   CurXPos:=1;                {Current Relative X Position+1}
  206.   UnPadVar(MainStr,MainStr);
  207.   If Length(MainStr)>MaxLets Then
  208.     MainStr:=Copy(MainStr,1,MaxLets);
  209.   SetFillStyle(EmptyFill,GetColor);
  210.   Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  211.   OutTextXY(X,Y,MainStr);
  212.   Count:=Length(MainStr)+1;  {How many letters in the string+1}
  213.   FlashCount:=0;
  214.   OnOff:=True;
  215.   OldClr:=GetColor;
  216.  
  217.   Repeat                     {Repeat Until [Return] is Pressed}
  218.     If Ins Then SetColor(LightRed) Else SetColor(LightGreen);
  219.     While Not KeyPressed do
  220.     Begin
  221.       Inc(FlashCount);
  222.       If FlashCount>Mouse.ComputerSpeed Then
  223.       Begin
  224.         LineCursor(X,Y,CurXPos-1,OnOff);
  225.         OnOff:=Not OnOff;
  226.         FlashCount:=0;
  227.       End;
  228.     End;
  229.     LineCursor(X,Y,CurXPos-1,False);
  230.     SetColor(OldClr);
  231.     If Upper Then
  232.       C:=UpCase(ReadKey)
  233.     Else
  234.       C:=ReadKey;
  235.  
  236.     If C=Chr(0) Then         {Check for a cursor key}
  237.     Begin
  238.       C:=ReadKey;            {Which cursor key}         {Numeric Keypad Value}
  239.       If (C='O') Then CurXPos:=Count;                            {1}
  240.       If (C='P') And (CurXPos>=3) Then Dec(CurXPos,2);           {2}
  241.       If (C='Q') And (CurXPos>=4) Then Dec(CurXPos,3);           {3}
  242.       If (C='K') And (CurXPos>1) Then Dec(CurXPos);              {4}
  243.       If (C='M') And (CurXPos<Count) Then Inc(CurXPos);          {6}
  244.       If (C='G') Then CurXPos:=1;                                {7}
  245.       If (C='H') And (CurXPos<=Count-2) Then Inc(CurXPos,2);     {8}
  246.       If (C='I') And (CurXPos<=Count-3) Then Inc(CurXPos,3);     {9}
  247.       If (C=#7 ) Then MainStr[0]:=Chr(CurXPos-1);                {Shift-Del}
  248.       If (C='S') And (Count>1) Then                              {Del}
  249.       Begin
  250.         Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  251.         Delete(MainStr,CurXPos,1);
  252.         OutTextXY(X,Y,MainStr);
  253.         Dec(Count);
  254.       End;
  255.       If (C='R') Then                                            {Ins}
  256.         Ins:=Not Ins;
  257.     End  {End Extended Key}
  258.     Else
  259.     Begin
  260.  
  261.       If (C=#17) Then                           {^Q}
  262.       Begin
  263.         C:=ReadKey;
  264.         If C=#0 Then
  265.           C:=ReadKey
  266.         Else
  267.         If C in ['y','Y',#25] Then
  268.         Begin
  269.           Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  270.           MainStr[0]:=Chr(CurXPos-1);
  271.           Count:=CurXPos;
  272.           OutTextXY(X,Y,MainStr);
  273.         End;
  274.       End
  275.       Else
  276.       If (C=#27) Then
  277.       Begin
  278.         Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  279.         MainStr:='';
  280.         C:=#13;
  281.       End
  282.       Else
  283.       If (C=#8) Then                     {Was BackSpace Presssed?}
  284.       Begin
  285.         If (CurXPos>1) Then              {Can I BackSpace?}
  286.         Begin
  287.           Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  288.           Delete(MainStr,CurXPos-1,1);   {Delete the char}
  289.           OutTextXY(X,Y,MainStr);
  290.           Dec(Count);                    {One less char}
  291.           Dec(CurXPos);                  {Move Back}
  292.         End;                             {End 'Can I BackSpace?'}
  293.       End                                {End 'Was BackSpace Pressed?'}
  294.       Else                               {No Not BackSpace - A Normal Letter}
  295.         If (CurXPos<=MaxLets) And (C<>#13) Then    {Is there Space?}
  296.         Begin
  297.           If Ins Or (CurXPos>=Count) Then   {Must I Insert the Char?}
  298.           Begin
  299.             If Count<=MaxLets Then
  300.               Begin
  301.                 Insert(C,MainStr,CurXPos);  {Insert the Char}
  302.                 Inc(Count);                 {Add 1 to Count}
  303.                 Inc(CurXPos);               {Move Cursor}
  304.               End;                          {End Check for Space in String}
  305.           End                               {End Check to see if Ins was True}
  306.           Else                              {No, Do not Insert, Overwrite}
  307.           Begin
  308.             MainStr[CurXPos]:=C;      {Overwrite char}
  309.             Inc(CurXPos);             {Move Cursor}
  310.           End;                        {End Insert / Overwrite}
  311.  
  312.           Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
  313.           OutTextXY(X,Y,MainStr);
  314.         End;
  315.     End;                              {End Area which accepts a BackSpace or a Letter}
  316.   Until C=#13;
  317.   Mouse.Show;
  318.   UnPadVar(MainStr,MainStr);
  319. End;
  320.  
  321. Procedure ShowDirList(Var Dir:DirList;ShowMore:Byte;
  322.                       X,Y,Current,Start,HowMany:Word;
  323.                       FileColor,DirColor,CurrentColor:Byte;
  324.                       Var PgUp,PgDn:Boolean);
  325.  
  326. { ╔════════════════════════════════════════════════════════════════════════╗ }
  327. { ║                                                                        ║ }
  328. { ║  This procedure displays the files in Dir (without a border) at X,Y.   ║ }
  329. { ║                                                                        ║ }
  330. { ║  It displays HowMany files starting at file Start.  File Current       ║ }
  331. { ║  is marked in CurrentColor.                                            ║ }
  332. { ║                                                                        ║ }
  333. { ║  The programmer should mark each file as a button.                     ║ }
  334. { ║                                                                        ║ }
  335. { ║  Warning:  No graphic save is done.                                    ║ }
  336. { ║                                                                        ║ }
  337. { ╚════════════════════════════════════════════════════════════════════════╝ }
  338.  
  339. Var
  340.   OldX,
  341.   StartF,
  342.   EndF       :Word;
  343.   Temp2,
  344.   Temp       :String[20];
  345.   DateAndTime:DateTime;
  346.  
  347. Begin
  348.   If Dir.Root=NIL Then Exit;
  349.   Mouse.Hide;
  350.   EndF:=Start+HowMany-1;
  351.   If EndF>Dir.Total Then EndF:=Dir.Total;
  352.  
  353.   If Start>1 Then
  354.     PgUp:=True
  355.   Else
  356.     PgUp:=False;
  357.  
  358.   If EndF<Dir.Total Then
  359.     PgDn:=True
  360.   Else
  361.     PgDn:=False;
  362.  
  363.   StartF:=Start;
  364.   Inc(Start);
  365.   GotoDirList(Dir,StartF);
  366.  
  367.   Repeat
  368.     If StartF=Current Then
  369.       SetColor(CurrentColor)
  370.     Else
  371.     If (Dir.Info^.Attr And Directory)<>0 Then
  372.       SetColor(DirColor)
  373.     Else
  374.       SetColor(FileColor);
  375.  
  376.     OldX:=X;
  377.     PadFileName(Dir.Info^.Name,Temp);
  378.     OutTextXY(X,Y,Temp);
  379.     Inc(X,12*8);
  380.     If ((ShowMore And Size)<>0) And ((Dir.Info^.Attr And Directory)=0) Then
  381.     Begin
  382.       Str(Dir.Info^.Size:10,Temp);
  383.       OutTextXY(X,Y,Temp);
  384.       Inc(X,10*8);
  385.     End;
  386.  
  387.     If ((ShowMore And Date)<>0) Then
  388.     Begin
  389.       UnPackTime(Dir.Info^.Time,DateAndTime);
  390.       Str(DateAndTime.Day:4,Temp);
  391.       Str(DateAndTime.Month:2,Temp2);
  392.       Temp:=Concat(Temp,'/',Temp2,'/');
  393.       Str(DateAndTime.Year,Temp2);
  394.       Temp:=Concat(Temp,Temp2);
  395.       OutTextXY(X,Y,Temp);
  396.       Inc(X,12*8);
  397.     End;
  398.  
  399.     If ((ShowMore And Time)<>0) Then
  400.     Begin
  401.       UnPackTime(Dir.Info^.Time,DateAndTime);
  402.       Str(DateAndTime.Hour:4,Temp);
  403.       Str(DateAndTime.Min:2,Temp2);
  404.       SpacesToZeros(Temp2,Temp2);
  405.       Temp:=Concat(Temp,':',Temp2);
  406.     End;
  407.     X:=OldX;
  408.     Inc(StartF);
  409.     Inc(Y,12);
  410.     Dir.Info:=Dir.Info^.Next;
  411.   Until StartF>EndF;
  412.   Mouse.Show;
  413. End;
  414.  
  415. { Copyright 1993, Michael Gallias }
  416.