'#############################
'Test-Programm für :
'XProfan
'#############################
'Author : Andreas Miethe
'August 2003
'#############################
'Thema : Windows-Ende abfangen
'#############################

$H windows.ph
$H messages.ph

DEF HiWord(1) And(&(1)>>16,$FFFF)
DEF LoWord(1) And(&(1),$FFFF)

Declare Ende&,Button&,OldWindowProc&

Proc Speicher_Routine
Declare X&
'Statt einer Speicher-Routine läuft hier nur ein Zähler durch
~TextOut(%hDC,0,0,"Speicher-Dummy :",16)
Whilenot X& > 20000
Locate 2,0
Print X&
Inc X&
EndWhile
~TextOut(%hDC,0,100,"fertig mit Speichern :",22)
~TextOut(%hDC,0,150,"Taste.... :",11)
Waitinput
EndProc

Proc Frage_Speichern
 If Messagebox("Erstmal alle Daten speichern ?","Windows_Ende?",36) = 7
     return 1 'Windows wird sofort beendet
 Else
      'bevor 1 zurückgegeben wird kann hier eine Speicher-Routine
      'eingebaut werden. Windows wird erst beendet wenn alles erledigt ist.
     Speicher_Routine
     return 1 'Windows wird nach dem Speichern beendet
     'return 0 'Windows nicht beendet
 Endif
EndProc

Proc WindowProc
  Parameters Wnd&, Msg&, wParam&, lParam&

  If Msg& = ~WM_COMMAND
     If lParam& = Button& 'Control abfragen
        If HiWord(wParam&) = ~BN_CLICKED'Klick auf Button
           SendMessage(Wnd&,~WM_CLOSE,0,0)
        Endif
     Endif
  Endif

  If Msg& = ~WM_CLOSE
     Speicher_Routine
     ~PostQuitMessage(0)'Programm-Ende
  Endif

  If Msg& = ~WM_QUERYENDSESSION
     Return Frage_Speichern()
  Endif

  'alle Messages die nicht behandelt wurden an die Original-Prozedur weiterleiten
  return ~CallWindowProc(OldWindowProc&,Wnd&, Msg&, WParam&, LParam&)
EndProc

set("FastMode",1)
SetTrueColor 1
WindowStyle 31
Window 0,0-640,480
CLS ~GetSysColor(~COLOR_BTNFACE)

Button& = CreateButton(%hwnd,"Ende",10,50,80,24)
Sendmessage(Button&,~WM_SETFONT,~GetStockObject(~DEFAULT_GUI_FONT),1)

'Window-Prozedur austauschen und die Original-Prozedur in
'OldWindowproc sichern
OldWindowProc& = ~SetWindowLong(%hwnd,~GWL_WNDPROC, ProcAddr(windowProc,4))

WhileNot Ende&
WaitInput
EndWhile