home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 134 / pascal / freedr2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-17  |  6.2 KB  |  216 lines
  1. {$A+,$S5,D-}  {compile for desk accessory}
  2.  
  3. PROGRAM Disk_Space_Accessory;  { 2 Drive version }
  4.  
  5.  CONST {$I gemconst.pas}
  6.        AC_Open = 40;  {Two new message that only accessories will get}
  7.        AC_Close = 41;
  8.        Height = 45;   {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 := '      ' ;                { 2 drive version shows 6 digits }
  62.    I := A DIV 100000 ;
  63.    spc[ 1 ] := Chr( I + 48 ) ;
  64.    A := A - ( I * 100000 ) ;
  65.  
  66.    I := A DIV 10000 ;
  67.    spc[ 2 ] := Chr( I + 48 ) ;
  68.    A := A - ( I * 10000 ) ;
  69.  
  70.    I := A DIV 1000 ;
  71.    spc[ 3 ] := Chr( I + 48 ) ;
  72.    A := A - ( I * 1000 ) ;
  73.  
  74.    I := A DIV 100 ;
  75.    spc[ 4 ] := Chr( I + 48 ) ;
  76.    A := A - ( I * 100 ) ;
  77.  
  78.    I := A DIV 10 ;
  79.    spc[ 5 ] := Chr( I + 48 ) ;
  80.    A := A - ( I * 10 ) ;
  81.  
  82.    I :=  A ;
  83.    spc[ 6 ] := Chr( I + 48 ) ;
  84.  END ;
  85.  
  86.  PROCEDURE Get_DF ;
  87.  
  88.  VAR dspc : Str255 ;
  89.  
  90.  BEGIN
  91.    space := Free( 1 );     { Get free space on drive A }
  92.    Convert ( space ) ;
  93.    dspc := Concat ( 'Drive A: Free = ', spc ) ;
  94.    Draw_String( 12, 20, dspc ) ;
  95.    space := Free( 2 );     { Get free space on drive B }
  96.    Convert ( space ) ;
  97.    dspc := Concat ( 'Drive B: Free = ', spc ) ;
  98.    Draw_String( 12, 30, dspc ) ;
  99.  END ;
  100.  
  101. { Open our window, if not already open, otherwise make it the front window. }
  102.  
  103.  PROCEDURE Do_Open ;
  104.   BEGIN
  105.    { Does our window already exist? }
  106.    IF window <> No_window THEN
  107.      Bring_To_Front ( window )    { Yes, just make it front window. }
  108.    ELSE
  109.      BEGIN
  110.        wind_name := ' Free Disk Space ' ;
  111.        window := New_Window ( G_Name|G_Close|G_Move,wind_name,
  112.                               0,0,Width,Height );
  113.        Open_Window( window,curx,cury,Width,Height )
  114.      END {ELSE}
  115.   END ; {Do_Open}
  116.  
  117.  { Close our window and delete it from the system }
  118.  
  119.   PROCEDURE Do_Close ;
  120.   BEGIN
  121.     Close_Window( window );
  122.     Delete_Window( window );
  123.     window := No_Window
  124.   END; {Do_Close}
  125.  
  126. { Redraw an area of our window.  The redraw area is passed in the parameters
  127.   x0,y0,w0,and h0. }
  128.  
  129.  PROCEDURE Do_Redraw( handle,x0,y0,w0,h0 : integer; bckgrnd : Boolean );
  130.  
  131.    {These will hold the size of the current redraw rectangle in redraw list. }
  132.  VAR x,y,w,h : Integer ;
  133.  
  134.  BEGIN
  135.    Set_window(window);
  136.    Begin_Update;
  137.    Hide_Mouse ;
  138.    Draw_Mode( 1 );
  139.    Paint_Style( Solid );
  140.    Paint_Color( White ) ;
  141.    First_Rect( handle, x, y, w, h ) ;
  142.    WHILE (w <> 0) AND (h <> 0) DO
  143.    BEGIN
  144.  
  145.      IF Rect_Intersect( x0,y0,w0,h0,x,y,w,h ) THEN
  146.      BEGIN
  147.        Set_Clip( x,y,w,h ) ;
  148.        IF bckgrnd = True THEN Paint_Rect( 0,0,Width,Height ) ;
  149.        Frame_Rect( 0,0,Width,Height ) ;
  150.        Get_DF;
  151.      END ;
  152.  
  153.      Next_Rect( handle,x,y,w,h ) ;
  154.    END ;
  155.  
  156.    Show_Mouse ;
  157.    End_Update
  158.  END ;
  159.  
  160. { This next routine performs all events we receive from GEM.  Since we are an
  161.   accessory, we will never stop running, so the loop below is infinite}
  162.  
  163.  PROCEDURE Event_Loop ;
  164.  
  165.  VAR event, d : Integer ;
  166.           msg : Message_Buffer ;
  167.  
  168.  BEGIN
  169.    WHILE True DO
  170.    BEGIN
  171.      event := Get_Event( E_Message,0,0,0,0,false,0,0,0,0,
  172.                          false,0,0,0,0,msg,d,d,d,d,d,d ) ;
  173.  
  174.      IF event & E_Message <> 0 THEN  {its a message!}
  175.      CASE msg[0] OF
  176.        AC_Open: Do_Open ;      { open the window }
  177.        AC_Close:
  178.          IF (msg[3]=menu_id) AND (window <> No_Window) THEN
  179.                                                        window := No_Window ;
  180.          WM_Sized,
  181.          WM_Moved:
  182.           BEGIN
  183.            Set_WSize( msg[3], msg[4], msg[5], msg[6], msg[7] );
  184.            curx := msg[4];     {keep track of x,y coordinates of}
  185.            cury := msg[5];     {window.}
  186.            Do_Redraw( window, curx, cury, Width, Height, True);
  187.           END;
  188.          WM_Closed: Do_Close ;
  189.          WM_Redraw: Do_Redraw( msg[3], msg[4], msg[5], msg[6], msg[7],True );
  190.          WM_Topped: Bring_To_Front( msg[3] )
  191.      END
  192.      ELSE
  193.        IF window <> No_window THEN
  194.                         Do_Redraw( window, curx, cury, Width, Height, False ) ;
  195.    END
  196.  END ;
  197.  
  198. { Main routine -- initialize GEM, insert our name into the "Desk" menu and
  199.   go to Event_Loop. Because that routine will NEVER return we don't need an
  200.   Exit_Gem call at the end of the program.}
  201.  
  202. BEGIN
  203.   AP_ID := Init_Gem ;     { We do need to save our application ID }
  204.   IF AP_ID >= 0 THEN      { thats a change from most programs }
  205.     BEGIN
  206.       window := No_Window ; {Starting off with no window on the screen. }
  207.       { Always put two spaces before the name of the accessory: }
  208.       our_name := '  Free Disk Space ' ;
  209.       {Here is where we use the application ID number: }
  210.       menu_id := Menu_Register( AP_ID, our_name ) ;
  211.       curx := 20;
  212.       cury := 20;
  213.       Event_Loop ;
  214.     END
  215. END.
  216.