home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 134 / pascal / freedr5m.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-17  |  6.8 KB  |  232 lines
  1. {$A+,$S5,D-}  {compile for desk accessory}
  2.  
  3. PROGRAM Disk_Space_Accessory;
  4.  
  5.  CONST {$I gemconst.pas}
  6.        AC_Open = 40;  {Two new message that only accessories will get}
  7.        AC_Close = 41;
  8.        Height = 115;   {height and width of the window}
  9.        Width = 216;
  10.  
  11.  
  12.  TYPE {$I gemtype.pas}
  13.      shortstring = String[2];
  14.      FreeRec = Packed RECORD
  15.         FreeCl : Long_Integer;  { # of free clusters }
  16.         NumCl  : Long_Integer;  { total # of clusters on disk }
  17.         SecSiz : Long_Integer;  { Sector size in bytes }
  18.         CluSiz : Long_Integer;  { number of sectors per cluster }
  19.         END;
  20.  
  21.    FreePtr = ^FreeRec;          { pointer to free record }
  22.  
  23.  VAR window,             { The handle of our window }
  24.      AP_ID,              { Our application identification handle. }
  25.      curx,cury,          { current x and y coordinates of window }
  26.      menu_id : Integer ; { Index of our menu item in "Desk" menu }
  27.      our_name,           { The name of our accessory. }
  28.      wind_name : Str255; { The title of our window. }
  29.      space : Long_Integer;
  30.      spc   : String ;
  31.  
  32.  
  33.  {$I gemsubs.pas}
  34.  
  35.  {Here's our declaration of Menu_Register}
  36.  
  37.  FUNCTION Menu_Register( id : Integer ; VAR name : Str255 ) : Integer;
  38.   EXTERNAL;
  39.  
  40.  Procedure Dfree( VAR rec : FreeRec;  drive : Integer ) ;
  41.  GEMDOS( $36 );
  42.  
  43.  Function Free( drive : Integer ) : Long_integer;
  44.                                  { drive 1-16 for A - P, 0 for current}
  45.  VAR
  46.    FreeInf : FreeRec ;           { what dfree returns }
  47.  
  48.  BEGIN
  49.    Dfree( FreeInf, drive );    { get info into freeinf }
  50.    WITH FreeInf DO
  51.      BEGIN
  52.        Free := FreeCL * ( SecSiz * CluSiz );
  53.      END;
  54.  END;
  55.  
  56.  PROCEDURE  Convert ( A : Long_Integer ) ;
  57.  
  58.  VAR I : Long_Integer ;
  59.  
  60.  BEGIN
  61.    spc := '       ' ;                    {mono/hard-drive version}
  62.    I := A DIV 1000000 ;                  {shows 7 digits, vice 6 }
  63.    spc[ 1 ] := Chr( I + 48 ) ;
  64.    A := A - ( I * 1000000 ) ;
  65.  
  66.    I := A DIV 100000 ;
  67.    spc[ 2 ] := Chr( I + 48 ) ;
  68.    A := A - ( I * 100000 ) ;
  69.  
  70.    I := A DIV 10000 ;
  71.    spc[ 3 ] := Chr( I + 48 ) ;
  72.    A := A - ( I * 10000 ) ;
  73.  
  74.    I := A DIV 1000 ;
  75.    spc[ 4 ] := Chr( I + 48 ) ;
  76.    A := A - ( I * 1000 ) ;
  77.  
  78.    I := A DIV 100 ;
  79.    spc[ 5 ] := Chr( I + 48 ) ;
  80.    A := A - ( I * 100 ) ;
  81.  
  82.    I := A DIV 10 ;
  83.    spc[ 6 ] := Chr( I + 48 ) ;
  84.    A := A - ( I * 10 ) ;
  85.  
  86.    I :=  A ;
  87.    spc[ 7 ] := Chr( I + 48 ) ;
  88.  END ;
  89.  
  90.  PROCEDURE Get_DF ;
  91.  
  92.  VAR dspc : Str255 ;
  93.  
  94.  BEGIN
  95.    space := Free( 1 );     { Get free space on drive A }
  96.    Convert ( space ) ;
  97.    dspc := Concat ( 'Drive A: Free = ', spc ) ;
  98.    Draw_String( 12, 15, dspc ) ;
  99.    space := Free( 2 );     { Get free space on drive B }
  100.    Convert ( space ) ;
  101.    dspc := Concat ( 'Drive B: Free = ', spc ) ;
  102.    Draw_String( 12, 30, dspc ) ;
  103.    space := Free( 3 );     { Get free space on drive C }
  104.    Convert ( space ) ;
  105.    dspc := Concat ( 'Drive C: Free = ', spc ) ;
  106.    Draw_String( 12, 45, dspc ) ;
  107.    space := Free( 4 );     { Get free space on drive D }
  108.    Convert ( space ) ;
  109.    dspc := Concat ( 'Drive D: Free = ', spc ) ;
  110.    Draw_String( 12, 60, dspc ) ;
  111.    space := Free( 5 );     { Get free space on drive E }
  112.    Convert ( space ) ;
  113.    dspc := Concat ( 'Drive E: Free = ', spc ) ;
  114.    Draw_String( 12, 75, dspc ) ;
  115.  END ;
  116.  
  117. { Open our window, if not already open, otherwise make it the front window. }
  118.  
  119.  PROCEDURE Do_Open ;
  120.   BEGIN
  121.    { Does our window already exist? }
  122.    IF window <> No_window THEN
  123.      Bring_To_Front ( window )    { Yes, just make it front window. }
  124.    ELSE
  125.      BEGIN
  126.        wind_name := ' Free Disk Space ' ;
  127.        window := New_Window ( G_Name|G_Close|G_Move,wind_name,
  128.                               0,0,Width,Height );
  129.        Open_Window( window,curx,cury,Width,Height )
  130.      END {ELSE}
  131.   END ; {Do_Open}
  132.  
  133.  { Close our window and delete it from the system }
  134.  
  135.   PROCEDURE Do_Close ;
  136.   BEGIN
  137.     Close_Window( window );
  138.     Delete_Window( window );
  139.     window := No_Window
  140.   END; {Do_Close}
  141.  
  142. { Redraw an area of our window.  The redraw area is passed in the parameters
  143.   x0,y0,w0,and h0. }
  144.  
  145.  PROCEDURE Do_Redraw( handle,x0,y0,w0,h0 : integer; bckgrnd : Boolean );
  146.  
  147.    {These will hold the size of the current redraw rectangle in redraw list. }
  148.  VAR x,y,w,h : Integer ;
  149.  
  150.  BEGIN
  151.    Set_window(window);
  152.    Begin_Update;
  153.    Hide_Mouse ;
  154.    Draw_Mode( 1 );
  155.    Paint_Style( Solid );
  156.    Paint_Color( White ) ;
  157.    First_Rect( handle, x, y, w, h ) ;
  158.    WHILE (w <> 0) AND (h <> 0) DO
  159.    BEGIN
  160.  
  161.      IF Rect_Intersect( x0,y0,w0,h0,x,y,w,h ) THEN
  162.      BEGIN
  163.        Set_Clip( x,y,w,h ) ;
  164.        IF bckgrnd = True THEN Paint_Rect( 0,0,Width,Height ) ;
  165.        Frame_Rect( 0,0,Width,Height ) ;
  166.        Get_DF;
  167.      END ;
  168.  
  169.      Next_Rect( handle,x,y,w,h ) ;
  170.    END ;
  171.  
  172.    Show_Mouse ;
  173.    End_Update
  174.  END ;
  175.  
  176. { This next routine performs all events we receive from GEM.  Since we are an
  177.   accessory, we will never stop running, so the loop below is infinite}
  178.  
  179.  PROCEDURE Event_Loop ;
  180.  
  181.  VAR event, d : Integer ;
  182.           msg : Message_Buffer ;
  183.  
  184.  BEGIN
  185.    WHILE True DO
  186.    BEGIN
  187.      event := Get_Event( E_Message,0,0,0,0,false,0,0,0,0,
  188.                          false,0,0,0,0,msg,d,d,d,d,d,d ) ;
  189.  
  190.      IF event & E_Message <> 0 THEN  {its a message!}
  191.      CASE msg[0] OF
  192.        AC_Open: Do_Open ;      { open the window }
  193.        AC_Close:
  194.          IF (msg[3]=menu_id) AND (window <> No_Window) THEN
  195.                                                        window := No_Window ;
  196.          WM_Sized,
  197.          WM_Moved:
  198.           BEGIN
  199.            Set_WSize( msg[3], msg[4], msg[5], msg[6], msg[7] );
  200.            curx := msg[4];     {keep track of x,y coordinates of}
  201.            cury := msg[5];     {window.}
  202.            Do_Redraw( window, curx, cury, Width, Height, True);
  203.           END;
  204.          WM_Closed: Do_Close ;
  205.          WM_Redraw: Do_Redraw( msg[3], msg[4], msg[5], msg[6], msg[7],True );
  206.          WM_Topped: Bring_To_Front( msg[3] )
  207.      END
  208.      ELSE
  209.        IF window <> No_window THEN
  210.                         Do_Redraw( window, curx, cury, Width, Height, False ) ;
  211.    END
  212.  END ;
  213.  
  214. { Main routine -- initialize GEM, insert our name into the "Desk" menu and
  215.   go to Event_Loop. Because that routine will NEVER return we don't need an
  216.   Exit_Gem call at the end of the program.}
  217.  
  218. BEGIN
  219.   AP_ID := Init_Gem ;     { We do need to save our application ID }
  220.   IF AP_ID >= 0 THEN      { thats a change from most programs }
  221.     BEGIN
  222.       window := No_Window ; {Starting off with no window on the screen. }
  223.       { Always put two spaces before the name of the accessory: }
  224.       our_name := '  Free Disk Space ' ;
  225.       {Here is where we use the application ID number: }
  226.       menu_id := Menu_Register( AP_ID, our_name ) ;
  227.       curx := 20;
  228.       cury := 20;
  229.       Event_Loop ;
  230.     END
  231. END.
  232.