Verfasst: 15.02.2009 21:34
grundsätzlich wäre es da einfacher, dir ein Grafikprogramm wie PhotoFiltre oder Paint.Net oder sowas zu installieren.
sowas braucht man immer mal wieder.
sowas braucht man immer mal wieder.
PureBoard
Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Gibt es Farberkenner für Anwedungen
Seite 2 von 3
Verfasst: 15.02.2009 21:44
Dafür benutz ich Pix
Verfasst: 15.02.2009 21:50
ich habe mir vor lange Zeit mal das geschrieben:
Code: Alles auswählen
Global *Mem = AllocateMemory(1024)
Procedure.l DesktopOutput()
PokeL(*Mem, 1) : ProcedureReturn *Mem
EndProcedure
ExamineDesktops()
Schrift = LoadFont(1, "Courier New Fett", 8, #PB_Font_Bold)
OpenWindow(0, 0, 0, 120, 32,"Farbe", #PB_Window_BorderLess)
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 1)
StickyWindow(0, 1) : SetGadgetFont(-1, Schrift)
TextGadget(11, 0,0,40,16,"0",#PB_Text_Center) : SetGadgetColor(11, #PB_Gadget_BackColor, $A0A0F0)
TextGadget(12, 40,0,40,16,"0",#PB_Text_Center) : SetGadgetColor(12, #PB_Gadget_BackColor, $A0F0A0)
TextGadget(13, 80,0,40,16,"0",#PB_Text_Center) : SetGadgetColor(13, #PB_Gadget_BackColor, $F0A0A0)
TextGadget(21, 0,16,60,16,"$000000",#PB_Text_Center) : SetGadgetColor(21, #PB_Gadget_BackColor, $F0F0A0)
TextGadget(22, 60,16,60,16,"#000000",#PB_Text_Center) : SetGadgetColor(22, #PB_Gadget_BackColor, $A0F0F0)
Repeat
Mx = DesktopMouseX() : My = DesktopMouseY()
StartDrawing(DesktopOutput())
P = Point(Mx,My)
StopDrawing()
x = Mx+15
y = My+20
If Mx+15+120 > DesktopWidth(0)
x = DesktopWidth(0)-90
EndIf
If My+20+32 > DesktopHeight(0)
y = DesktopHeight(0)-20
EndIf
ResizeWindow(0, x, y, #PB_Ignore, #PB_Ignore)
Event = WaitWindowEvent(10)
If Event = #PB_Event_Menu
If EventMenu() = 1 : End : EndIf
EndIf
SetGadgetText(11, Str(Red(P)))
SetGadgetText(12, Str(Green(P)))
SetGadgetText(13, Str(Blue(P)))
SetGadgetText(21, "$"+RSet(Hex(P),6,"0"))
SetGadgetText(22, "#"+RSet(Hex(RGB(Blue(P),Green(P),Red(P))),6,"0"))
ForEver
Verfasst: 15.02.2009 21:53
Ma ey! Jetzt hab ich meins Dynamsich gemacht!
Code: Alles auswählen
Procedure.l GetImageRGB(ImagePfad$, x, y)
Enumeration
#Image
EndEnumeration
Global Farbe
Global ReturnVal
Count = CountString(ImagePfad$, ".")
out$ = StringField(ImagePfad$, Count+1, ".")
Format$ = LCase(out$)
If Format$ = "jpg"
UseJPEGImageDecoder()
ElseIf Format$ = "png"
UsePNGImageDecoder()
ElseIf Format$ = "tiff"
UseTIFFImageDecoder()
ElseIf Format$ = "tga"
UseTGAImageDecoder()
EndIf
ReturnVal = LoadImage(#Image, ImagePfad$)
StartDrawing(ImageOutput(#Image))
Farbe = Point(x, y)
StopDrawing()
ProcedureReturn Farbe
EndProcedure
; Beispiel
GetImageRGB("x.jpg", 5, 5)
If ReturnVal = 0
MessageRequester("GetImageRGB", "Error, die Datei exsitiert nicht oder ist im falschen Format"+Chr(13)+"Erlaubte Formate: bmp, ico, jpg, png, tiff, tga")
Else
MessageRequester("GetImageRGB", "Farbe wurde erfolgreif ermittelt! Farbe: "+Str(Farbe))
EndIf
Verfasst: 15.02.2009 22:14
Könnt ihr den Clown mal wegsperren, der geht mir auf die Nüsse.
Verfasst: 15.02.2009 22:17
Was hab ich denn jetzt schon wieder gemacht?
Verfasst: 15.02.2009 23:12
Das sieht mir äußerst seltsam aus..
Enumeration in Procedure, ImageDecoder wenn überhaupt erst nach If,
diverse Rechtschreibfehler, usw..
Hier ich habe auch mal eine Frage an dich, php-freak:
Ist dein Code überhaupt funktionsfähig?
Enumeration in Procedure, ImageDecoder wenn überhaupt erst nach If,
diverse Rechtschreibfehler, usw..
Hier ich habe auch mal eine Frage an dich, php-freak:
Ist dein Code überhaupt funktionsfähig?
Verfasst: 16.02.2009 08:07
Dert funktioniert wie ne 1!
Verfasst: 16.02.2009 10:22
Verfasst: 16.02.2009 13:12
* PUZZLE * wasn hier los? ich dachte das wär die Laberecke?
*gleich mal nach "Anfänger" verschieb*
... also zum Kot:
1. Enumerations ganz an den Anfang, die müssen nur einmal beim Compilieren erledigt werden.
2. die Decoder ebenfalls alle ganz an den Anfang.
die brauchen auch nur eingebunden zu werden, nicht einzeln aufgerufen.