Minor changes to the source code:
-EventQueueEmpty = (_EventType = 0) instead of (_EventSource = 0)
-Added : Set Window On : in CreateUI() The screen is no longer cleared when the window is resized
It does nothing else than drawing a beautiful gradient box..
But it shows how to handle:
- DBPro window setup
- DBPro window lost or desktop resolution changed
- Shortcuts disabled when app inactive
- Titlebar deactivation problem
- Efficient event handling
Rem include gui.dba
Rem Set graphic mode to "Hidden"
#Constant false 0
#Constant true 1
#Constant NCACTIVATE 0x0086
#Constant MENUFILE 1000
#Constant MENUEDIT 2000
#Constant CMDEXIT -1
#Constant CMDCUT 2001
#Constant CMDCOPY 2002
#Constant CMDPASTE 2003
#Constant CMDROTATECLRS 2004
Global AppUser32DLL
Global AppDLLBuffer
Global AppDesktopWindow
Global AppScreen
Global AppWindow
Global AppWindowStatusbar
Global AppWindowClient
Global AppTitle$
Global AppExit
Global AppIsActive
Global BoxClr1
Global BoxClr2
Global BoxClr3
Global BoxClr4
Rem * App start *
StartBlue "user", "id"
Sync Off: Rem recomended mode for a windowed utility
AppUser32DLL = 1
Load DLL "user32.dll", AppUser32DLL
Rem * Variables Inits *
AppTitle$ = "My app"
AppDesktopWindow = CreateGadgetFromWindow(DesktopWindow())
AppScreen = CreateGadgetFromWindow(MainWindow())
AppIsActive = true
Rem * UI *
App_CreateUI()
App_CreateHotKeys()
Rem * Default "project" *
BoxClr1 = RGB (255, 0, 0)
BoxClr2 = RGB (255, 255, 255)
BoxClr3 = RGB (0, 255, 0)
BoxClr4 = RGB (0, 0, 255)
Rem Tip used to detect screen change
Get Image 1, 0, 0, 1, 1
Rem * Main loop *
ActivateGadget AppWindow
PrevActiveGadget = ActiveGadget()
ExitLoop = false
Do: Rem Loop with sync
Rem Indirect event response
_ActiveGadget = ActiveGadget()
MenuOp = false
Resize = false
Redraw = false
Command = 0
Rem - Detect screen change -
If Image Exist(1) = 0
DW = GadgetWidth(AppDesktopWindow): DH = GadgetHeight(AppDesktopWindow)
If (Screen Width() <> DW) Or (Screen Height() <> DH) Then Screen_Reset(DW, DH)
Get Image 1, 0, 0, 1, 1
Resize = true
EndIf
Rem - Empty the event queue -
For EventQueueEmpty = false to true: Rem For/Next fast loop *without* dbpsync call
GetEvent
_EventSource = EventSource()
_EventType = EventType()
If _EventSource = AppWindow
If _EventType = WINDOW_CLOSE Then Command = CMDEXIT
If _EventType = MENU_CLICK Then Command = EventData()
If _EventType = GADGET_SIZING Then Resize = true
If _EventType = GADGET_SIZE Then Resize = true
If _EventType = 287 Then MenuOp = true
EndIf
If _EventType = HOTKEY Then Command = EventData()
EventQueueEmpty = (_EventType = 0)
Next EventQueueEmpty
Rem - Reactivate titlebar when selecting DBPro window -
If _ActiveGadget <> PrevActiveGadget
If _ActiveGadget = AppScreen
BringToFront AppWindow
Activategadget AppScreen
App_ReactivateTitlebars(true)
EndIf
If _ActiveGadget = 0 Then App_ReactivateTitlebars(false)
Else
If (_ActiveGadget = AppScreen) And MenuOp Then App_ReactivateTitlebars(true)
EndIf
Rem - Disable shortcuts when app is inactive -
If _ActiveGadget
If AppIsActive = false
App_CreateHotKeys()
AppIsActive = true
EndIf
Else
If AppIsActive
App_DeleteHotKeys()
AppIsActive = false
EndIf
EndIf
Rem - Execute app commands -
If Command <> 0
Select Command
Case CMDEXIT: App_EXIT(): Endcase
Case CMDCUT: App_CUT(): Endcase
Case CMDCOPY: App_COPY(): Endcase
Case CMDPASTE: App_PASTE(): Endcase
Case CMDROTATECLRS: App_ROTATECOLORS(): Redraw = true: Endcase
EndSelect
EndIf
Rem - Resize and redraw -
If Resize
CW = GadgetClientWidth(AppWindow)
CH = GadgetClientHeight(AppWindow) - GadgetHeight(AppWindowStatusbar)
If CW < 640 Then CW = 640
If CH < 480 Then CH = 480
ResizeGadget AppWindowClient, CW, CH
Redraw = true
EndIf
If Redraw Then Screen_Redraw()
Rem - Loop end -
PrevActiveGadget = _ActiveGadget
If AppExit = true Then ExitLoop = true
If ExitLoop Then Exit
Loop
Rem * App end *
Delete DLL AppUser32DLL
End
`_____________________________________________________________________________________________________
Function Screen_Reset(Width, Height)
Set Window Layout 0, 0, 0
Set Display Mode Width, Height, Screen Depth()
Set Window Position 0, 0
ResetMainWindow
EndFunction
`_____________________________________________________________________________________________________
Function Screen_Redraw()
W = GadgetClientWidth(AppWindowClient): H = GadgetClientHeight(AppWindowClient)
Box 0, 0, W, H, BoxClr1, BoxClr2, BoxClr3, BoxClr4
CW = Screen Width(): CH = Screen Height()
Ink 0, 0: Text 9, 9, Str$(CW) + " " + Str$(CH)
Ink 0xffffffff, 0: Text 8, 8, Str$(CW) + " " + Str$(CH)
EndFunction
`_____________________________________________________________________________________________________
Function App_ReactivateTitlebars(Activate)
Call DLL AppUser32DLL, "SendMessageA", WindowHandle(AppWindow), NCACTIVATE, Activate, 0
EndFunction
`_____________________________________________________________________________________________________
Function App_CreateHotKeys()
CreateHotKey CMDCUT, 0, 0, 1, Asc("X")
CreateHotKey CMDCOPY, 0, 0, 1, Asc("C")
CreateHotKey CMDPASTE, 0, 0, 1, Asc("V")
EndFunction
`_____________________________________________________________________________________________________
Function App_DeleteHotKeys()
DeleteHotKey CMDCUT
DeleteHotKey CMDCOPY
DeleteHotKey CMDPASTE
EndFunction
`_____________________________________________________________________________________________________
Function App_CreateUI()
W = GadgetClientWidth(AppDesktopWindow) - 32
H = GadgetClientHeight(AppDesktopWindow) - 64
AppWindow = CreateWindow(16, 16, W, H, AppTitle$, WINDOW_NORMAL, 0, 1, 0)
AppWindowStatusbar = CreateStatusBar(AppWindow)
AppWindow_CreateMenu()
AppWindowClient = CreatePanel(0, 0, 1, 1, AppWindow)
SetPanelBorderStyle AppWindowClient, BORDER_SUNKEN
Set Window On
Screen_Reset(GadgetWidth(AppDesktopWindow), GadgetHeight(AppDesktopWindow))
SetGadgetParent AppScreen, AppWindowClient
BringToFront AppWindowStatusbar
EndFunction
`_____________________________________________________________________________________________________
Function AppWindow_CreateMenu()
TabChr$ = Chr$(9)
Menu = CreateMenu(AppWindow)
AddMenuItem Menu, "&File", MENUFILE
AddMenuItem Menu, "&Edit", MENUEDIT
FileMenu = CreateSubMenu(Menu, MENUFILE)
AddMenuItem FileMenu, "&Exit", CMDEXIT
EditMenu = CreateSubMenu(Menu, MENUEDIT)
AddMenuItem EditMenu, "&Cut"+TabChr$+"CTRL+X", CMDCUT
AddMenuItem EditMenu, "C&opy"+TabChr$+"CTRL+C", CMDCOPY
AddMenuItem EditMenu, "&Paste"+TabChr$+"CTRL+V", CMDPASTE
AddMenuSplitter EditMenu
AddMenuItem EditMenu, "Rotate colors", CMDROTATECLRS
EndFunction
`_____________________________________________________________________________________________________
Function App_EXIT()
r = QuestionMessage("Do you really want to exit ???", AppTitle$)
If r=1 Then AppExit = true
EndFunction
`_____________________________________________________________________________________________________
Function App_CUT()
Message AppTitle$, "CUT command at your service"
EndFunction
`_____________________________________________________________________________________________________
Function App_COPY()
Message AppTitle$, "COPY command at your service"
EndFunction
`_____________________________________________________________________________________________________
Function App_PASTE()
Message AppTitle$, "PASTE command at your service"
EndFunction
`_____________________________________________________________________________________________________
Function App_ROTATECOLORS()
tmp = BoxClr1
BoxClr1 = BoxClr2
BoxClr2 = BoxClr3
BoxClr3 = BoxClr4
BoxClr4 = tmp
EndFunction
This basic version is good start for this kind of app..
Better than longs explanations, I've added a few comments in the code...
This snippet is a part of my
Simple 3D Sandbox