PBMiner

$PBExportHeader$w_main.srw
forward
global type w_main from window
end type
type cb_stop from commandbutton within w_main
end type
type cb_process from commandbutton within w_main
end type
type lb_msgbox from listbox within w_main
end type
type cb_cancel from commandbutton within w_main
end type
end forward

global type w_main from window
integer width = 1586
integer height = 1004
boolean titlebar = true
string title = "Shared Objects Demo"
boolean controlmenu = true
long backcolor = 67108864
string icon = "UserObject5!"
boolean center = true
event ue_sharedmessage pbm_custom01
event ue_sharedcomplete pbm_custom02
event ue_sharedprogress pbm_custom03
cb_stop cb_stop
cb_process cb_process
lb_msgbox lb_msgbox
cb_cancel cb_cancel
end type
global w_main w_main

type variables
n_demotask in_shr
Boolean ib_SharedRunning
Boolean ib_RunBackground = True

end variables

forward prototypes
public subroutine wf_msg (string as_msg)
public function errorreturn wf_sharedresult (errorreturn aer_result)
public subroutine wf_setrunning (boolean ab_isrunning)
end prototypes

event ue_sharedmessage;// shared object Message event

String ls_msgtext

If lparam > 0 Then
   choose case wparam
      case 0
         // add message to listbox
         ls_msgtext = String(lparam, "address")
         wf_msg(ls_msgtext)
      case 1
         // display message
         ls_msgtext = String(lparam, "address")
         MessageBox(this.title, ls_msgtext, Information!)
   end choose
End If

Yield()

end event

event ue_sharedcomplete;// shared object Complete event

String ls_msgtext

// unregister the shared object
SetNull(in_shr)
SharedObjectUnregister("background")
Destroy in_shr

// enable/disable buttons
wf_SetRunning(False)

choose case wparam
   case 1
      wf_msg("The background task has stopped")
   case 2
      wf_msg("The background task has stopped due to errors")
      If lparam > 0 Then
         ls_msgtext = String(lparam, "address")
         wf_msg(ls_msgtext)
      End If
   case else
      wf_msg("The background task has completed")
end choose

Yield()

end event

event ue_sharedprogress;// shared object Progress event

String ls_msgtext

ls_msgtext = "Processing step " + String(wparam) + &
               " of " + String(lparam)
wf_msg(ls_msgtext)

Yield()

end event

public subroutine wf_msg (string as_msg);Integer li_item

li_item = lb_msgbox.AddItem(as_msg)
lb_msgbox.SelectItem(li_item)

end subroutine

public function errorreturn wf_sharedresult (errorreturn aer_result);// display error messages for SharedObject functions
choose case aer_result
   case SharedObjectExistsError!
      MessageBox("SharedObjectRegister Error", &
            "The instance name has already been used!", &
            StopSign!)
   case SharedObjectCreatePBSessionError!
      MessageBox("SharedObjectRegister Error", &
            "The shared object session could not be created!", &
            StopSign!)
   case SharedObjectCreateInstanceError!
      MessageBox("SharedObjectGet Error", &
            "The local reference to the shared object could " + &
            "not be created!", StopSign!)
   case SharedObjectNotExistsError!
      MessageBox("SharedObjectGet Error", &
            "The instance name has not been registered!", &
            StopSign!)
end choose

Return aer_result

end function

public subroutine wf_setrunning (boolean ab_isrunning);// enable/disable buttons
ib_SharedRunning = ab_isrunning
cb_process.Enabled = Not ab_isrunning
cb_stop.Enabled = ab_isrunning

end subroutine

on w_main.create
this.cb_stop=create cb_stop
this.cb_process=create cb_process
this.lb_msgbox=create lb_msgbox
this.cb_cancel=create cb_cancel
this.Control[]={this.cb_stop,&
this.cb_process,&
this.lb_msgbox,&
this.cb_cancel}
end on

on w_main.destroy
destroy(this.cb_stop)
destroy(this.cb_process)
destroy(this.lb_msgbox)
destroy(this.cb_cancel)
end on

event closequery;If ib_SharedRunning Then
   MessageBox(this.Title, "The window cannot be closed, " + &
      "a background task is running!", StopSign!)

   Return 1
End If

end event

type cb_stop from commandbutton within w_main
integer x = 512
integer y = 64
integer width = 370
integer height = 100
integer taborder = 20
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
boolean enabled = false
string text = "Stop"
end type

event clicked;this.Enabled = False

wf_msg("Waiting for background task to stop")

// stop the process
in_shr.Post of_StopProcess()

end event

type cb_process from commandbutton within w_main
integer x = 73
integer y = 64
integer width = 370
integer height = 100
integer taborder = 10
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "Process"
end type

event clicked;ErrorReturn ler_result
Window lw_window

// create processing object
If ib_RunBackground Then
   // object will run in a background thread
   // register the shared object
   ler_result = SharedObjectRegister("n_demotask", "background")
   If wf_SharedResult(ler_result) = Success! Then
      // get a reference to the shared object
      ler_result = SharedObjectGet("background", in_shr)
      If Not wf_SharedResult(ler_result) = Success! Then
         Return
      End If
      // copy transaction settings
      in_shr.of_CopyTrans(sqlca)
   End If
Else
   // object will run in this thread (good for debugging)
   in_shr = Create n_demotask
End If

// enable/disable buttons
wf_SetRunning(True)

// register the window events
lw_window = Parent
in_shr.of_RegisterEvents(lw_window, 1, 2, 3)

// run the processing function
in_shr.Post of_MyTask(10)

end event

type lb_msgbox from listbox within w_main
integer x = 73
integer y = 224
integer width = 1431
integer height = 484
integer taborder = 10
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
boolean vscrollbar = true
boolean sorted = false
borderstyle borderstyle = stylelowered!
end type

type cb_cancel from commandbutton within w_main
integer x = 1134
integer y = 768
integer width = 370
integer height = 100
integer taborder = 10
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "Cancel"
boolean cancel = true
end type

event clicked;Close(Parent)

end event