'
' GFA Snapshot ACC
' GFA-Basic v 2.02
' (C) 3/30/89, PKF
'
' After compilation, please rename
' the file .PRG into a file .ACC
'
Reserve 160000
Ap.id%=Dpeek(Lpeek(Gb+4)+4)
Nam$="  GFA Snapshot"
@Menu_register(Ap.id%,Nam$)
Buff$=String$(16,0)
@Form_alert(0,"[0][== !! GFA Snapshot !! == |A wonderful program by| ][ PKF ]")
Do
  @Evnt_mesag(Varptr(Buff$))
  If Cvi(Buff$)=40
    Sget Desk$
    @Programma
    Sput Desk$
  Endif
Loop
'
Procedure Programma
  Alert 1,"Press left mouse button|and release it, then drag|and select the chosen area,|confirm with right mouse button.",1,"  Ok  ",Pkf%
  Defmouse 7
  Do
    Mouse X%,Y%,K%
    If K%=1
      Pkf%=0
      Do
        @Rubberbox
        Exit If Mousek=2
      Loop
      Get X%,Y%,X%+Br%,Y%+H%,Pk$
      Put X%,Y%,Pk$,8
      Pause 20
      Put X%,Y%,Pk$
    Endif
    Exit If Pkf%=0
  Loop
  Defmouse 0
  Fileselect "\*.PIK","",A$
  If Len(A$)>1
    A$=Left$(A$,8)+".PIK"
    Bsave A$,Varptr(Pk$),Len(Pk$)
  Endif
Return
Procedure Menu_register(Ap.id%,Nam$)
  Nam$=Nam$+Chr$(0)
  Bmove Varptr(Nam$),Basepage+192,Len(Nam$)
  Dpoke Gintin,Ap.id%
  Lpoke Addrin,Basepage+192
  Gemsys 35
Return
Procedure Evnt_mesag(Adr%)
  Lpoke Addrin,Adr%
  Gemsys 23
Return
Procedure Form_alert(B_%,Nam_$)
  Nam_$=Nam_$+Chr$(0)
  Dpoke Gintin,B_%
  Lpoke Addrin,Varptr(Nam_$)
  Gemsys 52
Return
Procedure Rubberbox
  Dpoke Gintin,0
  Dpoke Gintin+2,0
  Dpoke Gintin,X%
  Dpoke Gintin+2,Y%
  Dpoke Gintin+4,3
  Dpoke Gintin+6,3
  Gemsys 70
  Br%=Dpeek(Gintout+2)
  H%=Dpeek(Gintout+4)
  Dpoke Gintin,0
  Dpoke Gintin+2,0
Return