Code : Tout sélectionner
;/================================================
;/ Objet : PROGRAMME TV
;/ Auteur : Flype - flype@altern.org
;/ Date : Février 2005
;/================================================
;/
Structure APP
Name.s
Url.s
Width.l
Height.l
Wnd.l
Brush.l
BgCol.l
EndStructure
Global app.APP
app\Name = "Programme TV"
app\Url = "http://www.programme-tv.net/tv.php"
app\Width = 560
app\Height = 500
app\BgCol = $808080
;/
Enumeration ; Id. Gadget
#gadWeb
#gadActualiser
EndEnumeration
Enumeration ; Id. Statusbar
#sbDate
#sbUrl
EndEnumeration
Enumeration ; Id. Popup Menu
#popActualiser
#popMontrer
#popCacher
#popQuitter
EndEnumeration
;/
Procedure.l RunOnce(lpName.s)
#ERROR_ALREADY_EXISTS = 183
If CreateMutex_(#Null,#Null,@lpName)
If GetLastError_() = #ERROR_ALREADY_EXISTS
Handle = FindWindow_(#Null,lpName)
If Handle
ShowWindow_(Handle,#True)
SetForegroundWindow_(Handle)
End
EndIf
EndIf
EndIf
EndProcedure
Procedure.l ExtractIcon()
lpFileName.s = Space(1024)
If GetModuleFileName_(#Null,lpFileName,1024)
ProcedureReturn ExtractIcon_(GetModuleHandle_(#Null),lpFileName,#Null)
EndIf
EndProcedure
Procedure.l ColorWindow(hwnd.l,crColor.l)
hBrush = CreateSolidBrush_(crColor)
If hBrush
SetClassLong_(hwnd,#GCL_HBRBACKGROUND,hBrush)
InvalidateRect_(hwnd,0,1)
ProcedureReturn hBrush
EndIf
EndProcedure
Procedure.l ShowWindow(hwnd.l,State.l)
If State = -1
State = #True - IsWindowVisible_(hwnd)
EndIf
ShowWindow_(hwnd,State)
If State = #True
SetForegroundWindow_(hwnd)
EndIf
EndProcedure
Procedure.s DateFR()
now.l = Date()
Select DayOfWeek(now)
Case 0 : dd.s = "Dimanche"
Case 1 : dd.s = "Lundi"
Case 2 : dd.s = "Mardi"
Case 3 : dd.s = "Mercredi"
Case 4 : dd.s = "Jeudi"
Case 5 : dd.s = "Vendredi"
Case 6 : dd.s = "Samedi"
EndSelect
Select Month(now)
Case 1 : mm.s = "Janvier"
Case 2 : mm.s = "Février"
Case 3 : mm.s = "Mars"
Case 4 : mm.s = "Avril"
Case 5 : mm.s = "Mai"
Case 6 : mm.s = "Juin"
Case 7 : mm.s = "Juillet"
Case 8 : mm.s = "Août"
Case 9 : mm.s = "Septembre"
Case 10 : mm.s = "Octobre"
Case 11 : mm.s = "Novembre"
Case 12 : mm.s = "Décembre"
EndSelect
ProcedureReturn dd+" "+Str(Day(now))+" "+mm+" "+Str(Year(now))+FormatDate(" à %hh:%ii:%ss",now)
EndProcedure
Procedure.l Quit()
CloseWindow(0)
DeleteObject_(app\Brush)
RemoveSysTrayIcon(0)
EndProcedure
Procedure.l Gui()
flags = #PB_Window_ScreenCentered
flags | #PB_Window_SystemMenu
flags | #PB_Window_SizeGadget
flags | #PB_Window_MinimizeGadget
app\Wnd = OpenWindow(0,0,0,app\Width,app\Height,flags,app\Name)
If app\Wnd = #Null
ProcedureReturn #False
EndIf
ColorWindow(app\Wnd,app\BgCol)
;/
If AddSysTrayIcon(0,app\Wnd,ExtractIcon()) = #Null
ProcedureReturn #False
EndIf
SysTrayIconToolTip(0,app\Name)
;/
If CreateStatusBar(0,app\Wnd) = #Null
ProcedureReturn #False
EndIf
AddStatusBarField(230)
AddStatusBarField($FFF)
StatusBarText(0,#sbUrl,app\Url,#PB_StatusBar_Center)
StatusBarText(0,#sbDate,DateFR(),#PB_StatusBar_Center)
;/
If CreatePopupMenu(0) = #Null
ProcedureReturn #False
EndIf
MenuItem(#popActualiser, "Actualiser")
MenuBar()
MenuItem(#popMontrer, "Montrer")
MenuItem(#popCacher, "Cacher")
MenuBar()
MenuItem(#popQuitter, "Quitter")
;/
If CreateGadgetList(app\Wnd) = #Null
ProcedureReturn #False
EndIf
WebGadget(#gadWeb,5,5,0,0,app\Url)
ButtonGadget(#gadActualiser,4,0,0,22,"Actualiser",#PB_Button_Default)
;/
If LoadFont(0,"Arial",10,#PB_Font_Bold)
SetGadgetFont(#gadActualiser,FontID())
EndIf
;/
ProcedureReturn #True
EndProcedure
Procedure.l Loop()
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow : ShowWindow(app\Wnd,#False)
Case #PB_Event_SizeWindow
wndW = WindowWidth()
wndH = WindowHeight()
ResizeGadget(#gadWeb,-1,-1,wndW-10,wndH-54)
ResizeGadget(#gadActualiser,-1,wndH-45,wndW-8,-1)
Case #PB_Event_Gadget
Select EventGadgetID()
Case #gadActualiser
SetGadgetState(#gadWeb,#PB_Web_Refresh)
StatusBarText(0,#sbDate,DateFR(),#PB_StatusBar_Center)
EndSelect
Case #PB_Event_Menu
Select EventMenuID()
Case #popActualiser : ShowWindow(app\Wnd,#True) : SetGadgetState(0,#PB_Web_Refresh)
Case #popMontrer : ShowWindow(app\Wnd,#True)
Case #popCacher : ShowWindow(app\Wnd,#False)
Case #popQuitter : Quit()
EndSelect
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_RightClick : DisplayPopupMenu(0,app\Wnd,DesktopMouseX(),DesktopMouseY())
Case #PB_EventType_LeftClick : ShowWindow(app\Wnd,-1)
EndSelect
EndSelect
ForEver
EndProcedure
;/
RunOnce(app\Name)
If Gui()
Loop()
EndIf
End
;/