Ne fonctionne qu'avec PB 5.60Code : Tout sélectionner
;=================================================================================================================
; AUTEUR : MicrodevWeb
; Nom du projet :
; Module : Zone
; Version : 0.1b
; Nom Fichier : Zone.pbi
; Requiere : void
; Version PB : 5.60
; Date Départ :
; Date Fin :
; Remarque :
;=================================================================================================================
DeclareModule Zone
;===============================================================================================================
;-* PUBLIC CONSTANTES
; --------------------------------------------------------------------------------------------------------------
;}==============================================================================================================
;===============================================================================================================
;-* PUBLIC PROTOTYPES
; --------------------------------------------------------------------------------------------------------------
Declare Init(IdCanvas,IdZoneRU,IdZoneRB,IdZoneW,PreferenceFileName.s,*CallBack=-1)
;}==============================================================================================================
EndDeclareModule
Module Zone
;===============================================================================================================
;-* PRIVATE CONSTANTES
; --------------------------------------------------------------------------------------------------------------
;}==============================================================================================================
;===============================================================================================================
;-* PRIVATE STRUCTURES
; --------------------------------------------------------------------------------------------------------------
Structure sZone
x.l
y.l
w.l
h.l
IdGadget.l
EndStructure
;}==============================================================================================================
;===============================================================================================================
;-* PRIVATE VARIABLES
; --------------------------------------------------------------------------------------------------------------
Global.sZone ZoneRU,ZoneRB,ZoneW,OldZoneRU,OldZoneRB,OldZoneW
Global M.l=8,myCanvas.l
Global Dim Pos.l(2,2)
Global.l gMouseX,gMouseY,OldX,OldY
Global.b OverVer=#False,OverHo=#False,GdgHide=#False,ClicOn=#False
Global *myCallBack
Global myPreference.s
;}==============================================================================================================
;===============================================================================================================
;-* PRIVATE PROTOTYPES
; --------------------------------------------------------------------------------------------------------------
Declare Draw()
Declare DrawVertSeparator()
Declare DrawHorSeparator()
Declare MyEvent()
Declare WhereIsMouse()
Declare MoveBarVer()
Declare MoveBarHor()
;}==============================================================================================================
;===============================================================================================================
;-* PRIVATE FUNCTIONS
; --------------------------------------------------------------------------------------------------------------
Procedure Draw()
StartVectorDrawing(CanvasVectorOutput(myCanvas))
VectorSourceColor($FFD3D3D3)
FillVectorOutput()
DrawVertSeparator()
DrawHorSeparator()
StopVectorDrawing()
EndProcedure
Procedure DrawVertSeparator()
;Séparation vertical
With ZoneW
AddPathBox(\x-M,\y,M,\h)
VectorSourceColor($8CC59D6C)
Pos(0,0)=\x-M
Pos(0,1)=\y
FillPath()
MovePathCursor(\x-M,\y)
AddPathLine(\x-M,\h)
VectorSourceColor($A7BA8A4F)
StrokePath(2)
MovePathCursor(\x-2,\y)
AddPathLine(\x-2,\h)
VectorSourceColor($88D3B590)
StrokePath(2)
EndWith
EndProcedure
Procedure DrawHorSeparator()
;Séparation vertical
With ZoneRU
AddPathBox(\x,\y+\h,\w,M)
Pos(1,0)=\x
Pos(1,1)=\y+\h
VectorSourceColor($8CC59D6C)
FillPath()
MovePathCursor(\x,\y+\h)
AddPathLine(\W,\y+\h)
VectorSourceColor($A7BA8A4F)
StrokePath(2)
MovePathCursor(\x,\y+\h+M-2)
AddPathLine(\W,\y+\h+M-2)
VectorSourceColor($88D3B590)
StrokePath(2)
EndWith
EndProcedure
Procedure MyEvent()
Select EventType()
Case #PB_EventType_MouseMove
gMouseX=GetGadgetAttribute(myCanvas,#PB_Canvas_MouseX)
gMouseY=GetGadgetAttribute(myCanvas,#PB_Canvas_MouseY)
If Not ClicOn
If WhereIsMouse()
If OverVer
SetGadgetAttribute(myCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
Else
SetGadgetAttribute(myCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
EndIf
Else
SetGadgetAttribute(myCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
EndIf
Else
If OverVer
MoveBarVer()
EndIf
If OverHo
MoveBarHor()
EndIf
EndIf
Case #PB_EventType_MouseLeave
SetGadgetAttribute(myCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
Case #PB_EventType_LeftButtonDown
If OverHo Or OverVer
If Not ClicOn
OldX=gMouseX
OldY=gMouseY
OldZoneRB\w=ZoneRB\w
OldZoneRB\h=ZoneRB\h
OldZoneRB\y=ZoneRB\y
OldZoneRB\x=ZoneRB\x
OldZoneRU\w=ZoneRU\w
OldZoneRU\h=ZoneRU\h
OldZoneRU\y=ZoneRU\y
OldZoneRU\x=ZoneRU\x
OldZoneW\x=ZoneW\x
OldZoneW\w=ZoneW\w
OldZoneW\h=ZoneW\h
OldZoneW\y=ZoneW\y
EndIf
ClicOn=#True
DisableGadget(ZoneRB\IdGadget,#True)
DisableGadget(ZoneRU\IdGadget,#True)
DisableGadget(ZoneW\IdGadget,#True)
HideGadget(ZoneRB\IdGadget,#True)
HideGadget(ZoneRU\IdGadget,#True)
HideGadget(ZoneW\IdGadget,#True)
GdgHide=#True
Else
GdgHide=#False
EndIf
Case #PB_EventType_LeftButtonUp
ClicOn=#False
OpenPreferences(myPreference)
If GdgHide
If OverVer
ResizeGadget(ZoneRB\IdGadget,#PB_Ignore,#PB_Ignore,ZoneRB\w,#PB_Ignore)
ResizeGadget(ZoneRU\IdGadget,#PB_Ignore,#PB_Ignore,ZoneRU\w,#PB_Ignore)
ResizeGadget(ZoneW\IdGadget,ZoneW\x,#PB_Ignore,ZoneW\w,#PB_Ignore)
WritePreferenceLong("SV",ZoneRU\w)
EndIf
If OverHo
ResizeGadget(ZoneRB\IdGadget,#PB_Ignore,ZoneRB\y,#PB_Ignore,ZoneRB\h)
ResizeGadget(ZoneRU\IdGadget,#PB_Ignore,#PB_Ignore,#PB_Ignore,ZoneRU\h)
WritePreferenceLong("SH",ZoneRU\H)
EndIf
If *myCallBack<>-1
CallCFunctionFast(*myCallBack)
EndIf
DisableGadget(ZoneRB\IdGadget,#False)
DisableGadget(ZoneRU\IdGadget,#False)
DisableGadget(ZoneW\IdGadget,#False)
HideGadget(ZoneRB\IdGadget,#False)
HideGadget(ZoneRU\IdGadget,#False)
HideGadget(ZoneW\IdGadget,#False)
GdgHide=#False
EndIf
ClosePreferences()
EndSelect
EndProcedure
Procedure WhereIsMouse()
OverVer=#False
OverHo=#False
If gMouseX>=Pos(0,0) And gMouseX<=Pos(0,0)+M
OverVer=#True
ProcedureReturn #True
EndIf
If gMouseY>=Pos(1,1) And gMouseY<=Pos(1,1)+M
OverHo=#True
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure MoveBarVer()
Protected DepX=OldX-gMouseX
If gMouseX<=M:ProcedureReturn :EndIf
If gMouseX>=WindowWidth(GetActiveWindow())-M:ProcedureReturn :EndIf
ZoneRB\w=OldZoneRB\w-DepX
ZoneRU\w=OldZoneRU\w-DepX
ZoneW\x=OldZoneW\x-DepX
ZoneW\w=OldZoneW\w+DepX
Draw()
EndProcedure
Procedure MoveBarHor()
Protected DepY=OldY-gMouseY
If gMouseY<=M:ProcedureReturn :EndIf
If gMouseY>=WindowHeight(GetActiveWindow())-M:ProcedureReturn :EndIf
ZoneRU\h=OldZoneRU\h-DepY
ZoneRB\h=OldZoneRB\h+DepY
ZoneRB\y=OldZoneRB\y-DepY
Draw()
EndProcedure
;}==============================================================================================================
;===============================================================================================================
;-* PUBLIC FUNCTIONS
; --------------------------------------------------------------------------------------------------------------
Procedure Init(IdCanvas,IdZoneRU,IdZoneRB,IdZoneW,PreferenceFileName.s,*CallBack=-1)
myCanvas=IdCanvas
myPreference=PreferenceFileName
If OpenPreferences(myPreference)=0
MessageRequester("Error","Fail to open preferences file")
ProcedureReturn
EndIf
With ZoneRU
\x=0
\y=0
\w=ReadPreferenceLong("SV",400)
\h=ReadPreferenceLong("SH",200)-(M/2)
\IdGadget=IdZoneRU
ResizeGadget(IdZoneRU,\x,\y,\w,\h)
EndWith
With ZoneRB
\x=0
\y=ReadPreferenceLong("SH",200)+M
\w=ReadPreferenceLong("SV",400)
\h=GadgetHeight(myCanvas)-(ReadPreferenceLong("SH",200)+M)
\IdGadget=IdZoneRB
ResizeGadget(IdZoneRB,\x,\y,\w,\h)
EndWith
With ZoneW
\x=ReadPreferenceLong("SV",400)+M
\y=0
\w=GadgetWidth(myCanvas)-(ReadPreferenceLong("SV",400)+M)
\h=GadgetHeight(myCanvas)
\IdGadget=IdZoneW
ResizeGadget(IdZoneW,\x,\y,\w,\h)
DisableGadget(IdZoneW,#True)
EndWith
*myCallBack=*CallBack
Draw()
BindGadgetEvent(myCanvas,@MyEvent())
ClosePreferences()
EndProcedure
;}==============================================================================================================
EndModule
;=============================================================================================================
; POUR LE TESTE
;=============================================================================================================defin
Global fileName.s="Teste.pref"
If FileSize(fileName)=-1
CreatePreferences(fileName)
WritePreferenceLong("SV",400)
WritePreferenceLong("SH",200)
EndIf
Enumeration
#ZoneCanvas
#CanvasRU
#CanvasRB
#CanvasW
EndEnumeration
Procedure Draw()
StartVectorDrawing(CanvasVectorOutput(#CanvasRU))
AddPathBox(0,0,GadgetWidth(#CanvasRU),GadgetHeight(#CanvasRU))
VectorSourceColor($FF3C14DC)
FillPath(#PB_Path_Preserve)
VectorSourceColor($FF800000)
StrokePath(8)
StopVectorDrawing()
StartVectorDrawing(CanvasVectorOutput(#CanvasRB))
AddPathBox(0,0,GadgetWidth(#CanvasRB),GadgetHeight(#CanvasRB))
VectorSourceColor($FFFF00FF)
FillPath(#PB_Path_Preserve)
VectorSourceColor($FF800080)
StrokePath(8)
StopVectorDrawing()
StartVectorDrawing(CanvasVectorOutput(#CanvasW))
AddPathBox(0,0,GadgetWidth(#CanvasW),GadgetHeight(#CanvasW))
VectorSourceColor($FF00FF00)
FillPath(#PB_Path_Preserve)
VectorSourceColor($FF006400)
StrokePath(8)
StopVectorDrawing()
EndProcedure
Procedure Open()
OpenWindow(0,0,0,800,600,"Teste",#PB_Window_SystemMenu|#PB_Window_Maximize)
CanvasGadget(#ZoneCanvas,0,0,WindowWidth(0),WindowHeight(0),#PB_Canvas_Container)
CanvasGadget(#CanvasRU,0,0,0,0)
CanvasGadget(#CanvasRB,0,0,0,0)
CanvasGadget(#CanvasW,0,0,0,0)
Zone::Init(#ZoneCanvas,#CanvasRU,#CanvasRB,#CanvasW,fileName,@Draw())
Draw()
EndProcedure
Open()
Repeat
WaitWindowEvent()
Until Event()=#PB_Event_CloseWindow
