Sources PureBasic
Sources PureBasicConsultez toutes les sources
Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011
Sommaire→Images- Affichage d'un texte sur toute la diagonale d'une image
- Déformation d'une image
- Quelques exemples d'utilisation de la fonction CustomFilterCallback()
- Démo : Contour d'un texte dans une image, avec de très jolis effets.
- Codage informatique des couleurs : RGB, CMY, HLS, HSL (HLS, HSI)
- Lotus démo , ou un nouvel exemple avec CustomFilterCallback()
- Réaliser une interface de type 'Cover Flow'
Pour les besoins d'un éditeur srod avait besoin d'inscrire un texte en lieu et place d'une image qui ne serait pas définie, etc.
Le texte est calculé de façon à occuper la diagonale de l'image manquante.
Sélectionnez
;Based on code by Bluid-fyte.
text$ = "NO IMAGE DEFINED!"
If OpenWindow(0, 0, 0, 600, 600, "",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
;Create an EMF to house the text.
hdc = CreateEnhMetaFile_(0, 0, 0, 0)
If hdc
oldBrush = SelectObject_(hdc, GetStockObject_(#NULL_BRUSH))
oldPen = SelectObject_(hdc, GetStockObject_(#WHITE_PEN))
SetBkMode_(hdc, #TRANSPARENT)
hFont = CreateFont_(100,55,450,0.0,0,0,0,0,0,0,0,0,0,"ARIAL")
oldFont = SelectObject_(hdc, hFont)
SetTextAlign_(hdc, #TA_LEFT|#TA_BOTTOM)
BeginPath_(hdc)
TextOut_(hdc, 70, 510,text$, Len(text$))
EndPath_(hdc)
SelectObject_(hdc, oldFont)
DeleteObject_(hFont)
StrokeAndFillPath_(hdc)
SelectObject_(hdc, oldPen)
SelectObject_(hdc, oldBrush)
hEMF = CloseEnhMetaFile_(hdc)
EndIf
width = WindowWidth(0)
height = WindowHeight(0)
;Now an image gadget etc.
If CreateImage(1, width, height, 24)
hdc = StartDrawing(ImageOutput(1))
If hdc
SetRect_(rc.RECT, 0, 0, width,height)
PlayEnhMetaFile_(hdc, hEMF, rc)
StopDrawing()
ImageGadget(1, 0,0,0,0,ImageID(1))
EndIf
EndIf
Repeat
EventID = WaitWindowEvent()
Until EventID = #PB_Event_CloseWindow
DeleteEnhMetaFile_(hEMF)
EndIfCréé le 15 mars 2009 par srod
Ce code permet de déformer une image.
Sélectionnez
;"Image Rotate, Pull, Reverse & Stretch"
Structure PointF : X.f : Y.f : EndStructure
Structure FLEX
pt.POINT
Plg.POINT[4]
Vertx.POINT[4]
s1.f[4]
S2.PointF[4]
EndStructure
Global __Clip ,__Hatch,__Rim
Global _Brush,_BrushRGB,_BrushStyle
Global _DRAWING,_Grid,_Mode
Global _MyFont10=FontID(LoadFont(-1,"Arial",10))
Global _OldBrush,_Pen,_PenRGB,_PenStyle,_ShowCornerNumbers=1,_Showflag=1
Global _X,_Xmax,_Xmin,_Y,_Ymax,_Ymin
Global Dim Color(0, 0)
Global Dim Grid.POINT(0, 0)
Global _Flex.FLEX
Title$ = "Image Rotate, Pull, Reverse & Stretch"
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
#DBLUE=$660000
#LBLUE=$FFFCC2
Enumeration
#ImGad
#IMG
#IMG2
#Open
#SaveAs
#CornerNumbers
#Quit
#HorVer
#Diag
#Grid
#GridIMG
EndEnumeration
Macro MMx : WindowMouseX(EventWindow()) : EndMacro
Macro MMy : WindowMouseY(EventWindow()) : EndMacro
Macro MMK
Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
EndMacro
Macro MouseOverGad ;- MouseOverGad : ret GadgetID under mouse
WindowFromPoint_(MMx|MMy<<32)
EndMacro
Macro LoBound(A,B) : If A<B :A=B:EndIf : EndMacro
Macro HiBound(A,B) : If A>B :A=B:EndIf : EndMacro
Procedure InMousEX(X,Y,X1,Y1)
SetRect_(rc.RECT,X,Y,X1,Y1)
ProcedureReturn PtInRect_(@rc,MMx|MMy<<32)
EndProcedure
Procedure EndClip() ;- EndClip
SelectClipRgn_(_DRAWING, 0)
DeleteObject_(__Clip)
EndProcedure
Procedure Clip(X,Y,X1,Y1) ;- Clip(X,Y,X1,Y1)
If __Clip:EndClip():EndIf
__Clip = CreateRectRgn_(X,Y,X1,Y1)
If __Clip : SelectClipRgn_(_DRAWING, __Clip)
Else : __Clip=0
EndIf
EndProcedure
Macro STOPDRAW ;- StopDraw
If _DRAWING
StopDrawing() : _DRAWING=0: EndIf
EndMacro
Macro DrawIMG(IMG) ;- DrawIMG(IMG) ; #ImageOutput=2
STOPDRAW
_DRAWING=StartDrawing(ImageOutput(IMG)) ;<
EndMacro
Procedure Min(A,B)
If A<B:ProcedureReturn A:EndIf
ProcedureReturn B
EndProcedure
Procedure ClsImg(IMG,RGB=0) ;-ClsImg(IMG,RGB=0)
DrawIMG(IMG)
Box(0,0,ImageWidth(IMG),ImageHeight(IMG),RGB)
EndProcedure
Macro DelBrush() ;-DelBrush()
If _Brush :DeleteObject_(_Brush) :EndIf
_Brush=0
If _OldBrush : SelectObject_(_DRAWING, _OldBrush) : EndIf
_BrushRGB=0
EndMacro
Procedure Brush(BrushRGB,style=#BS_SOLID,Hatch=0) ;- Brush(BrushRGB,Style=#BS_SOLID,Hatch=0) #BS_HOLLOW, #BS_PATTERN
Protected L.LOGBRUSH
DelBrush()
L\lbStyle=style
L\lbColor=BrushRGB
L\lbHatch=Hatch
_Brush = CreateBrushIndirect_(@L)
_OldBrush=SelectObject_(_DRAWING,_Brush)
_BrushRGB=BrushRGB
_BrushStyle=style
__Hatch=Hatch
EndProcedure
Macro DelPen() ;- DelPen
If _Pen: DeleteObject_(_Pen) :EndIf
_Pen=0: _PenRGB=0:__Rim=0
EndMacro
Macro Pen(Rim=1, PenRGB=0,style=#PS_SOLID) ;- Pen(Rim=1, PenRGB=0,style=#ps_solid)
DelPen()
If style=#NULL_PEN
_Pen= SelectObject_(_DRAWING,GetStockObject_ ( #NULL_PEN ))
Else
_Pen=CreatePen_(style,Rim,PenRGB)
SelectObject_(_DRAWING,_Pen)
EndIf
__Rim=Rim
_PenRGB=PenRGB
_PenStyle=style
EndMacro
Procedure CenterTXT(X,Y,Wi,He,T.S)
Protected TextWidth=TextWidth(T),TextHeight=TextHeight(T)
Protected X1=X+Wi,Y1=Y+He
Clip(X,Y,X1,Y1)
If TextWidth>Wi : DrawText(X,(Y+Y1)/2-TextHeight/2 , T)
Else : DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , T)
EndIf
EndClip()
EndProcedure
Procedure Corners() ;- draw corners
Protected i
With _Flex
DrawingFont(_MyFont10)
FrontColor(#LBLUE):BackColor(#DBLUE)
For i = 0 To 3
Circle (\Vertx[i]\X , \Vertx[i]\Y, 9,#DBLUE)
CenterTXT(\Vertx[i]\X-5,\Vertx[i]\Y-5,10,10,Str(i))
Next
EndWith
EndProcedure
Procedure Bounding() ;- Bounding()
Protected i
With _Flex
_Xmax=0 : _Xmin=$FFFFFF:_Ymax=0:_Ymin=$FFFFFF
For i = 0 To 3
HiBound(_Xmin,\Vertx[i]\X)
LoBound(_Xmax,\Vertx[i]\X)
HiBound(_Ymin,\Vertx[i]\Y)
LoBound(_Ymax,\Vertx[i]\Y)
Next
EndWith
EndProcedure
Procedure STP(A,B,C,D,E) ;- STP(A,B,C,D,E) - aux de Sizes
With _Flex
\s1[0] = (\S2[A]\X - \S2[B]\X) / E
\s1[1] = (_Flex\Vertx[C]\X - _Flex\Vertx[D]\X) / E
\s1[2] = (\S2[A]\Y - \S2[B]\Y) / E
\s1[3] = (_Flex\Vertx[C]\Y - _Flex\Vertx[D]\Y) / E
EndWith
EndProcedure
Procedure Sizes()
Protected i,j,A.f,B.f,C.f,D.f
With _Flex
; _Xmax = 0 : _Xmin = _X : _Ymax = 0 : _Ymin = _Y
Bounding()
\S2[0]\X = (\Vertx[1]\X - \Vertx[0]\X) / \pt\X ; step X HOR TOP
\S2[0]\Y = (\Vertx[1]\Y - \Vertx[0]\Y) / \pt\X ; step Y HOR TOP
\S2[1]\X = (\Vertx[2]\X - \Vertx[3]\X) / \pt\X ; step X HOR BOTTOM
\S2[1]\Y = (\Vertx[2]\Y - \Vertx[3]\Y) / \pt\X ; step Y HOR BOTTOM
\S2[2]\X = (\Vertx[3]\X - \Vertx[0]\X) / \pt\Y ; step X VER LEFT
\S2[2]\Y = (\Vertx[3]\Y - \Vertx[0]\Y) / \pt\Y ; step Y VER LEFT
\S2[3]\X = (\Vertx[2]\X - \Vertx[1]\X) / \pt\Y ; step X VER RIGHT
\S2[3]\Y = (\Vertx[2]\Y - \Vertx[1]\Y) / \pt\Y ; step Y VER RIGHT
STP(1,0,3,0,\pt\Y)
For j = 0 To \pt\Y
A=\S2[0]\X +\s1[0]*j
B=\Vertx[0]\X +\s1[1]*j
C=\S2[0]\Y +\s1[2]*j
D=\Vertx[0]\Y +\s1[3]*j
For i = 0 To \pt\X
Grid(i,j)\X=A*i+B
Grid(i,j)\Y=C*i+D
Next
Next
STP(3,2,1,0,\pt\X)
For j = 0 To \pt\X
A=\S2[2]\X +\s1[0]*j
B=\Vertx[0]\X +\s1[1]*j
C=\S2[2]\Y +\s1[2]*j
D=\Vertx[0]\Y +\s1[3]*j
For i = 1 To \pt\Y
Grid(j,i)\X=A*i+B
Grid(j,i)\Y=C*i+D
Next
Next
EndWith
EndProcedure
Procedure FastGrid(Wi,He,StpX=24,StpY=-1,RGB=-1)
If StpY=-1:StpY=StpX:EndIf
If RGB=-1:RGB=$555555:EndIf
For Y=0 To He
LineXY(0,Y,Wi,Y,RGB)
Y+StpY
Next
For X=0 To Wi
LineXY(X,0,X,He,RGB)
X+StpX
Next
EndProcedure
Macro InitGrid() ;- InitGrid()
CreateImage(#GridIMG,_X,_Y)
DrawIMG(#GridIMG)
FastGrid(_X,_Y,30,30)
STOPDRAW
EndMacro
Procedure FastImage() ;- Faster than ShowImage - ONLY POINTS to circumvent the Polygon drawing
Static i,j,STP
With _Flex
If _Grid
FreeImage(#IMG)
GrabImage(#GridIMG,#IMG,0,0,_X,_Y)
DrawIMG(#IMG)
Else
DrawIMG(#IMG)
ClsImg(#IMG)
EndIf
If _ShowCornerNumbers : Corners() : EndIf
STP=\pt\X/120 ; LONGER STP = QUICKER DRAWING
LoBound(STP,1)
i=0
Repeat ; Increase Stp for slow processor
j=0
Repeat
Box(Grid(i, j)\X, Grid(i, j)\Y,1,1, Color(i, j))
j+STP
Until j>=\pt\Y
i+STP
Until i>=\pt\X
STOPDRAW
SetGadgetState(#ImGad, ImageID(#IMG))
EndWith
EndProcedure
Procedure Polyg( Sides,*P,RGB=-1) ;P= array of POINT struc with polyg vertices ; sides >1
If RGB>-1
Pen(1,RGB):Brush(RGB)
EndIf
Polygon_(_DRAWING,*P,Sides)
EndProcedure
Procedure ShowImage()
Protected i,j,i2,j2
With _Flex
If _Grid
FreeImage(#IMG)
GrabImage(#GridIMG,#IMG,0,0,_X,_Y)
DrawIMG(#IMG)
Else
DrawIMG(#IMG)
ClsImg(#IMG,0)
EndIf
If _ShowCornerNumbers : Corners() : EndIf
For i = 0 To \pt\X
DrawIMG(#IMG)
If MMK = 1 : _Showflag=0: ProcedureReturn : EndIf ; show interruptus
i2=i+1
WindowEvent()
For j = 0 To \pt\Y
If j < \pt\Y And i < \pt\X
j2=j+1
\Plg[0]\X = Grid(i ,j )\X ; Polygon positions
\Plg[0]\Y = Grid(i ,j )\Y
\Plg[1]\X = Grid(i2,j )\X
\Plg[1]\Y = Grid(i2,j )\Y
\Plg[2]\X = Grid(i2,j2)\X
\Plg[2]\Y = Grid(i2,j2)\Y
\Plg[3]\X = Grid(i ,j2)\X
\Plg[3]\Y = Grid(i ,j2)\Y
Pen(1,Color(i,j)):Brush(Color(i,j))
Polyg(4,\Plg[0])
Else
Plot(Grid(i,j)\X, Grid(i,j)\Y, Color(i,j)) ; only 1 pixel for the last line
EndIf
Next
If _ShowCornerNumbers : Corners() : EndIf
STOPDRAW
SetGadgetState(#ImGad,ImageID(#IMG))
Next
EndWith
EndProcedure
Procedure SaveImg(DefaultFile$="",Title.S="Save Image") ; Save Image
Protected Flag, Pattern$ = "(*.bmp)|*.bmp|"
Pattern$ + "(*.jpg)|*.jpg|"
Pattern$ + "(*.png)|*.png|"
File$=SaveFileRequester("Please Choose The File Name To Save", DefaultFile$, Pattern$, 0)
If File$
If _ShowCornerNumbers
Flag=1
_ShowCornerNumbers = 0
EndIf
If _Grid
Flag+2
_Grid=0
EndIf
If Flag : ShowImage() : EndIf
Select SelectedFilePattern()
Case 0 : SaveImage(#IMG,File$,#PB_ImagePlugin_BMP)
Case 1 : SaveImage(#IMG,File$,#PB_ImagePlugin_JPEG,10)
Case 2 : SaveImage(#IMG,File$,#PB_ImagePlugin_PNG)
EndSelect
MessageRequester("","Saved to "+File$, #PB_MessageRequester_Ok)
Else
MessageRequester("","File Not Saved", #PB_MessageRequester_Ok)
EndIf
If Flag=1 Or Flag=3:_ShowCornerNumbers=1:EndIf
If Flag=2 Or Flag=3:_Grid=1:EndIf
If Flag:ShowImage():EndIf
EndProcedure
Procedure$ GetLastDir(LastDirFile.S)
Protected Temp= ReadFile(-1,GetTemporaryDirectory()+LastDirFile)
If Temp
LastDir.S=ReadString(Temp)
CloseFile(Temp)
EndIf
ProcedureReturn LastDir.S
EndProcedure
Procedure SetLastDir(LastDirFile.S,LastDir.S) ;-SetLastDir - pone en TempDir
Protected Temp
DeleteFile(GetTemporaryDirectory()+LastDirFile)
Temp=OpenFile(-1,GetTemporaryDirectory()+LastDirFile)
If Temp
WriteString(Temp,LastDir)
CloseFile(Temp)
EndIf
EndProcedure
Procedure LeeImg(*P.POINT)
Protected StandardFile$
Static IMG,hIMG
If IsImage(IMG):FreeImage(IMG):EndIf
If hIMG:DeleteDC_(hIMG):EndIf
LastDirFile.S="EstiraLast"
Pattern$ = "Images (*.bmp, *.jpg, *.png, *.tiff, *.tga)|*.bmp;*.jpg; *.png; *.tiff ; *.tga |All files (*.*)|*.*"
StandardFile$=GetLastDir(LastDirFile)
If StandardFile$=""
StandardFile$ = "c:\" ; put here your image directory
EndIf
File$ = OpenFileRequester("Load Image", StandardFile$, Pattern$, Pattern)
If File$
StandardFile$=GetPathPart(File$)
SetLastDir(LastDirFile,StandardFile$)
hIMG = CreateCompatibleDC_(GetDC_(WindowID(0)))
IMG = LoadImage(#PB_Any, File$, #PB_Image_DisplayFormat)
If ImageWidth(IMG)>_X
ResizeImage(IMG,_X,ImageHeight(IMG))
EndIf
If ImageHeight(IMG)>_Y
ResizeImage(IMG,ImageWidth(IMG),_Y)
EndIf
*P\X=ImageWidth(IMG):*P\Y=ImageHeight(IMG)
SelectObject_(hIMG, ImageID(IMG))
ProcedureReturn hIMG
EndIf
EndProcedure
Procedure Menu(Win=0) ;- Menu(win)
Protected Menu= CreateMenu(-1, WindowID(Win))
MenuTitle(" File")
MenuItem(#Open,"Open ")
MenuBar()
MenuItem(#SaveAs,"Save As")
MenuBar()
MenuItem(#Quit,"Quit")
MenuTitle(" Options")
MenuItem( #CornerNumbers, "Switch Corner Numbers")
MenuBar()
MenuItem(#Grid,"Switch Grid")
ProcedureReturn Menu
EndProcedure
Procedure NewImage()
Protected hIMG = LeeImg(@P.POINT) ,X,Y,CenterX,CenterYsz
With _Flex
If hIMG
\pt\X = P\X - 1 : \pt\Y = P\Y - 1
Global Dim Color(\pt\X, \pt\Y)
Global Dim Grid.POINT (\pt\X, \pt\Y )
For X = 0 To \pt\X
For Y = 0 To \pt\Y
Color(X, Y) = GetPixel_(hIMG, X, Y)
Next
Next
CenterX=_X/2:CenterY=_Y/2
SZ=Min(_X,_Y)/10
\Vertx[0]\X = CenterX-SZ
\Vertx[0]\Y = CenterY-SZ
\Vertx[1]\X = CenterX+SZ
\Vertx[1]\Y = CenterY-SZ
\Vertx[2]\X = CenterX+SZ
\Vertx[2]\Y = CenterY+SZ
\Vertx[3]\X = CenterX-SZ
\Vertx[3]\Y = CenterY+SZ
Sizes() : ShowImage()
EndIf
EndWith
EndProcedure
Procedure GetDistance(A1,A2) ;- GetDistance(a1,a2)
ProcedureReturn Sqr(A1*A1 + A2*A2)
EndProcedure
Procedure Near(X,Y); X, Y, ArrSize, ARRAY P.POINT(1)) ; Return elem de Array de Points Nearest to x,y
Protected A,i,min
With _Flex
min = $FFFFFFF
For i = 0 To 3
A = GetDistance(X - \Vertx[i]\X, Y - \Vertx[i]\Y)
If A < min : min = A : Near = i : EndIf
Next i
ProcedureReturn Near
EndWith
EndProcedure
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If OpenWindow(0, 100, 100,600,400,Title$, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
SetWindowColor(0,0)
StickyWindow(0,1)
_X=WindowWidth(0):_Y=WindowHeight(0)
Menu()
CreateImage(#IMG, _X,_Y,32)
ImageGadget(#ImGad,0,0,0,0,ImageID(#IMG))
SetWindowLongPtr_(GadgetID(#ImGad), -20, GetWindowLongPtr_(GadgetID(#ImGad), -20) | $2000000)
InitGrid() : NewImage()
With _Flex
Repeat
If GetAsyncKeyState_(#VK_ESCAPE) : End:EndIf
Ev = WaitWindowEvent(1)
Select Ev
Case #PB_Event_Menu
Select EventMenu() ; To see which menu has been selected
Case #Quit : End
Case #Open :NewImage()
Case #SaveAs:SaveImg()
Case #CornerNumbers ; switch corner numbers
_ShowCornerNumbers = 1 -_ShowCornerNumbers
ShowImage()
Case #Grid
_Grid=1-_Grid
ShowImage()
EndSelect
Case #PB_Event_SizeWindow
_X=WindowWidth(0):_Y=WindowHeight(0)
ShowImage()
Default
If Ev=#WM_MOUSEMOVE
If MMK = 1
If InMousEX(1,1,_X-4,_Y-4)
If Sel = 0
Near = Near(MMx,MMy)
Sel = 1
EndIf
_Showflag = 0
\Vertx[Near]\X = MMx
\Vertx[Near]\Y = MMy
Sizes() : FastImage()
EndIf
EndIf
EndIf
If MMK=0
If _Showflag = 0 : _Showflag = 1 : ShowImage() : EndIf
Sel = 0
EndIf
EndSelect
Until Ev = #PB_Event_CloseWindow
EndWith
EndIf
EndCréé le 29 mars 2009 par einander
Le code qui suit comporte 2 exemples avec la fonction CustomFilterCallback(),
l'appel se fait aux lignes 65, 66 :
- ;NoiseFilter() ; Supprimez le commentaire pour tester cette fonction
- PixelFilter() ; mettez cette ligne en commentaire pour tester la fonction ci dessus.
Le premier code est complet et permet de tester les 2 premiers effets, plus bas
vous trouverez d'autres effets sous forme d'une procédure uniquement,
vous pourrez prendre modèle sur le premier code pour les utiliser.
Sélectionnez
UsePNGImageDecoder()
Procedure NoiseFilterCallback(x, y, SourceColor, TargetColor)
If (x+y)%5=0
ProcedureReturn TargetColor
EndIf
xn=x-1+Random(2)
yn=y-1+Random(2)
If xn<0 Or xn>=OutputWidth() Or yn<0 Or yn>=OutputHeight()
ProcedureReturn TargetColor
EndIf
ProcedureReturn Point(xn, yn)
EndProcedure
Procedure NoiseFilter()
CustomFilterCallback(@NoiseFilterCallback())
EndProcedure
Procedure PixelFilterCallback(x, y, SourceColor, TargetColor)
#pixelSize=5
xn=#pixelSize*(x/#pixelSize)
yn=#pixelSize*(y/#pixelSize)
ProcedureReturn Point(xn, yn)
EndProcedure
Procedure PixelFilter()
CustomFilterCallback(@PixelFilterCallback())
EndProcedure
If OpenWindow(0, 0, 0, 800, 600, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
; load purebasic logo
CatchImage(100, ?TestImage)
; background layer
If CreateImage(0, 800, 600, 32) And StartDrawing(ImageOutput(0))
#box_size=7
Box(0, 0, 800, 600, $FFFFFF)
For y=0 To 600 Step #box_size*2
For x=0 To 800 Step #box_size*2
Box(x, y, #box_size, #box_size, $C0C0C0)
Box(x+#box_size, y+#box_size, #box_size, #box_size, $C0C0C0)
Next
Next
; draw logo image
For i=1 To 60
DrawAlphaImage(ImageID(100), Random(800), Random(600))
Next
StopDrawing()
EndIf
; drawing layer
CreateImage(1, 800, 600, 32)
SmartWindowRefresh(0, 1)
ImageGadget(1, 0, 0, 0, 0, ImageID(1))
Repeat
e=WaitWindowEvent(0)
If e=#PB_Event_ActivateWindow Or e=#WM_MOUSEMOVE
StartDrawing(ImageOutput(1))
; draw background
DrawImage(ImageID(0), 0, 0)
; draw gradient filter
DrawingMode(#PB_2DDrawing_CustomFilter)
;NoiseFilter()
PixelFilter()
Circle(WindowMouseX(0), WindowMouseY(0), 100)
StopDrawing()
SetGadgetState(1, ImageID(1))
EndIf
Until e=#PB_Event_CloseWindow
EndIf
DataSection
TestImage :
Data.b $89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52
Data.b $00, $00, $00, $30, $00, $00, $00, $30, $08, $06, $00, $00, $00, $57, $02, $F9
Data.b $87, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $1C, $20, $00, $00, $1C
Data.b $20, $01, $CD, $0F, $9B, $9E, $00, $00, $00, $07, $74, $49, $4D, $45, $07, $D6
Data.b $0C, $1C, $15, $17, $0D, $B6, $53, $C9, $04, $00, $00, $0C, $9C, $49, $44, $41
Data.b $54, $68, $DE, $D5, $99, $79, $8C, $5D, $D7, $5D, $C7, $3F, $E7, $9C, $7B, $EF
Data.b $5B, $E6, $BD, $D9, $17, $CF, $E2, $78, $A9, $27, $09, $B6, $A2, $26, $71, $90
Data.b $93, $8A, $2C, $60, $D2, $02, $6D, $54, $94, $96, $48, $24, $6D, $11, $55, $55
Data.b $05, $A5, $40, $25, $4A, $04, $52, $A1, $82, $06, $A9, $8A, $10, $02, $A1, $A6
Data.b $34, $40, $45, $CB, $2A, $0A, $51, $A0, $B4, $84, $2C, $4E, $52, $E3, $6C, $B6
Data.b $C7, $F6, $64, $C6, $19, $7B, $16, $8F, $67, $5F, $DF, $BE, $DF, $77, $CF, $E1
Data.b $8F, $7B, $66, $3C, $36, $89, $ED, $B1, $C7, $48, $1C, $E9, $E8, $5E, $DD, $27
Data.b $BD, $FB, $FB, $9E, $DF, $F6, $FD, $FE, $AE, $62, $8B, $56, $4B, $3C, $2A, $9E
Data.b $79, $F4, $A1, $96, $87, $F6, $DF, $D6, $11, $53, $2A, $32, $B6, $94, $52, $81
Data.b $D6, $0E, $A0, $00, $B9, $61, $0B, $BB, $B9, $E4, $FE, $9A, $96, $D8, $22, $FB
Data.b $C5, $F4, $23, $0F, $7E, $B9, $51, $D7, $FF, $D8, $F1, $5C, $29, $1C, $15, $18
Data.b $29, $2B, $06, $72, $46, $90, $D1, $82, $4C, $A0, $C9, $D4, $B5, $49, $D7, $11
Data.b $E9, $BA, $54, $99, $9A, $A3, $D2, $15, $A9, $D2, $45, $44, $2A, $A7, $4D, $7A
Data.b $36, $5F, $4A, $1D, $3E, $37, $93, $7E, $73, $72, $B6, $70, $66, $25, $E5, $07
Data.b $DA, $68, $60, $6D, $07, $F6, $7A, $63, $00, $9C, $79, $E2, $D1, $9B, $55, $A6
Data.b $30, $50, $74, $DD, $06, $E3, $07, $18, $BF, $8E, $30, $06, $61, $C0, $51, $02
Data.b $E5, $39, $38, $9E, $83, $F2, $5C, $1C, $C7, $C5, $95, $02, $19, $F8, $50, $2E
Data.b $41, $AD, $82, $10, $E0, $7A, $11, $94, $E7, $82, $52, $B5, $74, $AE, $58, $D0
Data.b $F9, $6A, $26, $55, $F5, $8F, $DC, $F9, $C3, $D7, $9E, $06, $E6, $81, $8C, $05
Data.b $72, $D1, $72, $AE, $D7, $F8, $87, $6F, $DE, $A1, $A2, $E9, $FC, $B7, $A7, $CF
Data.b $4F, $37, $68, $40, $1B, $83, $36, $60, $08, $37, $F6, $AA, $0D, $04, $1A, $02
Data.b $6D, $D0, $08, $94, $1B, $C5, $69, $6A, $C2, $69, $6C, $42, $7A, $1E, $A2, $0A
Data.b $C2, $57, $4C, $8D, $0C, $7A, $1D, $41, $AD, $75, $5F, $57, $57, $FC, $E1, $D7
Data.b $DE, $01, $B8, $17, $78, $1D, $28, $DC, $10, $00, $7F, $76, $FF, $81, $2F, $2E
Data.b $9C, $9D, $78, $C0, $6C, $74, $AB, $00, $63, $42, $F7, $5E, $78, $6E, $C2, $80
Data.b $17, $20, $8D, $41, $FB, $15, $AA, $2B, $15, $CA, $2B, $4B, $61, $6C, $08, $45
Data.b $C1, $D4, $89, $F9, $25, $F6, $DF, $B4, $DD, $FC, $C2, $91, $E3, $E9, $C9, $62
Data.b $69, $9B, $B5, $B1, $F6, $7E, $C6, $63, $93, $EA, $9A, $D7, $D0, $AF, $3D, $BA
Data.b $33, $37, $B3, $F0, $8D, $AA, $EF, $83, $31, $18, $13, $9A, $6B, $36, $A2, $31
Data.b $1B, $1E, $08, $90, $02, $A4, $B4, $5B, $80, $14, $06, $25, $C0, $77, $14, $54
Data.b $0A, $3C, $B0, $BD, $8F, $2F, $9D, $1A, $C9, $1F, $4B, $65, $97, $80, $53, $C0
Data.b $00, $B0, $B8, $E5, $00, $6E, $EF, $68, $91, $D1, $E5, $D4, $B7, $B2, $D9, $6C
Data.b $23, $18, $CC, $DA, $59, $6F, $30, $DE, $98, $0D, $BF, $58, $8F, $20, $D6, $C2
Data.b $CB, $80, $08, $EF, $44, $43, $92, $62, $6E, $85, $7B, $BB, $B7, $F1, $17, $E7
Data.b $E7, $4A, $FF, $3C, $35, $37, $0F, $BC, $03, $BC, $0C, $BC, $07, $14, $2F, $FE
Data.b $E7, $2D, $00, $F0, $DC, $CF, $3F, $F0, $B9, $D4, $C2, $E2, $CF, $69, $63, $42
Data.b $43, $0D, $18, $63, $CD, $5D, $F7, $C6, $C5, $EF, $34, $EF, $03, $D0, $4D, $B6
Data.b $B0, $9C, $5A, $E4, $F6, $D6, $56, $4E, $94, $AB, $B5, $AF, $0D, $9D, $59, $02
Data.b $4E, $00, $2F, $59, $0F, $64, $3F, $A8, $02, $61, $6B, $F4, $A6, $D7, $C0, $AF
Data.b $7E, $AA, $A7, $3E, $33, $FF, $7C, $B1, $52, $89, $E9, $75, $E3, $2F, $24, $EE
Data.b $7A, $F2, $1A, $61, $3D, $20, $2C, $B0, $8B, $81, $44, $92, $CD, $2C, $66, $D3
Data.b $EC, $F0, $1C, $62, $8D, $8D, $C1, $27, $0F, $1F, $5D, $AE, $69, $3D, $08, $FC
Data.b $27, $F0, $DF, $36, $74, $EA, $97, $B3, $65, $D3, $49, $BC, $2D, $1E, $95, $0D
Data.b $CB, $A9, $3F, $9F, $CF, $64, $5B, $EB, $DA, $86, $87, $14, $08, $21, $C2, $E4
Data.b $15, $62, $3D, $65, $8D, $08, $BD, $83, $30, $17, $9D, $BC, $30, $E0, $C5, $13
Data.b $A4, $2A, $55, $9A, $B4, $4F, $7F, $4F, $AF, $B9, $FF, $D5, $37, $53, $85, $7A
Data.b $7D, $14, $38, $04, $1C, $B1, $A5, $D3, $BF, $92, $3D, $9B, $06, $F0, $BD, $BB
Data.b $6F, $DB, $51, $2A, $64, $9B, $DC, $98, $BB, $D4, $28, $44, $9B, $13, $68, $55
Data.b $01, $7C, $24, $01, $10, $04, $9A, $7A, $50, $47, $23, $C2, $92, $23, $42, $4F
Data.b $5C, $F4, $52, $2F, $42, $59, $45, $08, $52, $33, $7C, $64, $D7, $4E, $1E, $79
Data.b $EB, $64, $F6, $5C, $A1, $34, $09, $FC, $D8, $EE, $F3, $B6, $F2, $DC, $90, $4E
Data.b $DC, $00, $7C, $18, $F8, $B8, $14, $E2, $CE, $CE, $88, $D7, $D6, $1F, $75, $93
Data.b $3B, $A3, $5E, $BC, $37, $EA, $C5, $BA, $63, $D1, $C8, $81, $F6, $D6, $86, $42
Data.b $D5, $57, $75, $AD, $C1, $7A, $06, $04, $CA, $F5, $30, $DA, $40, $73, $27, $33
Data.b $D3, $A3, $1C, $DC, $BE, $9D, $A7, $46, $27, $0B, $CF, $8E, $4D, $4E, $02, $AF
Data.b $00, $CF, $DB, $F8, $CF, $7D, $50, $D2, $6E, $05, $00, $0F, $E8, $06, $3E, $64
Data.b $AF, $4D, $76, $37, $02, $4D, $F7, $75, $B4, $DC, $FC, $F5, $5D, $7D, $3F, $5D
Data.b $F1, $7D, $A9, $A5, $40, $08, $89, $10, $82, $68, $A2, $89, $B2, $72, $E9, $2E
Data.b $67, $19, $CE, $64, $D8, $D7, $DE, $C1, $6B, $C5, $4A, $F9, $37, $8F, $0D, $CE
Data.b $D8, $90, $79, $0E, $78, $13, $48, $5D, $2E, $69, $B7, $A2, $91, $F9, $C0, $1C
Data.b $B0, $02, $44, $2C, $A0, $28, $10, $FB, $E8, $AE, $BE, $9D, $7F, $78, $53, $CF
Data.b $F7, $D2, $B9, $9C, $34, $80, $D1, $06, $21, $34, $5E, $34, $46, $25, $92, $20
Data.b $7D, $EE, $34, $BB, $3E, $B4, $C7, $FC, $D5, $E8, $54, $7E, $78, $7C, $2E, $B7
Data.b $58, $A9, $AE, $00, $EF, $02, $2F, $DA, $7A, $9F, $DE, $8C, $F1, $D7, $0A, $C0
Data.b $58, $10, $BE, $AD, $CF, $02, $E0, $B7, $EE, $DC, $1B, $FB, $62, $6F, $F7, $B3
Data.b $53, $B3, $B3, $ED, $D2, $5A, $61, $0C, $08, $29, $50, $AD, $3D, $4C, $9F, $3D
Data.b $C9, $DD, $BB, $76, $F3, $C4, $C0, $70, $EE, $D0, $D2, $EA, $14, $30, $04, $0C
Data.b $5B, $00, $A7, $80, $A5, $0F, $6A, $56, $5B, $0A, $E0, $C4, $E7, $7F, $B1, $AF
Data.b $AB, $BD, $E5, $EE, $B9, $7C, $31, $FF, $97, $C7, $4E, $9F, $FD, $F6, $D1, $A1
Data.b $55, $A0, $FE, $1B, $7B, $76, $FE, $C9, $FC, $EC, $DC, $4F, $79, $9E, $8B, $D6
Data.b $10, $18, $83, $36, $86, $78, $F7, $2E, $46, $CE, $BE, $CB, $BE, $BE, $3E, $7E
Data.b $F7, $BD, $F1, $FC, $CB, $0B, $4B, $D3, $B6, $44, $FE, $97, $6D, $52, $CB, $96
Data.b $E7, $F8, $D7, $52, $D2, $37, $95, $03, $23, $8F, $7C, $7C, $77, $9B, $E7, $9F
Data.b $90, $E5, $5A, $A3, $17, $8B, $E2, $C6, $63, $A6, $8C, $9C, $AF, $69, $31, $5D
Data.b $5C, $4E, $1D, $F0, $A5, $C0, $AF, $07, $54, $FD, $80, $7A, $60, $50, $89, $36
Data.b $06, $C7, $DE, $A3, $29, $1E, $E5, $B9, $D5, $5C, $F1, $EF, $C7, $26, $D7, $8C
Data.b $FF, $37, $DB, $69, $53, $F6, $D4, $CD, $B5, $36, $D4, $AB, $F6, $C0, $67, $77
Data.b $F7, $39, $CD, $75, $FF, $AF, $4B, $42, $37, $CA, $B6, $26, $F2, $42, $11, $18
Data.b $21, $02, $4D, $4F, $63, $26, $D7, $D3, $D8, $D5, $46, $60, $04, $D5, $9A, $4F
Data.b $B9, $E2, $83, $8C, $71, $6C, $6C, $94, $93, $B3, $73, $2C, $B5, $75, $54, $FE
Data.b $69, $6C, $72, $19, $38, $69, $3B, $EC, $80, $35, $BE, $7E, $BD, $64, $F2, $6A
Data.b $01, $88, $A7, $EF, $D8, $F7, $EB, $C2, $D1, $0F, $44, $3D, $17, $53, $AD, $13
Data.b $51, $06, $A9, $1C, $8C, $00, $A7, $B3, $05, $E5, $44, $08, $0C, $18, $E9, $10
Data.b $C8, $18, $D3, $B9, $22, $AB, $E9, $15, $5A, $1C, $C5, $1D, $1E, $D1, $5F, $BE
Data.b $7F, $7F, $B7, $1B, $8D, $DC, $E1, $41, $09, $6D, $92, $43, $99, $DC, $C9, $3F
Data.b $38, $75, $76, $32, $5D, $F3, $2B, $36, $7C, $D6, $44, $8B, $D9, $F2, $10, $1A
Data.b $FD, $D4, $47, $F7, $36, $4B, $73, $54, $C4, $9C, $B8, $11, $21, $9D, $14, $CA
Data.b $41, $48, $85, $54, $0A, $A9, $1C, $84, $0A, $63, $BF, $EA, $07, $94, $CB, $3E
Data.b $E5, $9A, $8F, $89, $46, $A9, $6B, $4D, $10, $F8, $54, $4A, $45, $74, $21, $4F
Data.b $BC, $52, $A0, $39, $E2, $12, $73, $5C, $DC, $48, $24, $8F, $1B, $19, $79, $FC
Data.b $E8, $D0, $D7, $BE, $3F, $39, $3B, $68, $2B, $5B, $75, $4B, $3D, $F0, $D4, $87
Data.b $6F, $F6, $9A, $D1, $DF, $51, $31, $27, $AE, $37, $E2, $5E, $A3, $CE, $6B, $47
Data.b $A6, $0D, $C6, $08, $04, $02, $29, $15, $AE, $32, $D4, $7D, $8D, $A7, $5C, $DC
Data.b $68, $03, $AD, $8D, $9D, $18, $2F, $8A, $69, $68, $24, $9D, $5A, $62, $F0, $D8
Data.b $6B, $EC, $4D, $36, $25, $FF, $71, $75, $31, $FA, $FD, $C9, $D9, $7B, $AC, $E1
Data.b $45, $DB, $81, $AF, $DA, $0B, $57, $62, $A3, $E2, $0B, $3B, $7B, $9F, $54, $51
Data.b $79, $E0, $82, $02, $17, $17, $5F, $4D, $C8, $8F, $D7, $08, $1D, $58, $5E, $24
Data.b $25, $42, $48, $A4, $08, $29, $85, $90, $0A, $57, $3A, $88, $62, $85, $F1, $63
Data.b $6F, $B0, $23, $12, $E7, $07, $D9, $42, $E9, $F7, $4F, $BD, $07, $D0, $62, $8D
Data.b $DE, $DA, $32, $3A, $F1, $B1, $03, $B7, $47, $A4, $F9, $AA, $72, $54, $28, $0B
Data.b $85, $C4, $08, $19, $1A, $27, $25, $88, $D0, $48, $83, $E4, $02, $7B, $5E, $23
Data.b $76, $12, $69, $F9, $90, $10, $E1, $30, $A2, $5E, $0F, $38, $79, $FC, $75, $7A
Data.b $84, $66, $C4, $50, $FB, $CA, $C0, $F0, $32, $70, $06, $78, $1B, $18, $03, $CA
Data.b $9B, $CD, $81, $CB, $D2, $E9, $A9, $72, $35, $98, $C9, $E5, $53, $A3, $4B, $E9
Data.b $F6, $7A, $D5, $4F, $B6, $2B, $E5, $4A, $C7, $11, $D2, $71, $2D, $08, $15, $4A
Data.b $AB, $90, $86, $A2, $8D, $08, $35, $B1, $D6, $68, $0D, $46, $48, $A4, $08, $F3
Data.b $04, $E9, $70, $7A, $78, $80, $58, $3E, $4D, $D0, $D8, $58, $7F, $E4, $C8, $F1
Data.b $45, $5F, $9B, $41, $E0, $47, $96, $C0, $CD, $5F, $4B, $2F, $B8, $2C, $80, $91
Data.b $7C, $49, $1D, $5A, $CD, $55, $7F, $B8, $94, $CE, $7F, $F7, $FC, $C2, $6A, $A6
Data.b $5C, $F3, $1E, $EC, $ED, $EC, $10, $9E, $7B, $E1, $F4, $CD, $05, $FA, $AC, $4D
Data.b $28, $EA, $03, $1D, $0A, $FB, $50, $43, $4A, $A4, $72, $18, $9B, $38, $4B, $7D
Data.b $69, $86, $8E, $CE, $8E, $E0, $13, $87, $8F, $AD, $14, $EA, $C1, $69, $CB, $FB
Data.b $5F, $05, $A6, $AE, $96, $7D, $6E, $56, $D0, $68, $9B, $58, $B3, $BF, $D4, $DB
Data.b $59, $FD, $C6, $5D, $7B, $3F, $EB, $25, $E3, $6E, $28, $50, $04, $06, $C9, $F8
Data.b $CC, $2A, $A5, $89, $31, $DC, $6A, $99, $A0, $1E, $A0, $09, $E3, $5D, $5B, $50
Data.b $42, $2A, $66, $16, $E6, $C9, $4C, $8D, $D2, $DF, $DB, $AD, $1F, $3A, $32, $90
Data.b $5A, $A8, $54, $CF, $5A, $FE, $F3, $12, $30, $B1, $D9, $CA, $B3, $99, $2A, $54
Data.b $07, $52, $5F, $BD, $75, $47, $ED, $4B, $BB, $B7, $FF, $43, $A4, $B1, $21, $A6
Data.b $B5, $59, $D7, $B3, $73, $A9, $02, $93, $13, $A3, $F4, $75, $B5, $E9, $4F, $1E
Data.b $3E, $91, $E9, $95, $54, $EE, $6B, $49, $AA, $FD, $AD, $4D, $89, $BD, $6D, $6D
Data.b $71, $95, $68, $12, $2B, $5A, $B1, $30, $31, $CC, $1D, $7D, $3D, $E6, $D3, $EF
Data.b $0C, $66, $CE, $17, $CB, $13, $F6, $D4, $5F, $B1, $C6, $57, $AE, $A7, $13, $5F
Data.b $B1, $0F, $C4, $1D, $47, $4C, $FC, $CC, $FE, $67, $22, $ED, $6D, $8F, $6B, $A5
Data.b $C2, $E1, $88, $10, $64, $2A, $9A, $A3, $43, $C3, $F4, $B4, $35, $99, $C7, $4F
Data.b $9D, $4D, $BD, $97, $2B, $4E, $02, $A7, $ED, $00, $AA, $B9, $41, $A9, $AE, $FB
Data.b $1A, $63, $DD, $B7, $34, $44, $DB, $13, $5E, $34, $FA, $1F, $A9, $5C, $F9, $64
Data.b $26, $37, $03, $BC, $06, $FC, $00, $18, $04, $F2, $D7, $63, $FC, $55, $01, $98
Data.b $3E, $B8, $FF, $B1, $44, $6B, $EB, $DF, $E2, $45, $84, $16, $60, $90, $54, $EA
Data.b $F0, $C6, $F0, $08, $6E, $D4, $31, $5F, $1F, $9F, $CD, $0C, $A4, $B2, $E7, $AC
Data.b $14, $3C, $64, $75, $6C, $12, $E8, $B2, $7A, $A1, $07, $E8, $B4, $EF, $1A, $03
Data.b $0E, $5B, $E3, $B3, $9B, $A5, $CE, $9B, $0E, $A1, $33, $0F, $DC, $FE, $13, $89
Data.b $64, $F2, $5B, $78, $AE, $08, $45, $79, $58, $65, $06, $C6, $26, $79, $7D, $7A
Data.b $86, $F9, $D6, $B6, $CA, $C9, $74, $6E, $09, $38, $6A, $E3, $F9, $B8, $55, $53
Data.b $CA, $6A, $84, $04, $D0, $6C, $05, $8F, $B4, $9D, $76, $CE, $9E, $FC, $75, $1B
Data.b $7F, $D9, $24, $FE, $D7, $7B, $F6, $C5, $F7, $35, $35, $FE, $48, $26, $13, $3B
Data.b $40, $AC, $CF, $73, $16, $6B, $01, $E7, $4B, $45, $2A, $F9, $02, $F7, $B4, $35
Data.b $B9, $BF, $F7, $B3, $F7, $24, $1F, $DE, $DD, $A7, $3E, $D6, $D7, $99, $2E, $F9
Data.b $C1, $F4, $78, $AE, $50, $B5, $B9, $53, $B1, $86, $AE, $02, $0B, $C0, $AC, $05
Data.b $50, $B9, $DE, $B0, $B9, $62, $08, $25, $5C, $47, $4C, $1E, $BC, $EB, $59, $AF
Data.b $B9, $E9, $0B, $5A, $CA, $0B, $E3, $12, $11, $56, $1F, $5F, $2A, $2A, $91, $08
Data.b $99, $5C, $91, $F4, $EA, $2A, $D1, $5A, $95, $AE, $64, $03, $1D, $AD, $CD, $7E
Data.b $C5, $98, $E3, $73, $85, $D2, $AB, $87, $E6, $96, $5F, $FC, $CA, $B1, $D3, $43
Data.b $DA, $98, $D2, $86, $D1, $E0, $96, $19, $7E, $59, $00, $0B, $0F, $FE, $E4, $AF
Data.b $24, $9B, $9B, $FE, $C6, $B8, $EE, $FA, $7C, $DB, $AC, $F9, $5C, $4A, $90, $2A
Data.b $6C, $62, $42, $51, $AD, $6B, $2A, $8E, $4B, $BE, $54, $A2, $98, $CF, $E2, $94
Data.b $8B, $B4, $7A, $2E, $2D, $89, $38, $28, $35, $BD, $5A, $2E, $BF, $7E, $26, $5B
Data.b $78, $F9, $A9, $E1, $89, $1F, $BF, $B5, $9A, $5B, $B5, $1E, $A8, $6F, $55, $08
Data.b $FD, $2F, $00, $E3, $07, $F7, $DF, $B6, $AD, $31, $F9, $86, $88, $46, $13, $21
Data.b $CD, $11, $04, $98, $90, $2A, $0B, $81, $11, $21, $85, $40, $28, $8C, $0C, $AF
Data.b $DA, $F6, $84, $5A, $3D, $C0, $F7, $5C, $8A, $7E, $8D, $4A, $B9, $08, $99, $14
Data.b $4D, $D4, $69, $F2, $3C, $12, $B1, $48, $39, $5B, $AD, $BD, $3D, $57, $AA, $1C
Data.b $7A, $7E, $6E, $E5, $C5, $3F, $1A, $99, $1A, $03, $D6, $BC, $A3, $AF, $D5, $3B
Data.b $17, $01, $F8, $E6, $81, $7D, $D1, $CF, $B5, $37, $1D, $93, $89, $86, $7D, $C8
Data.b $90, $BF, $84, $5F, $17, $2C, $00, $42, $00, $6B, $7B, $1D, $C8, $DA, $33, $04
Data.b $DA, $EE, $40, $1B, $EA, $91, $18, $65, $61, $A8, $96, $F3, $04, $E9, $25, $12
Data.b $A5, $3C, $CD, $8E, $43, $5B, $3C, $66, $AA, $5A, $8F, $2F, $55, $FD, $57, $07
Data.b $73, $C5, $97, $7F, $67, $68, $FC, $8D, $B1, $42, $39, $6B, $BD, $13, $6C, $C6
Data.b $3B, $97, $7A, $C0, $FB, $F2, $EE, $EE, $83, $77, $B5, $34, $3E, $79, $4F, $47
Data.b $CB, $81, $6D, $89, $86, $98, $56, $2A, $F4, $F7, $06, $00, $7A, $23, $00, $29
Data.b $31, $22, $FC, $8A, $A4, $C5, $5A, $87, $16, $68, $2C, $C9, $13, $12, $23, $25
Data.b $81, $EB, $51, $F3, $5C, $CA, $A5, $0C, $F5, $EC, $32, $B1, $CC, $0A, $ED, $AE
Data.b $43, $B3, $EB, $A1, $94, $93, $5B, $AD, $D5, $DF, $38, $5F, $AE, $BE, $F2, $77
Data.b $53, $F3, $2F, $3D, $33, $3E, $7D, $DE, $32, $80, $FA, $95, $3C, $73, $69, $15
Data.b $92, $6F, $A5, $0B, $FA, $B9, $F9, $D5, $EC, $37, $C7, $67, $B3, $43, $A9, $B4
Data.b $1F, $0D, $02, $AF, $2F, $E2, $C5, $94, $72, $C2, $09, $95, $10, $F6, $1F, $C5
Data.b $DA, $C4, $7F, $C3, $1B, $C4, $C6, $2F, $01, $17, $EE, $85, $44, $21, $88, $18
Data.b $49, $C2, $4D, $10, $4D, $76, $22, $FA, $F6, $90, $8E, $27, $59, $74, $24, $2B
Data.b $D9, $74, $24, $22, $D8, $B3, $3B, $16, $79, $70, $B4, $54, $6E, $7F, $69, $31
Data.b $35, $67, $85, $7E, $79, $B3, $00, $B0, $BC, $64, $D9, $C0, $F9, $91, $42, $E5
Data.b $DC, $BF, $CC, $AD, $4C, $7F, $67, $72, $6E, $39, $5D, $28, $D0, $2A, $45, $B4
Data.b $D3, $73, $23, $46, $3A, $E1, $0C, $D4, $88, $F5, $CA, $64, $6C, $9D, $DD, $08
Data.b $CE, $58, $70, $42, $08, $1B, $6E, $E1, $90, $4B, $4A, $85, $AB, $05, $0D, $5E
Data.b $12, $65, $A2, $2C, $A4, $57, $91, $F9, $A2, $F9, $ED, $33, $13, $0B, $7F, $3A
Data.b $3A, $BD, $68, $BB, $F9, $F4, $D5, $34, $3B, $F5, $3E, $33, $9F, $9A, $6D, $46
Data.b $8B, $76, $46, $39, $5E, $0E, $F4, $B9, $B7, $33, $85, $73, $DF, $9D, $5A, $98
Data.b $79, $61, $6E, $29, $67, $AA, $65, $D5, $E7, $AA, $78, $C2, $71, $94, $91, $CE
Data.b $45, $A7, $7D, $61, $42, $BD, $E6, $A1, $B5, $9F, $2D, $ED, $DE, $00, $AC, $5A
Data.b $2C, $30, $F9, $EE, $11, $3A, $74, $D5, $3C, $39, $36, $95, $FB, $F7, $B9, $95
Data.b $05, $3B, $2B, $3A, $6A, $79, $52, $E9, $4A, $1E, $10, $57, $91, $23, $8E, $ED
Data.b $AA, $2D, $96, $1A, $EC, $04, $FA, $A5, $10, $FD, $0F, $75, $35, $DF, $FA, $E9
Data.b $9E, $AE, $5D, $F7, $76, $77, $B5, $39, $B1, $A4, $34, $8E, $67, $3D, $22, $D1
Data.b $A8, $F5, $9C, $40, $2A, $BB, $43, $1D, $2D, $94, $43, $B9, $54, $60, $E6, $CC
Data.b $00, $ED, $51, $C7, $3C, $71, $7A, $3C, $F3, $56, $2A, $37, $65, $47, $2E, $2F
Data.b $00, $C7, $6C, $D3, $AB, $5F, $37, $17, $BA, $44, $7E, $BA, $76, $B8, $DB, $06
Data.b $F4, $01, $BB, $81, $9B, $5B, $3D, $A7, $FF, $B1, $9E, $F6, $5B, $1E, $EA, $ED
Data.b $DE, $BE, $B7, $BD, $3D, $59, $8F, $24, $D1, $D2, $59, $4F, $FA, $30, $D9, $D5
Data.b $FA, $2E, $15, $73, $2C, $4C, $0C, $D3, $1C, $73, $F5, $E7, $07, $47, $D3, $43
Data.b $21, $11, $3C, $6C, $F5, $C1, $89, $0D, $F3, $A2, $1B, $32, $DC, $15, $16, $4C
Data.b $C4, $92, $B6, $4E, $E0, $26, $A0, $1F, $E8, $BF, $AD, $31, $7E, $CB, $67, $7A
Data.b $3B, $F6, $3C, $D8, $DB, $D3, $DD, $92, $68, $F1, $EA, $91, $44, $28, $29, $A5
Data.b $83, $91, $92, $42, $3E, $C3, $EA, $F4, $28, $B1, $58, $24, $F8, $CC, $C9, $91
Data.b $D4, $B9, $62, $65, $C2, $7E, $85, $7C, $C1, $92, $BC, $CC, $66, $B4, $B1, $D8
Data.b $82, $46, $B8, $31, $C4, $B6, $01, $BB, $80, $7E, $25, $44, $FF, $27, $BA, $9A
Data.b $6F, $7D, $B8, $BB, $63, $D7, $47, $B6, $F5, $B4, $89, $78, $8B, $CC, $96, $4B
Data.b $64, $17, $A6, $20, $E2, $06, $8F, $9E, $18, $59, $59, $A8, $D4, $C6, $AC, $36
Data.b $78, $D1, $CE, $4A, $37, $CD, $50, $C5, $16, $D2, $92, $0F, $0C, $B1, $36, $CF
Data.b $E9, $7F, $AC, $B7, $FD, $D6, $7D, $D1, $58, $EF, $8A, $31, $3C, $3D, $3E, $93
Data.b $CD, $FA, $F5, $35, $E3, $5F, $B2, $33, $D2, $6B, $62, $A8, $82, $1B, $B3, $D4
Data.b $25, $21, $B6, $03, $D8, $63, $C3, $AC, $CB, $36, $A9, $E3, $36, $69, $47, $6D
Data.b $CD, $37, $5B, $C2, $85, $6E, $00, $59, $74, $80, $98, $D5, $05, $DB, $AC, $77
Data.b $2A, $56, $C8, $CF, $5F, $CB, $28, $E5, $FF, $12, $C0, $A5, $21, $E6, $D8, $30
Data.b $33, $37, $92, $62, $FF, $BF, $5A, $FF, $03, $14, $40, $F3, $DA, $D8, $5F, $19
Data.b $B7, $00, $00, $00, $00, $49, $45, $4E, $44, $AE, $42, $60, $82
EndDataSectionSélectionnez
;Overlay diagonal scanlines by reducing color and leaving Alpha unchanged
Procedure DiagonalScanlines(x,y,SourceColor,TargetColor)
If ((x+y) % 3)
ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
Else
ProcedureReturn TargetColor
EndIf
EndProcedure
;invert color and keep alpha layer
Procedure InvertedColors(x,y,SourceColor,TargetColor)
ProcedureReturn TargetColor ! $FFFFFF
EndProcedure
;convert color to grayscale
Procedure GrayscaleFilter(x,y,SourceColor,TargetColor)
grayLevel=(Red(TargetColor)+Green(TargetColor)+Blue(TargetColor))/3
ProcedureReturn RGBA(grayLevel,grayLevel,grayLevel,Alpha(TargetColor))
EndProcedure
Procedure SetDarkenPercent(percent)
Global DarkFactor.f
DarkFactor = 1 - percent / 100.0
If DarkFactor < 0 : DarkFactor = 0 : EndIf
If DarkFactor > 1 : DarkFactor = 1 : EndIf
EndProcedure
Procedure DarkenFilter(x, y, SourceColor, TargetColor)
Global DarkFactor.f
ProcedureReturn RGBA(Red(TargetColor) * DarkFactor, Green(TargetColor) * DarkFactor, Blue(TargetColor) * DarkFactor, Alpha(TargetColor))
EndProcedure
; SetDarkenPercent(10) ; make image 10% darker
Procedure SetLightenPercent(percent)
Global LightFactor.f
LightFactor =1-percent / 100.0
If LightFactor < 0 : LightFactor = 0 : EndIf
If LightFactor > 1 : LightFactor = 1 : EndIf
EndProcedure
Procedure LightenFilter(x, y, SourceColor, TargetColor)
Global LightFactor.f
ColorToWhite = $FFFFFF - TargetColor
ProcedureReturn RGBA(255 - Red(ColorToWhite) * LightFactor, 255 - Green(ColorToWhite) * LightFactor, 255 - Blue(ColorToWhite) * LightFactor, Alpha(TargetColor))
EndProcedure
;SetLightenPercent(20) ;make image 20% lighter
;Fat pixel
Procedure PixelFilterCallback(x, y, SourceColor, TargetColor)
#pixelSize=5
xn=#pixelSize*(x/#pixelSize)
yn=#pixelSize*(y/#pixelSize)
ProcedureReturn Point(xn,yn)
EndProcedure
Procedure PixelFilter()
CustomFilterCallback(@PixelFilterCallback())
EndProcedureLes trois derniers filtres sont de Demivec :
Sélectionnez
;Transfer the Alpha layer into the visible layer.
Procedure MakeAlphaVisibleFilterCallback(x, y, SourceColor, TargetColor)
ProcedureReturn RGBA(Alpha(SourceColor), Alpha(SourceColor),Alpha(SourceColor),00)
EndProcedure
;Overlay horizontal scanlines by reducing color and leaving Alpha unchanged
Procedure HorizontalScanlines(x,y,SourceColor,TargetColor)
If y % 2
ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
Else
ProcedureReturn TargetColor
EndIf
EndProcedure
;Overlay vertical scanlines by reducing color and leaving Alpha unchanged
Procedure VerticalScanlines(x,y,SourceColor,TargetColor)
If x % 2
ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
Else
ProcedureReturn TargetColor
EndIf
EndProcedureCréé le 8 mars 2011 par eddy
Première version :
Sélectionnez
#SquaredShape=0
#RhombShape=1
EnableExplicit
Define i,wi,he, ev,Fon,Img,ImGad
DisableDebugger ; with debugger on, slow drawing
Procedure CAux(Array Arr.Point(1),X,Y,A,B,Rgb,N)
If Point(X,Y)=RGB And Point(A,B)<>Rgb
Arr(N)\X=x : Arr(N)\Y=y
N+1
EndIf
ProcedureReturn N
EndProcedure
Procedure Outline(Array Arr.Point(1),Img,Rgb=0,Rhomb=0)
;ret Arr con outline de rgb
Protected I,X,Y,N
Protected Iwi=ImageWidth(Img)-2
Protected Ihe=ImageHeight(Img)-2
Dim arr(iwi*ihe)
For X=1 To Iwi
For y=1 To Ihe
If Rhomb=1 Or (Rhomb=2 And 1&Y) ; if Odd(y)
N=CAux(Arr(),X,Y,X-1,Y ,Rgb,N) ; left
N=CAux(Arr(),X,Y,X ,Y-1,Rgb,N) ; top
N=CAux(Arr(),X,Y,X+1,Y ,Rgb,N) ; right
N=CAux(Arr(),X,Y,X ,Y+1,Rgb,N) ; bottom
EndIf
If Rhomb=0 Or (Rhomb=2 And Not(1&Y)) ; if Even(Y)
N=CAux(Arr(),X,Y,X-1,Y-1,Rgb,N) ; left top
N=CAux(Arr(),X,Y,X-1,Y+1,Rgb,N) ; left bottom
N=CAux(Arr(),X,Y,X+1,Y-1,Rgb,N) ; top right
N=CAux(Arr(),X,Y,X+1,Y+1,Rgb,N) ; bottom right
EndIf
Next
Next
ReDim arr(n-1)
EndProcedure
;Test it <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;StartDrawing is inside loop to see the growing outline effect
Procedure TestDraw(img,imgad)
Protected RGB,j
Dim arr.point(0)
StartDrawing(ImageOutput(Img))
Outline(arr(),Img,0,#RhombShape) ; try #SquaredShape <<<<<<<<<<
RGB=Random(#White)
For j=0 To ArraySize(arr())
Plot(arr(j)\x,arr(j)\y,RGB)
Next
StopDrawing()
SetGadgetState(Imgad,ImageID(Img))
EndProcedure
OpenWindow(0, 100, 100,900,320 ,"Get Outline", #PB_Window_SystemMenu |1)
Wi=WindowWidth(0):He=WindowHeight(0)
Fon=LoadFont(-1,"arial",80)
Img=CreateImage(-1,Wi,He)
Imgad=ImageGadget(-1,0,0,0,0,ImageID(Img))
StartDrawing(ImageOutput(Img))
DrawingFont(FontID(Fon))
DrawingMode(#PB_2DDrawing_Outlined)
DrawText(130,90,"Pure Basic",Random(#White),0)
StopDrawing()
SetGadgetState(Imgad,ImageID(Img))
Repeat
ev= WaitWindowEvent(1)
If i<90
testdraw(img,imgad)
i+1
EndIf
Until ev=#PB_Event_CloseWindowVersion encore plus jolie (avec un semblant de 3D) :
Sélectionnez
#SquaredShape=0
#RhombShape=1
EnableExplicit
Define i,wi,he, ev,Fon,Img,ImGad
Global _FastMode=#False ; less fun if set to #True
Global _drawing
DisableDebugger ; with debugger on, slow drawing
Macro MMK
Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
EndMacro
Procedure CAux(Array Arr.Point(1),X,Y,A,B,Rgb,N)
If Point(X,Y)=RGB And Point(A,B)<>Rgb
Arr(N)\X=x : Arr(N)\Y=y
N+1
EndIf
ProcedureReturn N
EndProcedure
Procedure Outline(Array Arr.Point(1),Img,Rgb=0,Rhomb=0)
;ret Arr con outline de rgb
Protected I,X,Y,N
Protected Iwi=ImageWidth(Img)-2
Protected Ihe=ImageHeight(Img)-2
Dim arr(iwi*ihe)
For X=1 To Iwi
For y=1 To Ihe
If Rhomb=1 Or (Rhomb=2 And 1&Y) ; if Odd(y)
N=CAux(Arr(),X,Y,X-1,Y ,Rgb,N) ; left
N=CAux(Arr(),X,Y,X ,Y-1,Rgb,N) ; top
N=CAux(Arr(),X,Y,X+1,Y ,Rgb,N) ; right
N=CAux(Arr(),X,Y,X ,Y+1,Rgb,N) ; bottom
EndIf
If Rhomb=0 Or (Rhomb=2 And Not(1&Y)) ; if Even(Y)
N=CAux(Arr(),X,Y,X-1,Y-1,Rgb,N) ; left top
N=CAux(Arr(),X,Y,X-1,Y+1,Rgb,N) ; left bottom
N=CAux(Arr(),X,Y,X+1,Y-1,Rgb,N) ; top right
N=CAux(Arr(),X,Y,X+1,Y+1,Rgb,N) ; bottom right
EndIf
Next
Next
ReDim arr(n-1)
EndProcedure
;Test it <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Procedure BallDraw(img,imgad,X,Y,Array Arr.Point(1),Rgb1,Rgb2,Radius)
Protected I,X1,Y1,R2=Radius/2,ev
If _Fastmode
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(Rgb2) : BackColor(Rgb1)
For I=0 To ArraySize(Arr())-1
X1=Arr(I)\X : Y1=Arr(I)\Y
LinearGradient(X1-R2,Y1-R2,X1+R2,Y1+R2)
Circle(X1,Y1,Radius)
Next
Else
While Mmk:WindowEvent():Wend
For I=0 To ArraySize(Arr())-1
If GetAsyncKeyState_(27)&$8000 : End : EndIf
WindowEvent()
If Mmk :Break:EndIf ; stop drawing and return if left mouse click
If _Drawing:StopDrawing():EndIf
_Drawing=StartDrawing(ImageOutput(Img))
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(Rgb2) : BackColor(Rgb1)
X1=Arr(I)\X : Y1=Arr(I)\Y
LinearGradient(X1-R2,Y1-R2,X1+R2,Y1+R2)
Circle(X1,Y1,Radius)
StopDrawing():_Drawing=0
SetGadgetState(Imgad,ImageID(Img))
Next
EndIf
EndProcedure
Procedure TestDraw(img,imgad,rgb1,rgb2,radius)
Protected RGB,j
Dim arr.point(0)
_drawing=StartDrawing(ImageOutput(Img))
Outline(arr(),Img,0,#RhombShape) ; try #SquaredShape <<<<<<<<<<
RGB=Random(#White)
balldraw(img,imgad,arr(j)\x,arr(j)\y,arr(),rgb1,rgb2,radius)
StopDrawing():_drawing=0
SetGadgetState(Imgad,ImageID(Img))
EndProcedure
OpenWindow(0, 100, 100,1000,320 ,"Get Outline _ Double click on Close Window to Quit", #PB_Window_SystemMenu |1)
Wi=WindowWidth(0):He=WindowHeight(0)
Fon=LoadFont(-1,"times new roman",70) ; try different fonts and sizes
Img=CreateImage(-1,Wi,He)
Imgad=ImageGadget(-1,0,0,0,0,ImageID(Img))
StartDrawing(ImageOutput(Img))
DrawingFont(FontID(Fon))
DrawingMode(#PB_2DDrawing_Outlined)
DrawText(100,90,"P u r e B a s i c",Random(#White),0)
StopDrawing()
SetGadgetState(Imgad,ImageID(Img))
testdraw(img,imgad,#Yellow,$55,6) ; last parameter= radius: small values or very slow drawing
Repeat
ev= WaitWindowEvent(1)
If i<10
testdraw(img,imgad,Random(#White),Random(#White),i)
i+1
SetWindowTitle(0,Str(i))
EndIf
Until ev=#PB_Event_CloseWindowEt une version de kenmo :
Sélectionnez
#Glow = 0.35 ; Vary from 0.0 to 1.0
#GlowColor = $2040FF ; Color in $BBGGRR format
#Thickness = 90 ; Outline iterations
#Message = "PureBasic" ; String to display
#SquaredShape=0
#RhombShape=1
EnableExplicit
Define i,wi,he, ev,Fon,Img,ImGad
DisableDebugger ; with debugger on, slow drawing
Procedure CAux(Array Arr.Point(1),X,Y,A,B,Rgb,N)
If Point(X,Y)=RGB And Point(A,B)<>Rgb
Arr(N)\X=x : Arr(N)\Y=y
N+1
EndIf
ProcedureReturn N
EndProcedure
Procedure Outline(Array Arr.Point(1),Img,Rgb=0,Rhomb=0)
;ret Arr con outline de rgb
Protected I,X,Y,N
Protected Iwi=ImageWidth(Img)-2
Protected Ihe=ImageHeight(Img)-2
Dim arr(iwi*ihe)
For X=1 To Iwi
For y=1 To Ihe
If Rhomb=1 Or (Rhomb=2 And 1&Y) ; if Odd(y)
N=CAux(Arr(),X,Y,X-1,Y ,Rgb,N) ; left
N=CAux(Arr(),X,Y,X ,Y-1,Rgb,N) ; top
N=CAux(Arr(),X,Y,X+1,Y ,Rgb,N) ; right
N=CAux(Arr(),X,Y,X ,Y+1,Rgb,N) ; bottom
EndIf
If Rhomb=0 Or (Rhomb=2 And Not(1&Y)) ; if Even(Y)
N=CAux(Arr(),X,Y,X-1,Y-1,Rgb,N) ; left top
N=CAux(Arr(),X,Y,X-1,Y+1,Rgb,N) ; left bottom
N=CAux(Arr(),X,Y,X+1,Y-1,Rgb,N) ; top right
N=CAux(Arr(),X,Y,X+1,Y+1,Rgb,N) ; bottom right
EndIf
Next
Next
ReDim arr(n-1)
EndProcedure
;Test it <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;StartDrawing is inside loop to see the growing outline effect
Procedure TestDraw(img,imgad,i)
Protected RGB,j
Dim arr.point(0)
StartDrawing(ImageOutput(Img))
Outline(arr(),Img,0,#RhombShape) ; try #SquaredShape <<<<<<<<<<
Define f.f = 1.0 - Pow((i / #Thickness), #Glow)
RGB=RGB(Red(#GlowColor) * f, Green(#GlowColor) * f, Blue(#GlowColor) * f)
For j=0 To ArraySize(arr())
Plot(arr(j)\x,arr(j)\y,RGB)
Next
StopDrawing()
SetGadgetState(Imgad,ImageID(Img))
EndProcedure
OpenWindow(0, 100, 100,900,320 ,"Get Outline", #PB_Window_SystemMenu |1)
Wi=WindowWidth(0):He=WindowHeight(0)
Fon=LoadFont(-1,"georgia",80,#PB_Font_Bold)
If (Not Fon)
Fon=LoadFont(-1,"times",80,#PB_Font_Bold)
EndIf
Img=CreateImage(-1,Wi,He)
Imgad=ImageGadget(-1,0,0,0,0,ImageID(Img))
StartDrawing(ImageOutput(Img))
DrawingFont(FontID(Fon))
DrawingMode(#PB_2DDrawing_Outlined)
DrawText(150,90,#Message,$010101,0)
StopDrawing()
SetGadgetState(Imgad,ImageID(Img))
Repeat
ev= WaitWindowEvent(1)
If i<#Thickness
testdraw(img,imgad,i)
i+1
EndIf
Until ev=#PB_Event_CloseWindowCréé le 13 mars 2011 par einander
Sélectionnez
;- Color v1.1
;-
;- Procedures for handling colors not only in RGB, but also CMY, HSV and HSL (sometimes called HLS oder HSI)
;- Especially the last both let you modify the saturation and hue much more intuitively
;- See Wikipedia for more information on HSV and HSL
;-
;- The procedures contains all conversions between those color-types. The internal RGB-format
;- uses values in range [0.0, 1.0], so scale them manually to [0, 255] or use ColorRGB() for their usage in PB.
;-
;- Feel free to use this code for anything you want but without infringing its copyright.
;- (don't describe as it's author, don't sell itself - so just stay as nice as you are :)
;-
;- 19.09.06 by Froggerprogger
;-
;- v1.1:
;- - added example 3
;-
;- please report any bugs, etc. to Froggerprogger in the Purebasic-Forums
Enumeration
; do not change their order!
#COLOR_RGB
#COLOR_CMY
#COLOR_HSV
#COLOR_HSL
EndEnumeration
Structure Color
StructureUnion
r.f ; Red in RGB [0.0, 1.0]
c.f ; Cyan in CMY [0.0, 1.0]
h.f ; Hue in HSV/HSL [0.0, 360.0[
EndStructureUnion
StructureUnion
g.f ; Green in RGB [0.0, 1.0]
m.f ; Magenta in CMY [0.0, 1.0]
s.f ; Saturation in HSV/HSL [0.0, 1.0]
EndStructureUnion
StructureUnion
b.f ; Blue in RGB [0.0, 1.0]
y.f ; Yellow in CMY [0.0, 1.0]
v.f ; Value in HSV [0.0, 1.0]
l.f ; Lightness in HSL [0.0, 1.0]
EndStructureUnion
type.l ; gives the type. One of #COLOR_RGB, #COLOR_CMY, #COLOR_HSV, #COLOR_HSL
EndStructure
;- some neccessary declares
DeclareDLL.l Color2RGB(*c.Color)
DeclareDLL.l Color2CMY(*c.Color)
DeclareDLL.l Color2HSV(*c.Color)
DeclareDLL.l Color2HSL(*c.Color)
;- some helper-proceudures
Procedure.f Max3F(a.f, b.f, c.f)
If a > b
If a > c
ProcedureReturn a
Else
ProcedureReturn c
EndIf
Else
If b > c
ProcedureReturn b
Else
ProcedureReturn c
EndIf
EndIf
EndProcedure
Procedure.f Min3F(a.f, b.f, c.f)
If a < b
If a < c
ProcedureReturn a
Else
ProcedureReturn c
EndIf
Else
If b < c
ProcedureReturn b
Else
ProcedureReturn c
EndIf
EndIf
EndProcedure
;- some global color-procedures
ProcedureDLL.l IsColorValid(*c.Color) ; returns #True or #False whether *c specifies a valid color or not
If *c\type < #COLOR_RGB Or *c\type > #COLOR_HSL
ProcedureReturn #False
EndIf
; check r, c in [0.0, 1.0] or h in [0.0, 360.0]
If *c\type <= #COLOR_CMY
If *c\r < 0 Or *c\r > 1.0
ProcedureReturn #False
EndIf
Else
If *c\h < 0 Or *c\h >= 360.0
ProcedureReturn #False
EndIf
EndIf
; check g, m, s, b, y, v, l in [0.0, 1.0]
If *c\g < 0 Or *c\g > 1.0
ProcedureReturn #False
EndIf
If *c\b < 0 Or *c\b > 1.0
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
ProcedureDLL.l ColorCopy(*c.Color) ; copies *c and returns *copy
Protected *out = AllocateMemory(SizeOf(Color))
CopyMemory(*c, *out, SizeOf(Color))
ProcedureReturn *out
EndProcedure
ProcedureDLL.l ColorComplement(*c.Color) ; complements *c and returns *c
If *c\type <= #COLOR_CMY
; if #COLOR_RGB or #COLOR_CMY
*c\r = 1.0 - *c\r
*c\g = 1.0 - *c\g
*c\b = 1.0 - *c\b
Else
; if #COLOR_HSV or #COLOR_HSL
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
EndIf
EndProcedure
ProcedureDLL.l ColorChangeType(*c.Color, type.l) ; changes the type of *c to the new type and returns *c. type = #COLOR_*
Select type
Case #COLOR_RGB : Color2RGB(*c)
Case #COLOR_CMY : Color2CMY(*c)
Case #COLOR_HSV : Color2HSV(*c)
Case #COLOR_HSL : Color2HSL(*c)
EndSelect
EndProcedure
ProcedureDLL.l IsSameColors(*c1.Color, *c2.Color, tolerance.f) ; compares the two colors (of any type) without modifiing them and returns #True if they describe the same color equal, #False otherwise
Protected same.l
; compare in RGB to easy treat special cases in HSL, HSV
*c1c.Color = ColorCopy(*c1)
*c2c.Color = ColorCopy(*c2)
Color2RGB(*c1c)
Color2RGB(*c2c)
If tolerance = 0
same = CompareMemory(*c1c, *c2c, SizeOf(Color))
Else
same = #True
If Abs(*c1c\r - *c2c\r) > tolerance
same = #False
EndIf
If Abs(*c1c\g - *c2c\g) > tolerance
same = #False
EndIf
If Abs(*c1c\b - *c2c\b) > tolerance
same = #False
EndIf
EndIf
FreeMemory(*c1c)
FreeMemory(*c2c)
ProcedureReturn same
EndProcedure
ProcedureDLL.s ColorToStr(*c.Color)
Protected s.s
Select *c\type
Case #COLOR_RGB : s = "RGB"
Case #COLOR_CMY : s = "CMY"
Case #COLOR_HSV : s = "HSV"
Case #COLOR_HSL : s = "HSL"
EndSelect
s + ": " + StrF(*c\r, 2) + ", " + StrF(*c\g, 2) + ", " + StrF(*c\b, 2)
ProcedureReturn s
EndProcedure
;- change color to RGB
ProcedureDLL.l CMY2RGB(*c.Color) ; converts CMY-color *c to RGB and returns *c. No check if CMY is made!
*c\r = 1.0 - *c\c
*c\g = 1.0 - *c\m
*c\b = 1.0 - *c\y
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSV2RGB(*c.Color) ; converts HSV-color *c to RGB and returns *c. No check if HSV is made!
Protected h.f, s.f, v.f
Protected f.f, p.f, q.f, t.f, i.l
h = *c\h
s = *c\s
v = *c\v
If s = 0
; it's a gray-tone
*c\r = v
*c\g = v
*c\b = v
Else
h / 60.0
i = Round(h, 0)
f = h-i
p = v*(1.0-s)
q = v*(1.0-s*f)
t = v*(1.0-s*(1.0-f))
Select i
Case 0 : *c\r = v : *c\g = t : *c\b = p
Case 1 : *c\r = q : *c\g = v : *c\b = p
Case 2 : *c\r = p : *c\g = v : *c\b = t
Case 3 : *c\r = p : *c\g = q : *c\b = v
Case 4 : *c\r = t : *c\g = p : *c\b = v
Case 5 : *c\r = v : *c\g = p : *c\b = q
EndSelect
EndIf
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
Procedure.f HSL2RGBHelper(q1.f, q2.f, h.f)
If h >= 360.0
h - 360.0
ElseIf h < 0.0
h + 360.0
EndIf
If h < 60.0
ProcedureReturn q1+(q2-q1)*h/60.0
ElseIf h < 180.0
ProcedureReturn q2
ElseIf h < 240.0
ProcedureReturn q1+(q2-q1)*(240.0-h)/60.0
Else
ProcedureReturn q1
EndIf
EndProcedure
ProcedureDLL.l HSL2RGB(*c.Color) ; converts HSL-color *c to RGB and returns *c. No check if HSL is made!
Protected h.f, l.f, s.f
Protected f.f, p1.f, p2.f, t.f
Protected i.l
h = *c\h
l = *c\l
s = *c\s
If l<=0.5
p2 = l*(1.0+s)
Else
p2 = l+s-l*s
EndIf
p1 = 2.0*l-p2
If s=0.0
; it's a gray-tone
*c\r = l
*c\g = l
*c\b = l
Else
*c\r = HSL2RGBHelper(p1, p2, h+120.0)
*c\g = HSL2RGBHelper(p1, p2, h)
*c\b = HSL2RGBHelper(p1, p2, h-120.0)
EndIf
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
ProcedureDLL.l Color2RGB(*c.Color) ; converts *c from any color-type to RGB and returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn *c
Case #COLOR_CMY : ProcedureReturn CMY2RGB(*c)
Case #COLOR_HSV : ProcedureReturn HSV2RGB(*c)
Case #COLOR_HSL : ProcedureReturn HSL2RGB(*c)
EndSelect
EndProcedure
ProcedureDLL.l ColorSetRGB(*c.Color, r.f, g.f, b.f) ; sets *c to the RGB-color given by r,g,b, each in range [0.0, 1.0] (no check is made) and returns *c
*c\r = r
*c\g = g
*c\b = b
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
;- change color to CMY
ProcedureDLL.l RGB2CMY(*c.Color) ; converts RGB-color *c to CMY and returns *c. No check if RGB is made!
*c\c = 1.0 - *c\r
*c\m = 1.0 - *c\g
*c\y = 1.0 - *c\b
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSV2CMY(*c.Color) ; converts HSV-color *c to CMY and returns *c. No check if HSV is made!
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
HSV2RGB(*c) ; HSV2RGB of complement
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSL2CMY(*c.Color) ; converts HSL-color *c to CMY and returns *c. No check if HSL is made!
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
HSL2RGB(*c) ; HSL2RGB of complement
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
ProcedureDLL.l Color2CMY(*c.Color) ; converts *c from any color-type to CMY and returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn RGB2CMY(*c)
Case #COLOR_CMY : ProcedureReturn *c
Case #COLOR_HSV : ProcedureReturn HSV2CMY(*c)
Case #COLOR_HSL : ProcedureReturn HSL2CMY(*c)
EndSelect
EndProcedure
ProcedureDLL.l ColorSetCMY(*c.Color, c.f, m.f, y.f) ; sets *c to the CMY-color given by c,m,y, each in range [0.0, 1.0] (no check is made) and returns *c
*c\c = c
*c\m = m
*c\y = y
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
;- change color to HSV
ProcedureDLL.l RGB2HSV(*c.Color) ; converts RGB-color *c to HSV and returns *c. No check if RGB is made!
Protected r.f, g.f, b.f, max.f, min.f, delta.f
r = *c\r
g = *c\g
b = *c\b
max = Max3F(r,g,b)
min = Min3F(r,g,b)
; get value
*c\v = max
If max <> 0.0
delta = max - min
; get saturation
*c\s = delta/max
; get hue
If delta <> 0.0
If r = max
*c\h = (g-b)/delta
ElseIf g = max
*c\h = 2.0 + (b-r)/delta
ElseIf b = max
*c\h = 4.0 + (r-g)/delta
EndIf
*c\h * 60.0
If *c\h<0.0
*c\h + 360.0
EndIf
Else
; it's a gray-tone
*c\h = 0 ; *c\h is even undefined
EndIf
Else
; it's black
*c\s = 0
*c\h = 0 ; *c\h is even undefined
EndIf
*c\type = #COLOR_HSV
ProcedureReturn *c
EndProcedure
ProcedureDLL.l CMY2HSV(*c.Color) ; converts CMY-color *c to HSV and returns *c. No check if CMY is made!
; treat as RGB-color
RGB2HSV(*c)
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSL2HSV(*c.Color) ; converts HSL-color *c to HSV and returns *c. No check if HSL is made!
ProcedureReturn RGB2HSV(HSL2RGB(*c)) ; it's the easiest, though not fastet way
EndProcedure
ProcedureDLL.l Color2HSV(*c.Color) ; converts *c from any color-type to HSV And returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn RGB2HSV(*c)
Case #COLOR_CMY : ProcedureReturn CMY2HSV(*c)
Case #COLOR_HSV : ProcedureReturn *c
Case #COLOR_HSL : ProcedureReturn HSL2HSV(*c)
EndSelect
EndProcedure
ProcedureDLL.l ColorSetHSV(*c.Color, h.f, s.f, v.f) ; sets *c to the HSV-color given by h in range [0.0, 360.0] and s,v in range [0.0, 1.0] (no check is made) and returns *c
If h = 360.0
h = 0
EndIf
*c\h = h
*c\s = s
*c\v = v
*c\type = #COLOR_HSV
ProcedureReturn *c
EndProcedure
;- change color to HSL
ProcedureDLL.l RGB2HSL(*c.Color) ; converts RGB-color *c to HSL and returns *c. No check if RGB is made!
Protected r.f, g.f, b.f, max.f, min.f, delta.f
r = *c\r
g = *c\g
b = *c\b
max = Max3F(r,g,b)
min = Min3F(r,g,b)
delta = max - min
If delta <> 0.0
; get lightness
*c\l = (max + min) / 2.0
; get saturation
If *c\l <= 0.5
*c\s = delta/(max+min)
Else
*c\s = delta/(2-max-min)
EndIf
; get hue
If r = max
*c\h = (g-b)/delta
ElseIf g = max
*c\h = 2.0 + (b-r)/delta
ElseIf b = max
*c\h = 4.0 + (r-g)/delta
EndIf
*c\h * 60.0
If *c\h<0.0
*c\h + 360.0
EndIf
Else
; it's black
*c\s = 0
*c\h = 0 ; *c\h is even undefined
EndIf
*c\type = #COLOR_HSL
ProcedureReturn *c
EndProcedure
ProcedureDLL.l CMY2HSL(*c.Color) ; converts CMY-color *c to HSL and returns *c. No check if CMY is made!
; treat as RGB-color
RGB2HSL(*c)
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSV2HSL(*c.Color) ; converts HSV-color *c to HSL and returns *c. No check if HSV is made!
ProcedureReturn RGB2HSL(HSV2RGB(*c)) ; it's the easiest, though not fastet way
EndProcedure
ProcedureDLL.l Color2HSL(*c.Color) ; converts *c from any color-type to HSL and returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn RGB2HSL(*c)
Case #COLOR_CMY : ProcedureReturn CMY2HSL(*c)
Case #COLOR_HSV : ProcedureReturn HSV2HSL(*c)
Case #COLOR_HSL : ProcedureReturn *c
EndSelect
EndProcedure
ProcedureDLL.l ColorSetHSL(*c.Color, h.f, l.f, s.f) ; sets *c to the HSL-color given by h in range [0.0, 360.0[ and l,s in range [0.0, 1.0] (no check is made) and returns *c
*c\h = h
*c\l = l
*c\s = s
*c\type = #COLOR_HSL
ProcedureReturn *c
EndProcedure
;- change color to PureBasic's RGB
ProcedureDLL.l ColorRGBFast(*c.Color) ; converts *c to RGB and returns a Purebasic-RGB-colorcode same as returned by PB's RGB()
Color2RGB(*c)
ProcedureReturn RGB(255 * *c\r, 255 * *c\g, 255 * *c\b)
EndProcedure
ProcedureDLL.l ColorRGB(*c.Color) ; converts an internal copy of *c to RGB and returns a Purebasic-RGB-colorcode same as returned by PB's RGB()
Protected *cc.Color, rgb.l
*cc = ColorCopy(*c)
Color2RGB(*cc)
rgb = RGB(255 * *cc\r, 255 * *cc\g, 255 * *cc\b)
FreeMemory(*cc)
ProcedureReturn rgb
EndProcedure
;-
;- debug test functionality
;-
Procedure.l DebugTestFunctionality()
; RGB <-> CMY
For i=0 To 10000
ColorSetRGB(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2RGB(Color2CMY(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR RGB <-> CMY"
End
EndIf
FreeMemory(*c2)
Next
; RGB <-> HSV
For i=0 To 10000
ColorSetRGB(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2RGB(Color2HSV(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR RGB <-> HSV"
End
EndIf
FreeMemory(*c2)
Next
; RGB <-> HSL
For i=0 To 10000
ColorSetRGB(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2RGB(Color2HSL(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR RGB <-> HSL"
End
EndIf
FreeMemory(*c2)
Next
; CMY <-> HSV
For i=0 To 10000
ColorSetCMY(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2CMY(Color2HSV(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR CMY <-> HSV"
End
EndIf
FreeMemory(*c2)
Next
; CMY <-> HSL
For i=0 To 10000
ColorSetCMY(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2CMY(Color2HSL(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR CMY <-> HSL"
End
EndIf
FreeMemory(*c2)
Next
; HSV <-> HSL
For i=0 To 10000
ColorSetHSV(c.Color, Random(360)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2HSV(Color2HSL(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR HSV <-> HSL"
End
EndIf
FreeMemory(*c2)
Next
Debug "All Tests done."
EndProcedure
;Goto example3
;-
;- example 1
;-
example1:
ColorSetRGB(rgbCol.Color, 0.0, 0.0, 1.0) ; full blue
s.s = "Create blue, decrease its saturation towards gray and move it" + #CRLF$
s.s + "slightly towards green without changing it's intensity" + #CRLF$ + #CRLF$
s.s + "Original color: " + ColorToStr(rgbCol) + #CRLF$
; we dont' like this green, we want to make it a little bit darker and remove it's saturation
Color2HSL(rgbCol)
s.s + "Original color: " + ColorToStr(rgbCol) + #CRLF$
rgbCol\h - 30 ; be careful to stay in range [0, 360[. Here we know h is 240
rgbCol\s = 0.5
s.s + "Modified color: " + ColorToStr(rgbCol) + #CRLF$
Color2RGB(rgbCol)
s.s + "Modified color: " + ColorToStr(rgbCol) + #CRLF$
MessageRequester("Color example 1/3:", s)
MessageRequester("Color example 2/3:", "Click OK to run a HSL-demonstration in fullscreen.")
;-
;- example 2
;-
example2:
InitSprite()
InitKeyboard()
OpenScreen(1024, 768, 32, "Color-example")
framecounter = 0
fps = 0
lastFrametimer = 0
Repeat
; fps-calculation
framecounter+1
If ElapsedMilliseconds() - lastFrametimer > 1000
fps = framecounter
framecounter = 0
lastFrametimer = ElapsedMilliseconds()
EndIf
; draw the colorbars
ClearScreen(RGB(0, 0, 50))
StartDrawing(ScreenOutput())
FrontColor(RGB(255,255,255))
DrawingMode(1)
DrawText(10,10, "HSL-colors for 1.440.000 individual colored pixels at " + Str(fps) + " fps. Press ESC to exit.")
; create 1.440.000 combinations of hue, sat and lightness and display them
sat.f = 0.05
While sat <= 1.0
lig.f = 0
While lig <= 1.0
hue.f = 0
While hue < 360.0
; create a new hsl-colored pixel (you might fill your structure manually, too)
ColorSetHSL(HSLCol.Color, hue, sat, lig)
; draw it on the screen after converting to PB's RGB
Plot(152 + 2*hue, 180 + 20*lig + 400*sat, ColorRGBFast(HSLCol))
hue + 0.5
Wend
lig + 0.05
Wend
sat + 0.1
Wend
StopDrawing()
FlipBuffers()
Delay(10)
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
;-
;- example 3
;-
example3:
Procedure.l GetContrastedPBColor(red.l, green.l, blue.l)
Protected col.Color
ColorSetRGB(col.Color, red/255.0, green/255.0, blue/255.0)
Color2HSV(col)
ColorComplement(col) ; build the normal complement
; modify saturation and value
; you might experiment with those to achieve other results
col\s + 0.5
If col\s > 1.0
col\s - 1.0
EndIf
col\v + 0.5
If col\v > 1.0
col\v - 1.0
EndIf
Color2RGB(col)
ProcedureReturn RGB(col\r*255, col\g*255, col\b*255)
EndProcedure
CreateImage(0, 500, 500)
For i=0 To 9
Select i
Case 0 : col.l = $000000
Case 1 : col.l = $FFFFFF
Case 2 : col.l = $7F7F7F
Case 3 : col.l = $660000
Case 4 : col.l = $00FF00
Case 5 : col.l = $000033
Case 6 : col.l = $FF9900
Case 7 : col.l = $FF33FF
Case 8 : col.l = $3754A9
Case 9 : col.l = $9F3F20
EndSelect
contrCol = GetContrastedPBColor(Red(col), Green(col), Blue(col))
StartDrawing(ImageOutput(0))
Box(0, i*50, 500, 50, col)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(10, i*50 + 20, "This is just an example-text in a color contrasted to the background", contrCol)
StopDrawing()
Next
OpenWindow(0, 0, 0, 500, 500, "Color example 3/3:")
ImageGadget(0, 0, 0, 500, 500, ImageID(0))
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindowCréé le 24 mars 2011 par Froggerprogger
Sélectionnez
;********************************
;*
;* LOTUS DEMO
;* djes 28/03/2011
;*
;********************************
Procedure FilterCallback(x, y, SourceColor, TargetColor)
r.l = (0.5 * Sqr((x - 64) * (x - 256) + (y - 256) * (y - 256) ))
v.l = (0.5 * Sqr((x - 256) * (x - 64) + (y - 256) * (y - 64) ))
b.l = (0.5 * Sqr((x - 256) * (x - 256) + (y - 64) * (y - 256) ))
a.l = (256 * (512 - Sqr((x - 256) * (x - 256) + (y - 256) * (y - 256) )))
u%255
ProcedureReturn RGBA(r, v, b, a)
EndProcedure
If InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester("Error", "Sprite system can't be initialized", 0)
End
EndIf
If InitSprite3D() = 0
MessageRequester("Error", "Sprite3D system can't be initialized correctly", 0)
End
EndIf
If OpenWindow(0, 0, 0, 512, 512, "Un écran dans une fenêtre...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0), 0, 0, 512, 512, 0, 0, 0)
If CreateImage(0, 512, 512, 32) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0, 0, 512, 512, $00000000)
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@FilterCallback())
Circle( 256, 256, 256 )
StopDrawing()
EndIf
If StartDrawing(ScreenOutput())
DrawImage(ImageID(0), 0, 0)
StopDrawing()
EndIf
GrabSprite(0, 0, 0, 512, 512, #PB_Sprite_Texture|#PB_Sprite_AlphaBlending)
For u = 0 To 31
CreateSprite3D(u, 0)
Next u
Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)
i.f = 0
bl_src = 2
bl_dst = 6
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_Gadget
If EventGadget() = 0
End
EndIf
Case #PB_Event_CloseWindow
End
EndSelect
FlipBuffers()
ClearScreen(RGB(0,50,128))
If Start3D()
Sprite3DBlendingMode(bl_src, bl_dst)
For u = 0 To 31
w = 512 * Sin(i + u * 5)
h = 512 * Sin(i + u * 5)
ZoomSprite3D(u, w, h)
RotateSprite3D(u, i * 100 + u * 5, 0)
DisplaySprite3D(u, 256 - w / 2 - 8 * Sin(i * u), 256 - h / 2 - 8 * Cos(i * u), 127)
Next u
Stop3D()
EndIf
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Up)
bl_src + 1
EndIf
If KeyboardReleased(#PB_Key_Down)
bl_src - 1
EndIf
If KeyboardReleased(#PB_Key_Left)
bl_dst + 1
EndIf
If KeyboardReleased(#PB_Key_Right)
bl_dst - 1
EndIf
i+0.01
Until KeyboardPushed(#PB_Key_Escape)
Else
MessageRequester("Erreur", "Can't open a screen !", 0)
End
EndIf
Else
MessageRequester("Error", "Can't open a window !", 0)
EndIf
EndCréé le 29 mars 2011 par djes
Cover Flow est une interface utilisateur tridimensionnelle servant à naviguer dans une bibliothèque (de musique, d'image, ...)
via des représentations graphiques signifiantes (pochettes d'albums, image réduite,...).
C'est un bon exemple de manipulation des images, il faudrait tenter d'obtenir le même effet avec des sprite3D, qui s'y colle ?
Sélectionnez
EnableExplicit
; Mit 'UseRealAplhaMirror = #True' kann festgelegt werden, ob ein Spiegelbild mit ECHTEM Alpha-Kanal erstellt und genutzt werden soll, oder nicht.
; Andernfalls wird 'nur' ein Spiegelbild erstellt, welches auf eine feste Hintergrundfarbe 'geblendet' wird.
; (Die letztgenannte Methode hat den Vorteil, dass Bilder mit diesem Spiegelbild nahezu ohne Performanceeinbussen verkleinert dargestellt werden können.)
; Define UseRealAplhaMirror = #True
Define UseRealAplhaMirror = #False
Define TempDir.s = GetTemporaryDirectory()
Define Quit = #True
Define DeleteCoverImages = #False; #True
Define ScrWidth = 800
Define ScrHeight = 600
Define ScrXCenter = 400
Define ScrYCenter = 300
Define LoopHeight = 70
Define LoopWidth = 300
Define CoverURL.s
Define Covers.l
Define AktWinkel.f
Define OldWinkel.f = -1
Define WinkelSchrittweite.f
Define DoFShrink.f = 0.2
Define FrameColor.l = $ff0000
Define DummyImage.i
Define HintergrundFarbe = $0 ; $400000
Define n
Structure str_CoverZBuffer
ImageID.i
XPos.l
YPos.f
Zoom.f
Width.l
Height.l
CoverName.s
EndStructure
NewList CoverFiles.s()
;{ Flip-Image Procedures by Balatro. => http://www.purebasic.fr/english/viewtopic.php?t=25276&highlight=image+mirror
Procedure CopyImageToMemory(ImageNumber, Memory)
Protected TemporaryDC.L, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
TemporaryBitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
TemporaryBitmapInfo\bmiHeader\biWidth = TemporaryBitmap\bmWidth
TemporaryBitmapInfo\bmiHeader\biHeight = -TemporaryBitmap\bmHeight
TemporaryBitmapInfo\bmiHeader\biPlanes = 1
TemporaryBitmapInfo\bmiHeader\biBitCount = 32
TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
GetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
DeleteDC_(TemporaryDC)
EndProcedure
Procedure CopyMemoryToImage(Memory, ImageNumber)
Protected TemporaryDC.L, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
TemporaryBitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
TemporaryBitmapInfo\bmiHeader\biWidth = TemporaryBitmap\bmWidth
TemporaryBitmapInfo\bmiHeader\biHeight = -TemporaryBitmap\bmHeight
TemporaryBitmapInfo\bmiHeader\biPlanes = 1
TemporaryBitmapInfo\bmiHeader\biBitCount = 32
TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
DeleteDC_(TemporaryDC)
EndProcedure
Procedure Flip(ImageNumber)
Protected MemorySize, *MemoryOrigin, *MemoryTarget
Protected Origin, Target, W, H, X, Y
MemorySize = (ImageWidth(ImageNumber) * ImageHeight(ImageNumber) << 2)
*MemoryOrigin = AllocateMemory(MemorySize)
*MemoryTarget = AllocateMemory(MemorySize)
CopyImageToMemory(ImageNumber, *MemoryOrigin)
W = ImageWidth(ImageNumber)
H = ImageHeight(ImageNumber)
For Y = 0 To H - 1
For X = 0 To W - 1
Origin = (Y * W + X) << 2
Target = ((H - Y - 1) * W + X) << 2
PokeL(*MemoryTarget + Target, PeekL(*MemoryOrigin + Origin))
Next
Next
CopyMemoryToImage(*MemoryTarget, ImageNumber)
FreeMemory(*MemoryOrigin)
FreeMemory(*MemoryTarget)
EndProcedure
;}
Procedure AddAlphaMirrorToImage(ImageNum, HeightPercentage, MirrorOffest = 0, StartBlend = 40, EndBlend = 100)
Protected MirrorImage.i = CopyImage(ImageNum, #PB_Any)
Protected MirrorHeight.l = ImageHeight(ImageNum) * HeightPercentage / 100
Protected OrigImageHeight.l = ImageHeight(ImageNum)
Protected OrigImageWidth.l = ImageWidth(ImageNum)
Protected ActBlend.f = 255-(2.55 * StartBlend)
Protected BlendStep.f = (2.55 * (EndBlend-StartBlend)) / MirrorHeight
Protected n.l
CreateImage(ImageNum,ImageWidth(ImageNum),OrigImageHeight+MirrorHeight+MirrorOffest,32)
If StartDrawing(ImageOutput(ImageNum))
DrawImage(ImageID(MirrorImage),0,0)
ResizeImage(MirrorImage,ImageWidth(MirrorImage),MirrorHeight)
Flip(MirrorImage)
DrawImage(ImageID(MirrorImage),0,OrigImageHeight+MirrorOffest)
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0, OrigImageHeight, OrigImageWidth, MirrorHeight+MirrorOffest, $00000000)
For n = OrigImageHeight+MirrorOffest To ImageHeight(ImageNum)
LineXY(0,n,OrigImageWidth,n,RGBA(0,0,0,ActBlend))
ActBlend - BlendStep
Next
StopDrawing()
EndIf
EndProcedure
Procedure AddMirrorToImage(ImageNum, HeightPercentage, BGColor = 0, MirrorOffest = 0, StartBlend = 40, EndBlend = 100)
Protected MirrorImage.i = CopyImage(ImageNum, #PB_Any)
Protected MirrorHeight.l = ImageHeight(ImageNum) * HeightPercentage / 100
Protected OrigImageHeight.l = ImageHeight(ImageNum)
Protected OrigImageWidth.l = ImageWidth(ImageNum)
Protected ActBlend.f = 255 - (2.55 * StartBlend)
Protected BlendStep.f = (2.55 * (EndBlend-StartBlend)) / MirrorHeight
Protected n.l
ResizeImage(ImageNum,ImageWidth(ImageNum),OrigImageHeight+MirrorHeight+MirrorOffest)
If StartDrawing(ImageOutput(ImageNum))
Box(0, 0, OrigImageWidth, ImageHeight(ImageNum), BGColor)
DrawImage(ImageID(MirrorImage),0,0)
ResizeImage(MirrorImage,ImageWidth(MirrorImage),MirrorHeight)
Flip(MirrorImage)
DrawImage(ImageID(MirrorImage),0,OrigImageHeight+MirrorOffest)
DrawingMode(#PB_2DDrawing_AlphaBlend)
For n = OrigImageHeight+MirrorOffest To ImageHeight(ImageNum)
LineXY(0,n,OrigImageWidth,n,RGBA(Red(BGColor),Green(BGColor),Blue(BGColor),ActBlend))
ActBlend - BlendStep
Next
StopDrawing()
EndIf
EndProcedure
; Read URL from DataSection and Download Cover Images from Internet
InitNetwork()
UseJPEGImageDecoder()
Restore CoverFileNames
Read.s CoverURL
While CoverURL <> ""
AddElement(CoverFiles())
CoverFiles() = TempDir+GetFilePart(CoverURL)
If FileSize(CoverFiles()) <= 0
If ReceiveHTTPFile(CoverURL, CoverFiles())
LoadImage(ListSize(CoverFiles())-1,CoverFiles())
If UseRealAplhaMirror
AddAlphaMirrorToImage(ListSize(CoverFiles())-1,40,10,80,100)
Else
AddMirrorToImage(ListSize(CoverFiles())-1,40,HintergrundFarbe,10,20,0)
EndIf
Else
DeleteElement(CoverFiles())
EndIf
Else
LoadImage(ListSize(CoverFiles())-1,CoverFiles())
If UseRealAplhaMirror
AddAlphaMirrorToImage(ListSize(CoverFiles())-1,40,10,80,100)
Else
AddMirrorToImage(ListSize(CoverFiles())-1,40,HintergrundFarbe,10,20,0)
EndIf
EndIf
Read.s CoverURL
Wend
Covers = ListSize(CoverFiles())
If Covers < 1
Debug "Es konnten keine Cover-Bilder geladen werden."
End
EndIf
InitSprite()
InitKeyboard()
InitMouse()
Dim CoverZBuff.str_CoverZBuffer(Covers-1)
If OpenWindow(0,0,0,ScrWidth,ScrHeight,"Medien-Bibliothek (press ESC to exit)",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0),0,0,ScrWidth,ScrHeight,0,0,0)
Quit = #False
EndIf
EndIf
While Not Quit
WaitWindowEvent(2)
ExamineKeyboard()
ExamineMouse()
AktWinkel + 0.01 * MouseDeltaX()
If AktWinkel <> OldWinkel
Define starttime.i = ElapsedMilliseconds()
ClearScreen(HintergrundFarbe)
WinkelSchrittweite = #PI * 2 / Covers
If StartDrawing(ScreenOutput())
; =============================================================================================
Plot(0,0,0) ; <= BUG in PB !!! Ohne den Plot()-Befehl wird kein ClearScreen() ausgeführt !!!
; =============================================================================================
; Position und Größe der Cover an Hand der aktuellen Drehung (AktWinkel) berechnen
For n = 0 To Covers-1
CoverZBuff(n)\ImageID = n
CoverZBuff(n)\Zoom = DoFShrink + (Cos(AktWinkel + n * WinkelSchrittweite) + 1) * (1-DoFShrink) / 2
CoverZBuff(n)\Width = ImageWidth(n) * CoverZBuff(n)\Zoom
CoverZBuff(n)\Height = ImageHeight(n) * CoverZBuff(n)\Zoom
CoverZBuff(n)\XPos = ScrXCenter + Sin(AktWinkel + n * WinkelSchrittweite) * LoopWidth - CoverZBuff(n)\Width/2
CoverZBuff(n)\YPos = ScrYCenter + Cos(AktWinkel + n * WinkelSchrittweite) * LoopHeight - CoverZBuff(n)\Height/2
SelectElement(CoverFiles(),n)
CoverZBuff(n)\CoverName = GetFilePart(CoverFiles())
CoverZBuff(n)\CoverName = Left(CoverZBuff(n)\CoverName, Len(CoverZBuff(n)\CoverName)-4)
Next
; Sortieren nach Y-Position der Cover, um Überlappungen korrekt darzustellen.
SortStructuredArray(CoverZBuff(), #PB_Sort_Ascending, OffsetOf(str_CoverZBuffer\YPos), #PB_Sort_Float)
DrawingMode(#PB_2DDrawing_AlphaBlend)
For n = 0 To Covers-1
If UseRealAplhaMirror
; ------ Anzeige der Images mit ECHTEM Alpha-Kanal Spiegelbild -------
; Da ein AlphaImage nicht "on-the-fly" gezoomed werden kann, wird hier ein Dummy-Image erzeugt, welches dann verkleinert wird.
; Dieser Vorgang kostet extrem viel Zeit, wodurch die Framerate stark sinkt.
DummyImage = CopyImage(CoverZBuff(n)\ImageID, #PB_Any)
ResizeImage(DummyImage, CoverZBuff(n)\Width, CoverZBuff(n)\Height)
DrawAlphaImage(ImageID(DummyImage),CoverZBuff(n)\XPos, CoverZBuff(n)\YPos)
FreeImage(DummyImage)
; Sollte die "on-the-fly" Verkleinerung nicht benötigt werden, so kann nachfolgende Zeile statt der vorstehenden 4 Zeilen aktiviert werden.
; hierdurch steigt die Performance enorm - trotz Spiegelbild mit ECHTEM Alpha-Kanal.
; DrawAlphaImage(ImageID(CoverZBuff(n)\ImageID),CoverZBuff(n)\XPos, CoverZBuff(n)\YPos)
Else
; ------ Anzeige der Images mit Spiegelbild, welches auf einen einfarbigen Hintergrund geblendet wurde -------
DrawImage(ImageID(CoverZBuff(n)\ImageID),CoverZBuff(n)\XPos, CoverZBuff(n)\YPos, CoverZBuff(n)\Width, CoverZBuff(n)\Height)
EndIf
Next
DrawingMode(#PB_2DDrawing_Transparent)
DrawText((ScrWidth-TextWidth(CoverZBuff(n-1)\CoverName))/2, ScrHeight - 30, CoverZBuff(n-1)\CoverName, $888888, $0)
DrawText(10,ScrHeight - 30,Str(ElapsedMilliseconds()-starttime)+"ms/Frame",$444444)
StopDrawing()
EndIf
FlipBuffers()
OldWinkel = AktWinkel
EndIf
If KeyboardPushed(#PB_Key_Escape)
Quit = #True
EndIf
Wend
; ggfl. die heruntergeladenen Cover wieder löschen
If DeleteCoverImages
ForEach CoverFiles()
DeleteFile(CoverFiles())
Next
EndIf
DataSection
CoverFileNames:
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-the-best-of-volume-1-cover-8981.jpg"
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-a-broken-frame-cover-8980.jpg"
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-music-for-the-masses-cover-8977.jpg"
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-construction-time-again-cover-8974.jpg"
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-the-singles-81-98-cover-8972.jpg"
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-speak-and-spell-cover-8976.jpg"
Data.s "http://www.fan-lexikon.de/musik/depeche-mode/bilder/m/depeche-mode-violator-cover-8978.jpg"
Data.s "http://www.fan-lexikon.de/musik/seal/bilder/m/seal-i-cant-stand-the-rain-cover-9837.jpg"
Data.s "http://www.fan-lexikon.de/musik/seal/bilder/m/seal-soul-cover-9826.jpg"
Data.s "http://www.fan-lexikon.de/musik/seal/bilder/m/seal-amazing-single-cover-4416.jpg"
Data.s ""
Data.s ""
Data.s ""
Data.s ""
Data.s ""
Data.s ""
Data.s ""
EndDataSectionCréé le 30 mars 2011 par PureLust