Luma : Helligkeit

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Olaf
Beiträge: 117
Registriert: 20.04.2006 14:51
Wohnort: 66606 St.Wendel (Niederlinxweiler, Dr.Albert-Schweitzer-Str.9)
Kontaktdaten:

Luma : Helligkeit

Beitrag von Olaf »

8) Hi Leute, hab mal Code geschrieben für ne echte Grautonumwandlung.
Das geht mit der Helligkeit der Farbe (Berechnung mit den Werten vom Farbsystem YCrCb). Eine Annäherung an die tatsächliche Helligkeit erhält man jedoch auch mit Helligkeit=(R+G+B)/3.
Bei YCrCb wird jedoch berüksichtigt, das z.B. Blau sehr wenig an Helligkeit bringt, Rot jedoch viel und Grün am meisten.
Folglich muss die RGB-basierte Helligkeitsbestimmung nur noch 'n paar
Koeffizienten bekommen:
Helligkeit=R*0.299+G*0.587+B*0.114
Natürlich kann das neue Bild auch mit anderen Farbtabellen hochgerechnet werden.
=>Tolle Effekte:
Feuer, Regenbogen,... :-)

Code: Alles auswählen

Enumeration
  #Window
  #Scroll
  #Gadget1
  #Gadget2
  
  #Option
  #Selection
  #OK
  
  #Image
  #NewImage
EndEnumeration

Global lumared.d=0.299,lumagreen.d=0.587,lumablue.d=0.114,state

Procedure Luma(color)
  y=Int(lumared*Red(color)+lumagreen*Green(color)+lumablue*Blue(color))
  ProcedureReturn y
EndProcedure

Procedure Fire(y)
  If y<86
    color=RGB(y*3,0,0)
  ElseIf y>85 And y<170
    color=RGB(255,(y-85)*3,0)
  ElseIf y>169 And y<256
    color=RGB(255,255,(y-170)*3)
  EndIf
  ProcedureReturn color
EndProcedure

Procedure Ocean(y)
  If y<86
    color=RGB(0,0,y*3)
  ElseIf y>85 And y<170
    color=RGB(0,(y-85)*3,255)
  ElseIf y>169 And y<256
    color=RGB((y-170)*3,255,255)
  EndIf
  ProcedureReturn color
EndProcedure

Procedure Outside(y)
  If y<86
    color=RGB(0,y*3,0)
  ElseIf y>85 And y<170
    color=RGB(0,255,(y-85)*3)
  ElseIf y>169 And y<256
    color=RGB((y-170)*3,255,255)
  EndIf
  ProcedureReturn color
EndProcedure

Procedure Lila(y)
  If y<86
    color=RGB(0,0,y*3)
  ElseIf y>85 And y<170
    color=RGB((y-85)*3,0,255)
  ElseIf y>169 And y<256
    color=RGB(255,(y-170)*3,255)
  EndIf
  ProcedureReturn color
EndProcedure

Procedure Rainbow(y)
  y=255-y
  If y<51
    color=RGB(255,5*y,0)
  ElseIf y>50 And y<102
    color=RGB(255-5*(y-1*51),255,0)
  ElseIf y>101 And y<153
    color=RGB(0,255,5*(y-2*51))
  ElseIf y>152 And y<204
    color=RGB(0,255-5*(y-3*51),255)
  ElseIf y>203 And y<256
    color=RGB(5*(y-4*51),0,255)
  EndIf
  ProcedureReturn color
EndProcedure

Procedure Grey(y)
  color=RGB(y,y,y)
  ProcedureReturn color
EndProcedure

Procedure WrongColor(y)
  color=RGB(y,y*Sqr(10),y*10)
  ProcedureReturn color
EndProcedure

Procedure All(y)
  Select state
  Case 0
    color=Fire(y)
  Case 1
    color=Ocean(y)
  Case 2
    color=Outside(y)
  Case 3
    color=Lila(y)
  Case 4
    color=Rainbow(y)
  Case 5
    color=Grey(y)
  Case 6
    color=WrongColor(y)
  EndSelect
  ProcedureReturn color
EndProcedure

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()

start:

Image$=OpenFileRequester("Öffnen","","Bilddateien|*.bmp;*.ico;*.png;*.jpg;*.tga",0)

If Image$=""
  End
EndIf

If LoadImage(#Image,Image$)
  
  width=ImageWidth(#Image)
  height=ImageHeight(#Image)
  
  Dim Color.l(width,height)
  
  StartDrawing(ImageOutput(#Image))
  For x=0 To width
    For y=0 To height
      Color(x,y)=Point(x,y)
    Next y
  Next x
  StopDrawing()
  
  OpenWindow(#Option,0,0,200,40,"Schema",#PB_Window_ScreenCentered)
  CreateGadgetList(WindowID(#Option))
  ComboBoxGadget(#Selection,0,0,200,120)
  AddGadgetItem(#Selection,0,"Fire")
  AddGadgetItem(#Selection,1,"Ocean")
  AddGadgetItem(#Selection,2,"Outside")
  AddGadgetItem(#Selection,3,"Lila")
  AddGadgetItem(#Selection,4,"Rainbow")
  AddGadgetItem(#Selection,5,"Grey")
  AddGadgetItem(#Selection,6,"WrongColor")
  SetGadgetState(#Selection,state)
  ButtonGadget(#OK,0,20,200,20,"Start")
  Repeat
    event=WaitWindowEvent()
    Select event
    Case #PB_Event_Gadget
      Select EventGadget()
      Case #Selection
        state=GetGadgetState(#Selection)
      Case #OK
        Break
      EndSelect
    EndSelect
  Until event=#PB_Event_CloseWindow
  CloseWindow(#Option)
  
  CreateImage(#NewImage,width,height)
  StartDrawing(ImageOutput(#NewImage))
  For x=0 To width
    For y=0 To height
      Plot(x,y,All(Luma(Color(x,y))))
    Next y
  Next x
  StopDrawing()
  
  OpenWindow(#Window,0,0,1024,708,"Luma - Fire",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
  CreateGadgetList(WindowID(#Window))
  ScrollAreaGadget(#Scroll,0,0,1024,708,width*2,height,1,#PB_ScrollArea_Center|#PB_ScrollArea_BorderLess)
  ImageGadget(#Gadget1,0,0,width,height,ImageID(#NewImage))
  ImageGadget(#Gadget2,width,0,width,height,ImageID(#Image))
  Repeat
    event=WaitWindowEvent()
  Until event=#PB_Event_CloseWindow
  CloseWindow(#Window)
EndIf
Goto start
-----------
bobobo hat die Einrückungen "schöner" gemacht
PB 4.xx (Windows & Linux & Mac OS X)
Treffen sich 2 Kurven in der Unendlichkeit. Sagt die eine zur anderen: "Hau ab aus meinem Definitionsbereich oder ich leite dich ab!"
Darauf die andere: "Mach nur! Ich bin die e-Funktion." :lol:
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

ich seh in der vorletzten zeile ein EndIf, kann aber das If nicht finden.
die einrückungen könnten besser gegliedert sein.

und wieso ein Goto? Repeat:ForEver täts auch, mal davon ab das man auch ganz am Ende ein
Until EventID=#PB_Event_CloseWindow setzen kann...

hm.. das hast du ja sogar drin... wieso springst du dann wieder an den start?
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Benutzeravatar
#NULL
Beiträge: 2238
Registriert: 20.04.2006 09:50

Beitrag von #NULL »

sieht gut aus,
aber bei so etwas:

Code: Alles auswählen

CreateImage(#NewImage,width,height)
StartDrawing(ImageOutput(#NewImage))
For x=0 To width
   For y=0 To height
      Plot(x,y,All(Luma(Color(x,y))))
   Next y
Next x
StopDrawing()
...ich dachte immer das wäre sehr ungut, da Plot() nicht clipped ist und der jeweils letzte pixel ja width-1 ist, ect.
my pb stuff..
Bild..jedenfalls war das mal so.
Antworten