En ce dimanche mitigé, je m'amuse à faire un petit soft de remplacement de couleurs.
J'utilise 3 canvas.
J'ai cependant parfois un soucis sur les canvas #PALETTE et #CANVAS qui me sortent un Point() est en dehors de la zone de sélection.
Or j'ai pourtant un Flag OVERP qui est censé empêcher cela.
Le code n'est pas encore optimisé et des parties sont redondantes mais je ne vois pas pourquoi ce problème s'active (et parfois non).
1 - Charger une image
2 - Cliquer sur l'image du haut pour choisir une couleur à remplacer
3 - Cliquer sur une couleur de la palette.
Passez d'un canvas à l'autre assez rapidement
Code : Tout sélectionner
; Remplacement de couleurs.
; Ar-S
; V0.2 b290516
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
Enumeration
#WIN
#CANVAS
#APERCU
#PALETTE
#BT_LOAD
#AFF
#INFO
#iO
#iS
EndEnumeration
Global iO$, iS$, DimX, DimY, IM_OK, OVERCOLOR, OVERCOLORP, TXT_COL, TXT_COLP, SELEC_COL.b
Global LC = 557, HC = 250
#PAYSAGE = 1
#PORTRAIT = 2
#IDENTIQUE = 3
IM_OK = #False
Procedure LoadPic(Io, Is, chemin.s)
Protected iX, iY, MinL, MinH
If Not LoadImage(Io,chemin.s)
Debug "error"
ProcedureReturn 0
EndIf
Debug "image chargée"
DimL = ImageWidth(Io)
DimH = ImageHeight(Io)
CopyImage(Io, Is)
If DimL > DimH
FORMAT = #PAYSAGE
ElseIf DimL < DimH
FORMAT = #PORTRAIT
Else
FORMAT = #IDENTIQUE
EndIf
Select FORMAT
Case #PAYSAGE
Debug "paysage"
minL = LC
minH = DimH * LC / DimL
Ratio = DimL / LC
iX = 0
iY = HC/2 - DimH/2
Case #PORTRAIT
Debug "portrait"
iX = LC/2 - DimL/2
iY = 0
MinL = DimL * HC / DimH
MinH = HC
Ratio = DimH / HC
Case #IDENTIQUE
Debug "no change"
minL = DimL
minH = DimH
iX = LC/2 - DimL/2
iY = HC/2 - DimH/2
Ratio = 1
EndSelect
StartDrawing(CanvasOutput(#CANVAS))
Box(0,0,LC,HC,$FFFFFF)
DrawImage(ImageID(Io),iX, iY, MinL, MinH)
StopDrawing()
StartDrawing(CanvasOutput(#APERCU))
Box(0,0,LC,HC,$FFFFFF)
DrawImage(ImageID(Is),iX, iY, MinL, MinH)
StopDrawing()
; Dim TabPixel(DimL-1,DimH-1)
; Stock(TabPixel(), DimL, DimH, Is)
ProcedureReturn 1
EndProcedure
Procedure CreatePalette()
Protected x, y = 0
StartDrawing(CanvasOutput(#PALETTE))
For x = 0 To 255
Box(x,y,1,7,RGB(0,0,i))
Box(x,7,1,7,RGB(0,i,i))
Box(x,14,1,7,RGB(i,i,i))
Box(x,21,1,7,RGB(i,i,0))
Box(x,28,1,7,RGB(i,0,0))
Box(x,35,1,7,RGB(i,0,i))
Box(x,40,1,7,RGB(0,i,0))
i+1
Next
Box(0,47,127,3,$FFFFFF)
Box(128,47,127,3,$0)
StopDrawing()
EndProcedure
Procedure.s OuvreImage()
FichierParDefaut$ = "C:\"
Filtre$ = "Image|*.png;*.jpg"
Filtre = 0 ; utiliser par défaut le premier des trois filtres possibles
Fichier$ = OpenFileRequester("Choisissez une image à charger", FichierParDefaut$, Filtre$, Filtre)
If Fichier$
ProcedureReturn Fichier$
Else
MessageRequester("Information", "La sélection a été annulée.", 0)
ProcedureReturn "error"
EndIf
EndProcedure
If OpenWindow(#WIN, 0, 0, LC, 600, "Changer couleur", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(#CANVAS, 0, 0, LC, HC)
CanvasGadget(#APERCU, 0, 321, LC, HC)
CanvasGadget(#PALETTE, 301, 251, 255, 50)
CreatePalette()
ButtonGadget(#BT_LOAD,1,251,299,48,"Charger une image")
StringGadget(#AFF,0,300,299,20,"Veuillez charger une image",#PB_String_ReadOnly|#ES_CENTER)
StringGadget(#INFO,300,300,256,20,"Bienvenue",#PB_String_ReadOnly|#ES_CENTER)
SetWindowColor(#win,$0)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
;- CANVAS 1
Case #CANVAS
If IM_OK = #True
If StartDrawing(CanvasOutput(#CANVAS))
Select EventType()
Case #PB_EventType_MouseEnter
OVER = 1
SetGadgetAttribute(#canvas,#PB_Canvas_Cursor,#PB_Cursor_Cross)
Case #PB_EventType_MouseMove
x = GetGadgetAttribute(#CANVAS, #PB_Canvas_MouseX)
y = GetGadgetAttribute(#CANVAS, #PB_Canvas_MouseY)
If OVER = 1 And SELEC_COL = #False
OVERCOLOR = Point(x,y)
R$ = Str( Red (OVERCOLOR) )
V$ = Str( Green(OVERCOLOR) )
B$ = Str( Blue (OVERCOLOR) )
If SELEC_COL = #False
SetGadgetText(#AFF,"Couleur survolée : RGB(" + R$ + "," + V$ + "," + B$ + ")")
SetGadgetColor(#AFF,#PB_Gadget_BackColor,OVERCOLOR)
If Val(R$) + Val(V$) + Val(B$) < 3*112
TXT_COL = $FFFFFF
Else
TXT_COL = $0
EndIf
SetGadgetColor(#AFF,#PB_Gadget_FrontColor,TXT_COL)
EndIf
EndIf
Case #PB_EventType_MouseLeave
SetGadgetAttribute(#canvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
OVER = 0
Case #PB_EventType_LeftClick
SELEC_COL = #True
COL = Point(x,y)
R$ = Str( Red (COL) )
V$ = Str( Green(COL) )
B$ = Str( Blue (COL) )
SetGadgetText(#AFF,"Couleur à remplacer : RGB(" + R$ + "," + V$ + "," + B$ + ")")
SetGadgetText(#info,"Choissez dans la palette la couleur de remplacement")
Case #PB_EventType_RightClick
SELEC_COL = #False
SetGadgetText(#AFF,"Couleur survolée : RGB(" + R$ + "," + V$ + "," + B$ + ")")
EndSelect
; StopDrawing()
EndIf
StopDrawing()
EndIf
Case #PALETTE;- PALETTE
If IM_OK = #True
If StartDrawing(CanvasOutput(#PALETTE))
x = GetGadgetAttribute(#PALETTE, #PB_Canvas_MouseX)
y = GetGadgetAttribute(#PALETTE, #PB_Canvas_MouseY)
Select EventType()
Case #PB_EventType_MouseEnter
OVERP = 1
SetGadgetAttribute(#PALETTE,#PB_Canvas_Cursor,#PB_Cursor_Cross)
Case #PB_EventType_MouseLeave
SetGadgetAttribute(#PALETTE,#PB_Canvas_Cursor,#PB_Cursor_Default)
OVERP = 0
Case #PB_EventType_MouseMove
If OVERP = 1 And SELEC_COL = #True
OVERCOLORP = Point(x,y)
SetGadgetColor(#INFO,#PB_Gadget_BackColor,OVERCOLORP)
RP$ = Str( Red (OVERCOLORP) )
VP$ = Str( Green(OVERCOLORP) )
BP$ = Str( Blue (OVERCOLORP) )
If Val(RP$) + Val(VP$) + Val(BP$) < 3*112
TXT_COLP = $FFFFFF
Else
TXT_COLP = $0
EndIf
SetGadgetColor(#info,#PB_Gadget_FrontColor,TXT_COLP)
EndIf
Case #PB_EventType_LeftClick
SELEC_COL = #True
COLP = Point(x,y)
SetGadgetText(#Info,"Aperçu en cours")
EndSelect
StopDrawing()
EndIf
EndIf
Case #BT_LOAD
F$ = OuvreImage()
If F$ <> "error"
LoadPic(#iO, #iS, F$)
IM_OK = #True
Else
IM_OK = #False
EndIf
EndSelect
EndIf
Delay(1)
Until Event = #PB_Event_CloseWindow
EndIf
