this is just a simple about dialog i made for my tools.
Features:
- public domain
- easy to call
- easy extensible
- modal and cross platform (win, linux, don't have mac)
Feel free to use it in your apps
Code: Select all
;*************************************************************************
; dlgabout.pbi
; Simple dialog to display the information of an application.
;
; Author: Alexander Resner
;
; License:
;-------------------------------------------------------------------------
; 2011 June 23
;
; The author disclaims copyright To this source code. In place of
; a legal notice, here is a blessing:
;
; May you do good And Not evil.
; May you find forgiveness For yourself And forgive others.
; May you share freely, never taking more than you give.
;
;*************************************************************************
Procedure OpenWindow_About(idParent.l, title$, version$, copyright$, email$)
If (idParent >= 0) And (Not IsWindow(idParent))
idParent = -1
EndIf
Protected dlgAbout.l
Protected text_version.l, text_copyright.l, hl_email.l, menu_quit.l = $0AFF
Protected fontVerdana.l, fontVerdanaBold.l, hVerdana.l, hVerdanaBold.l
Protected eventid.l
Protected dlgAboutQuit.b = #False
If idParent >= 0
dlgAbout = OpenWindow(#PB_Any, 0, 0, 350, 100, title$, #PB_Window_WindowCentered | #PB_Window_Tool | #PB_Window_SystemMenu, WindowID(idParent))
Else
dlgAbout = OpenWindow(#PB_Any, 0, 0, 350, 100, title$, #PB_Window_ScreenCentered | #PB_Window_Tool | #PB_Window_SystemMenu)
EndIf
If dlgAbout = 0
MessageRequester("Error", "Can't open window!", #PB_MessageRequester_Ok)
ProcedureReturn
EndIf
; fonts
fontVerdana = LoadFont(#PB_Any, "Verdana", 10)
hVerdana = FontID(fontVerdana)
fontVerdanaBold = LoadFont(#PB_Any, "Verdana", 10, #PB_Font_Bold)
hVerdanaBold = FontID(fontVerdanaBold)
; gadgets
text_version = TextGadget(#PB_Any, 10, 10, 330, 20, version$, #PB_Text_Border | #PB_Text_Center)
SetGadgetFont(text_version, hVerdanaBold)
text_copyright = TextGadget(#PB_Any, 10, 50, WindowWidth(dlgAbout) - 20, 20, copyright$, #PB_Text_Center)
SetGadgetFont(text_copyright, hVerdana)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
hl_email = HyperLinkGadget(#PB_Any, 10, 70, WindowWidth(dlgAbout) - 20, 20, email$, RGB(0, 0, 255), #PB_Text_Center)
CompilerElse
; Under Linux there's sadly no simple solution available to call the standard email program.
hl_email = TextGadget(#PB_Any, 10, 70, WindowWidth(dlgAbout) - 20, 20, email$, #PB_Text_Center)
CompilerEndIf
ResizeGadget(hl_email, (WindowWidth(dlgAbout) - GadgetWidth(hl_email))/2, #PB_Ignore, #PB_Ignore, #PB_Ignore)
SetGadgetFont(hl_email, hVerdana)
; keyboard shortcuts / menus
AddKeyboardShortcut(dlgAbout, #PB_Shortcut_Escape, menu_quit)
; disable main window
If idParent >= 0 And IsWindow(idParent)
DisableWindow(idParent, #True)
SetActiveWindow(dlgAbout)
EndIf
Repeat
eventid = WaitWindowEvent()
Select EventWindow()
Case dlgAbout
Select eventid
Case #PB_Event_CloseWindow
dlgAboutQuit = #True
Case #PB_Event_Menu
Select EventMenu()
Case menu_quit
dlgAboutQuit = #True
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case hl_email
; Under Linux there's sadly no simple solution available to call the standard email program.
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
ShellExecute_(#Null, "open", "mailto:" + email$, #Null, #Null, #SW_SHOW)
CompilerEndIf
EndSelect
EndSelect
EndSelect
Until dlgAboutQuit = #True
If idParent >= 0 And IsWindow(idParent)
DisableWindow(idParent, #False)
SetActiveWindow(idParent)
EndIf
CloseWindow(dlgAbout)
FreeFont(fontVerdana)
FreeFont(fontVerdanaBold)
EndProcedure
;OpenWindow_About(-1, "Testtitel", "Testapp 0.00.00", "Copyright test", "test@test.de")
- chnages for linux
- enable window before closing child
