Color manageur
Posted: Fri Nov 20, 2015 4:07 pm
Stepp1: Copy this code (367 lines) and save this with the name ColorManager.pbi
Edit : Vers B0.3
Code: Select all
;************************************************************************************************
; Name : Module Color Manager
; Vers: B0.1 Date: 2015/11/20
; Vers: B0.2 Date: 2015/11/20
; --> Add Toltip
; --> Status bar
; Vers: B0.3 Date: 2015/11/20
; --> Bug fixed
; --> Alpha checkbox
; Use: Pb 5.40
; Author: MicrodevWeb
;************************************************************************************************
DeclareModule clm
Declare Open(DefaultColor.q,*Callback)
Declare RefreshStatus()
EndDeclareModule
Module clm
EnableExplicit
Prototype.i myProcedure(Value.q,AlphaChannel.b)
Structure form
IdForm.i
IdCanvasR.i
IdCanvasG.i
IdCanvasB.i
IdCanvasA.i
IdCanvasPreview.i
IdSubmit.i
IdChancel.i
*Callback
IdSatusBar.i
CheckAlpha.i
EndStructure
Structure color
R.i
G.i
B.i
A.i
EndStructure
Structure Pos
X.i
Y.i
EndStructure
Global myColor.color
Global myForm.form
Global gMotherId
Global gFont=LoadFont(#PB_Any,"Arial",12, #PB_Font_HighQuality)
Global gClicOn.b=#False
Global gMouse.Pos
Global gHover.b=#False
#CarreSize=6
Declare Draw()
Procedure Close()
If gMotherId<>-1
DisableWindow(gMotherId,#False)
EndIf
CloseWindow(myForm\IdForm)
EndProcedure
Procedure EventManage(gadget)
Protected Unit.d=GadgetWidth(gadget)/255
Protected Val=Round(gMouse\X/Unit,#PB_Round_Up)
Select EventType()
Case #PB_EventType_MouseEnter
SetGadgetAttribute(gadget,#PB_Canvas_Cursor,#PB_Cursor_Hand)
Case #PB_EventType_MouseLeave
SetGadgetAttribute(gadget,#PB_Canvas_Cursor,#PB_Cursor_Default)
Case #PB_EventType_MouseMove
gMouse\X=GetGadgetAttribute(gadget,#PB_Canvas_MouseX)
gMouse\Y=GetGadgetAttribute(gadget,#PB_Canvas_MouseY)
If gClicOn And gMouse\X>=0 And gMouse\X<=GadgetWidth(gadget)+1
Select gadget
Case myForm\IdCanvasA
myColor\A=Val
Case myForm\IdCanvasR
myColor\R=Val
Case myForm\IdCanvasB
myColor\B=Val
Case myForm\IdCanvasG
myColor\G=Val
EndSelect
Draw()
ProcedureReturn
EndIf
Case #PB_EventType_LeftButtonDown
If Not gClicOn
Select gadget
Case myForm\IdCanvasA
myColor\A=Val
Case myForm\IdCanvasR
myColor\R=Val
Case myForm\IdCanvasB
myColor\B=Val
Case myForm\IdCanvasG
myColor\G=Val
EndSelect
Draw()
EndIf
gClicOn=#True
Case #PB_EventType_LeftButtonUp
gClicOn=#False
EndSelect
EndProcedure
Procedure EventCanvas()
If EventGadget()=myForm\IdCanvasA And GetGadgetState(myForm\CheckAlpha)=#False
ProcedureReturn
EndIf
EventManage( EventGadget())
EndProcedure
Procedure Submit()
With myColor
Protected ValReturn.q,AlphaChannel.b
If GetGadgetState(myForm\CheckAlpha)=#True
ValReturn=RGBA(\R,\G,\B,\A)
AlphaChannel=#True
Else
ValReturn=RGB(\R,\G,\B)
AlphaChannel=#False
EndIf
Protected myProcedure.myProcedure=myForm\Callback
Close()
myProcedure(ValReturn,AlphaChannel)
EndWith
EndProcedure
Macro mCanvas(Label,gadgetId)
tmp=TextGadget(#PB_Any,X,Y,LW,HC,Label)
SetGadgetFont(tmp,FontID(gFont))
X+LW+M
gadgetId=CanvasGadget(#PB_Any,X,Y,W,HC)
Y+HC+M
BindGadgetEvent(gadgetId,@EventCanvas())
X=M
EndMacro
Macro mCanvas2(Label,gadgetId)
tmp=TextGadget(#PB_Any,X,Y,W*0.38,HC,Label)
SetGadgetFont(tmp,FontID(gFont))
myForm\CheckAlpha=CheckBoxGadget(#PB_Any,X+(W*0.38)+M,Y,20,20,"")
SetGadgetState(myForm\CheckAlpha,#True)
Y+HC
gadgetId=CanvasGadget(#PB_Any,X+LW+M,Y,W,HC)
Y+HC+M
BindGadgetEvent(gadgetId,@EventCanvas())
BindGadgetEvent(myForm\CheckAlpha,@Draw())
X=M
EndMacro
Procedure DrawPreview()
With myForm
Protected W=GadgetWidth(\IdCanvasPreview)
Protected H=GadgetHeight(\IdCanvasPreview)
Protected X,Y,D
StartDrawing(CanvasOutput(\IdCanvasPreview))
If GetGadgetState(myForm\CheckAlpha)=#True
;{ Dessin du damier
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,W,H,RGB(255,255,255))
For Y=0 To H
For X=D To W
Box(X,Y,#CarreSize,#CarreSize,$D3D3D3)
X+(#CarreSize*2)
Next
Y+#CarreSize
If D=0
D=#CarreSize
Else
D=0
EndIf
Next
;}
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(0,0,W,H/2,RGBA(myColor\R,myColor\G,myColor\B,myColor\A))
DrawingMode(#PB_2DDrawing_Default)
Box(0,H/2,W,H/2,RGB(myColor\R,myColor\G,myColor\B))
Else
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,W,H,RGB(myColor\R,myColor\G,myColor\B))
EndIf
StopDrawing()
EndWith
EndProcedure
Procedure DrawAlpha()
With myForm
Protected W=GadgetWidth(\IdCanvasA)
Protected H=GadgetHeight(\IdCanvasA)
Protected X,Y,D
Protected Unit=W/255
StartDrawing(CanvasOutput(\IdCanvasA))
;{ Dessin du damier
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,W,H,RGB(255,255,255))
For Y=0 To H
For X=D To W
Box(X,Y,#CarreSize,#CarreSize,$D3D3D3)
X+(#CarreSize*2)
Next
Y+#CarreSize
If D=0
D=#CarreSize
Else
D=0
EndIf
Next
;}
DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaBlend)
BackColor(RGBA(myColor\R,myColor\G,myColor\B,0))
FrontColor(RGBA(myColor\R,myColor\G,myColor\B,255))
LinearGradient(0,0,W,H)
Box(0,0,W,H)
;{ Dessin de la ligne du niveau
DrawingMode(#PB_2DDrawing_Default)
X=Unit * myColor\A
Box(X,0,2,H,RGB(0,0,0))
;}
StopDrawing()
GadgetToolTip(myForm\IdCanvasA,Str(myColor\A))
EndWith
EndProcedure
Procedure DrawNoAlpha()
With myForm
Protected W=GadgetWidth(\IdCanvasA)
Protected H=GadgetHeight(\IdCanvasA)
Protected X,Y,D
Protected Unit=W/255
StartDrawing(CanvasOutput(\IdCanvasA))
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,W,H,RGB(myColor\R,myColor\G,myColor\B))
StopDrawing()
GadgetToolTip(myForm\IdCanvasA,Str(255))
myColor\A=255
EndWith
EndProcedure
Procedure DrawRed()
With myForm
Protected W=GadgetWidth(\IdCanvasR)
Protected H=GadgetHeight(\IdCanvasR)
Protected X,Y,D
Protected Unit=1
StartDrawing(CanvasOutput(\IdCanvasR))
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(RGB(0,myColor\G,myColor\B))
FrontColor(RGB(255,myColor\G,myColor\B))
LinearGradient(0,0,W,H)
Box(0,0,W,H)
;{ Dessin de la ligne du niveau
DrawingMode(#PB_2DDrawing_Default)
X=Unit * myColor\R
Box(X,0,2,H,RGB(0,0,0))
;}
StopDrawing()
GadgetToolTip(myForm\IdCanvasR,Str(myColor\R))
EndWith
EndProcedure
Procedure DrawGreen()
With myForm
Protected W=GadgetWidth(\IdCanvasG)
Protected H=GadgetHeight(\IdCanvasG)
Protected X,Y,D
Protected Unit=1
StartDrawing(CanvasOutput(\IdCanvasG))
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(RGB(myColor\R,0,myColor\B))
FrontColor(RGB(myColor\R,255,myColor\B))
LinearGradient(0,0,W,H)
Box(0,0,W,H)
;{ Dessin de la ligne du niveau
DrawingMode(#PB_2DDrawing_Default)
X=Unit * myColor\G
Box(X,0,2,H,RGB(0,0,0))
;}
StopDrawing()
GadgetToolTip(myForm\IdCanvasG,Str(myColor\G))
EndWith
EndProcedure
Procedure DrawBlue()
With myForm
Protected W=GadgetWidth(\IdCanvasB)
Protected H=GadgetHeight(\IdCanvasB)
Protected X,Y,D
Protected Unit=1
StartDrawing(CanvasOutput(\IdCanvasB))
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(RGB(myColor\R,myColor\G,0))
FrontColor(RGB(myColor\R,myColor\G,255))
LinearGradient(0,0,W,H)
Box(0,0,W,H)
;{ Dessin de la ligne du niveau
DrawingMode(#PB_2DDrawing_Default)
X=Unit * myColor\B
Box(X,0,2,H,RGB(0,0,0))
;}
StopDrawing()
GadgetToolTip(myForm\IdCanvasB,Str(myColor\B))
EndWith
EndProcedure
Procedure Draw()
DrawPreview()
If GetGadgetState(myForm\CheckAlpha)
DrawAlpha()
Else
DrawNoAlpha()
EndIf
DrawRed()
DrawGreen()
DrawBlue()
RefreshStatus()
EndProcedure
Procedure RefreshStatus()
With myColor
StatusBarText(myForm\IdSatusBar,0,"R: "+Str(\R))
StatusBarText(myForm\IdSatusBar,1,"G: "+Str(\G))
StatusBarText(myForm\IdSatusBar,2,"B: "+Str(\B))
If myForm\CheckAlpha
StatusBarText(myForm\IdSatusBar,3,"A: "+Str(\A))
Else
StatusBarText(myForm\IdSatusBar,3,"")
EndIf
EndWith
EndProcedure
Procedure Open(DefaultColor.q,*Callback)
Protected M=10,HC=30,HP=100,W=256,LW=20,HB=30
Protected WF=W+(M*3)+LW
Protected HF=(HC*5)+(M*8)+HB+HP+20
Protected Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu
Protected Title$="Sélection d'une couleur"
Protected X=M,Y=M,tmp
gMotherId=GetActiveWindow()
With myForm
If gMotherId=-1
\IdForm=OpenWindow(#PB_Any,0,0,WF,HF,Title$,Flag)
Else
DisableWindow(gMotherId,#True)
\IdForm=OpenWindow(#PB_Any,0,0,WF,HF,Title$,Flag,WindowID(gMotherId))
EndIf
BindEvent(#PB_Event_CloseWindow,@Close(),\IdForm)
mCanvas("R :" ,\IdCanvasR)
mCanvas("G :",\IdCanvasG)
mCanvas("B :",\IdCanvasB)
mCanvas2("Canal alpha :",\IdCanvasA)
Y+M
X+LW+M
\IdCanvasPreview=CanvasGadget(#PB_Any,X,Y,W,HP)
Y+HP+M
W=W/2-M
\IdSubmit=ButtonGadget(#PB_Any,X,Y,W,HB,"Valider")
SetGadgetFont(\IdSubmit,FontID(gFont))
BindGadgetEvent(\IdSubmit,@Submit())
X+W+M
\IdChancel=ButtonGadget(#PB_Any,X,Y,W,HB,"Annuler")
SetGadgetFont(\IdChancel,FontID(gFont))
BindGadgetEvent(\IdChancel,@Close())
\Callback=*Callback
\IdSatusBar=CreateStatusBar(#PB_Any,WindowID(\IdForm))
Protected WSB=WindowWidth(\IdForm)/4
AddStatusBarField(WSB)
AddStatusBarField(WSB)
AddStatusBarField(WSB)
AddStatusBarField(WSB)
EndWith
With myColor
\R=Red(DefaultColor)
\G=Green(DefaultColor)
\B=Blue(DefaultColor)
\A=Alpha(DefaultColor)
EndWith
Draw()
EndProcedure
EndModule
Steep 2 for testing, copy lthis code(31 lignes) save this, build this
Code: Select all
XIncludeFile "ColorManager.pbi"
Global Color.q
Procedure Exit()
End
EndProcedure
Procedure ReveiveColor(Value.q,AlphaChannel.b)
StartDrawing(CanvasOutput(1))
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,GadgetWidth(1),GadgetHeight(1),RGB(255,255,255))
If AlphaChannel=#True
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(0,0,GadgetWidth(1),GadgetHeight(1),Value)
Else
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,GadgetWidth(1),GadgetHeight(1),Value)
EndIf
StopDrawing()
Color=Value
EndProcedure
Procedure OpenColor()
clm::Open(Color,@ReveiveColor())
EndProcedure
OpenWindow(0,0,0,800,600,"teste",#PB_Window_Maximize|#PB_Window_SystemMenu)
CanvasGadget(1,50,50,400,400)
ButtonGadget(2,500,50,100,30,"Color")
BindGadgetEvent(2,@OpenColor())
BindEvent(#PB_Event_CloseWindow,@Exit(),0)
clm::Open($95AD5B79,@ReveiveColor())
Repeat
WaitWindowEvent()
ForEver