PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Splitter personalisé

http://forums.purebasic.com/french/viewtopic.php?t=16615

Page 1 sur 1

Splitter personalisé

Publié : ven. 31/mars/2017 10:39
par microdevweb
Avec la version 5.60 purebasic offre encore de nouvelles fonctionalités vraiment intéressantes. Ici j'utilise un canvas comme container et divise la fenêtre en 3 portions repositionnables.

:!: Ne fonctionne qu'avec PB 5.60

Code : 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

Re: Splitter personalisé

Publié : ven. 31/mars/2017 10:53
par Ar-S
C'est sympa :)
ça fait genre BD j'aime bien.

Re: Splitter personalisé

Publié : ven. 31/mars/2017 13:50
par Micoute
Merci beaucoup pour le partage.

Re: Splitter personalisé

Publié : ven. 31/mars/2017 14:11
par Shadow
Pas mal :)

Je suppose que ceci n'est que un premier essais ?
J’espère qu'on pourra le personnaliser encore plus :)

Re: Splitter personalisé

Publié : ven. 31/mars/2017 16:05
par Kwai chang caine
Moi ça me rappelle les vieille machines et leur designs "grossiers", comme ATARI 800XL ou bien aussi PC en Qbasic quand j'avais trouvé un code qui gérait la souris...
C'est vraiment cool, merci du partage 8)
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru