Bildtiefe ändern

[Andreas]

Hallo Thomas,

ich hatte vor ein paar Jahren mal ein ähnliches Problem mit Konvertierungen.
Hab mir dann mit Delphi eine Dll geschrieben ( Problem gelöst ).

Wenn Du nicht gegen Fertiges hast probier sie einfach mal aus.


Hier zu finden

[Thomas]

Wie hast du das angestellt? (Vorgehensweise)

[Andreas]

Wie hast du das angestellt? (Vorgehensweise)

Ich habe damals im Delphi-Forum nach frei kopierbaren Codes gesucht, gefunden und eine Dll davon gemacht. Grob gesagt : abgeschrieben !

[Thomas]

ok;
wie mach ich das in PB?
(kann mit der DLL nur teilweise was anfagen...)

[Andreas]

ok;
wie mach ich das in PB?
(kann mit der DLL nur teilweise was anfagen...)

OK, hier eine kleine Spielerei:

Du legst mit PB ein 8-Bit-Bild an, legst eine Farbpalette für das Bild an und
schickst diese mit SetDIBColorTable_(....) an das 8-Bit-DC.
Die Farbpalette habe ich der Einfachheit halber als Data abgelegt.

Code: Alles auswählen

Dim GrayTable.RGBQUAD(255)
Dim ColorTable.RGBQUAD(255)

For I = 0 To 255
GrayTable(i)\rgbBlue = i
GrayTable(i)\rgbGreen = i
GrayTable(i)\rgbRed = i
Next I

;Paletta aus DATA einlesen
Restore Palette

For I = 0 To 255
Read r.b
Read g.b
Read b.b
ColorTable(i)\rgbBlue = r
ColorTable(i)\rgbGreen = g
ColorTable(i)\rgbRed = b
Next I

CreateImage(0,640,480,24)

hdc = StartDrawing(ImageOutput(0))
BitBlt_(hdc,0,0,640,480,GetDC_(0),0,0,#SRCCOPY)
StopDrawing()

CreateImage(1,640,480,8)
hdc = StartDrawing(ImageOutput(1))
SetDIBColorTable_(hdc,0,255,GrayTable(0))
DrawImage(ImageID(0),0,0)
StopDrawing()

OpenWindow(0,0,0,640,480,"void",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
ImageGadget(0,0,0,0,0,ImageID(1))

Delay(500)

FreeImage(1)
CreateImage(1,640,480,8)
hdc = StartDrawing(ImageOutput(1))
SetDIBColorTable_(hdc,0,255,ColorTable(0))
DrawImage(ImageID(0),0,0)
StopDrawing()
SetGadgetState(0,ImageID(1))


While WaitWindowEvent() ! #PB_Event_CloseWindow : Wend

DataSection
Palette:
Data.b 44,17,10,205,132,62,25,64,116,57,67,71,26,130,172,227,197,174,131,8,21
Data.b 128,67,34,16,32,65,39,94,120,138,137,163,171,100,58,16,113,173,79,163,204
Data.b 108,98,119,165,198,218,17,131,196,50,39,35,225,230,226,193,172,145,37,50,66
Data.b 39,116,146,144,33,60,140,130,100,131,103,89,127,76,71,58,96,105,79,134,170
Data.b 68,52,63,196,134,104,77,21,25,34,66,90,156,164,168,22,100,152,241,244,235
Data.b 156,87,34,116,40,10,87,148,185,205,154,115,22,53,93,196,207,221,138,175,206
Data.b 178,111,85,73,73,87,135,51,65,183,104,59,79,40,24,14,125,196,15,82,128
Data.b 77,143,198,77,116,136,24,21,37,69,98,122,210,232,247,138,87,72,57,124,175
Data.b 36,59,67,141,42,50,79,21,38,118,118,121,76,138,182,77,47,46,132,71,52,158,118,89
Data.b 186,49,66,83,26,63,208,175,166,190,115,60,190,155,138,62,108,151,69,86,119,183,36,52
Data.b 13,124,185,95,85,89,238,237,240,192,213,238,76,108,121,176,212,233,196,136,134,58,120,160
Data.b 192,133,87,141,84,57,123,90,93,97,57,48,65,52,90,13,130,188,51,148,202,16,87,141
Data.b 149,186,213,150,76,49,27,51,80,215,142,104,225,245,250,111,148,171,209,148,90,70,31,43
Data.b 164,89,55,185,28,49,122,60,45,105,123,153,40,80,106,184,178,172,190,123,86,190,51,84
Data.b 114,170,218,128,104,103,109,138,169,26,108,159,23,30,43,161,92,69,103,67,56,73,59,65
Data.b 158,122,120,225,154,112,27,61,97,160,154,146,83,121,155,169,202,230,42,136,197,32,123,180
Data.b 209,135,87,190,58,69,52,143,186,40,29,27,16,42,85,167,102,70,44,84,121,191,39,60
Data.b 94,70,70,189,196,201,140,152,165,243,198,141,222,203,196,125,134,141,132,21,35,137,157,185
Data.b 233,172,127,108,112,104,119,51,89,137,167,190,85,154,200,242,213,164,92,29,10,238,215,201
Data.b 116,78,92,208,188,170,102,96,91,150,189,230,193,158,156,149,181,196,60,68,116,59,52,51
Data.b 72,39,63,128,57,27,105,109,143,204,217,224,118,165,196,167,133,104,150,136,140,234,176,143
Data.b 192,118,73,217,155,132,42,107,135,109,156,197,238,188,162,129,11,37,70,73,103,128,118,106
Data.b 176,187,210,178,216,246,123,181,213,176,68,96,22,41,67,132,41,66,140,60,61,67,60,94
Data.b 184,62,92,171,111,73,34,21,25,31,117,163,114,121,136,72,90,136,134,25,47,48,41,47,198,144,110
Data.b 27,67,106,205,163,120,81,88,104,229,163,118,69,29,27,65,40,78,123,175,202,52,79,71
Data.b 116,108,121,199,220,240,194,144,137,104,81,74,32,59,83,175,184,193,155,75,69,97,17,28
Data.b 180,171,169,38,124,196,99,19,43,207,40,63,93,98,103,28,97,138,62,99,135,186,124,103
Data.b 23,72,118,236,183,128,182,107,70,216,142,118,111,151,184,172,47,52,67,108,137,44,132,185
Data.b 144,70,33,240,235,227,161,177,207,100,42,24,95,49,42,207,120,56,144,57,47,140,120,156
Data.b 178,125,121,156,50,84,164,171,188,55,131,171,48,31,62,172,114,60,100,52,65,37,53,93
Data.b 158,50,62,206,48,67,193,164,142,98,48,88,97,27,43,47,32,36,168,146,136,219,164,137,158,104,86
Data.b 97,75,85,107,141,181,242,246,247,156,107,101,164,134,121,103,74,105,157,118,104,119,47,22
Data.b 252,186,148,132,132,123,98,61,62,36,61,98,39,41,62,158,41,61
EndDataSection

[Thomas]

@Andreas
Genau das, ist das was ich eigentlich vermeiden möchte ... weil du ordnest ja in deinem Code wieder nur die ausgelesenen Farben einer vordefinierten Palette zu.

Ich möchte, dass eine optimale Palette für die im Bild verwendeten Farben errechnet (oder so) wird.

Ich hab schon nen Ansatz, aber weis nicht recht, wie ich das umsetzen soll:
1. ich lese alle Farben aus dem Bild in ein ein Array ein
2. ich fasse alle Farben die sich besonders ähnlich sind so lange zusammen bis nur noch 256 Farben übrig sind.

Hat jemand ne Idee, wie ich das mit dem zusammenfassen der Farben machen kann?

[Thomas]

Ich hab mal nen Code angefangen, der wie schon gesagt, alle Farben aus einem Bild ausliest und dann die zusammenfasst, die sich ähnlich sind:
(Die max. Größe der Bilder liegt bei 128x128)

Code: Alles auswählen

LoadImage(1, "Test_1.bmp")

Dim Palette.l(16347)

For n = 0 To 16347
  Palette(n) = -1
Next n

StartDrawing(ImageOutput(1))
For ny = 0 To 127
  For nx = 0 To 127
    Color = Point(nx, ny)
    Gefunden.l = 0
    For n = 0 To 16347
      If Palette(n) = Color
        Gefunden = 1
        Break
      EndIf
    Next n
    If Gefunden = 0
      Palette(Position) = Color
      Position.l = Position + 1
    EndIf
  Next nx
Next ny
StopDrawing()

SortArray(Palette(), 1)
For ne = 0 To 16347
  Color.l = Palette(ne)
  For nz = ne To 16347
    Unterschied = Abs(Red(Color)-Red(Palette(nz))) * Abs(Green(Color)-Green(Palette(nz))) * Abs(Blue(Color)-Blue(Palette(nz)))
    If Unterschied < 5       ;Und hier den Unterschied mal nach Bedarf anpassen ...
      Palette(nz) = -1
    EndIf
    SortArray(Palette(), 1)
  Next nz
Next ne

For n = 1 To 16347
  If Palette(n) <> -1
    Debug Palette(n)
  EndIf
Next n

Ich hab im Moment nur 2 Probleme:
-ich komm nicht wirklich weiter
-und ich kann das ergebnis nicht wirklich abwarten (zu laaaaaaaaaansam)

[Thomas]

Hat keiner ne Idee, wie ich die anzahl der Farben in meiner Liste schlau zusammenfassen kann?

(Wie kann man die 256 bzw. 16 Standardfarben ermitteln?)

[Kaeru Gaman]

die 16 standardfarben sind:
6 Reinfarben: Rot Gelb Grün Cyan Blau Magenta
(0000FF, 00FFFF, 00FF00, FFFF00, FF0000, FF00FF)
das sind auch grundsätzlich die basis-spektralfarben.
6 abgetönte: 50% der Reinfarben
(000080, 008080, 008000, 808000, 800000, 800080)
plus Schwarz, Weiß, 50% Grau und 75% Grau
(000000, FFFFFF, 808080, C0C0C0)

im allgemeinen werden jetzt für die 256er palette erstmal 16 grautöne ergänzt (in die farben 16-31)
danach wird mit unterschiedlichen abtönungen/pastellierungen der 6 basisfarben weitergemacht,
immer in 6er gruppen, jetzt frag mich nicht wie geordnet.

wenn du eine andere palette aufstellen magst, dann nimm doch die 216 webfarben
die kannst du ja noch um 40 zusatztöne ergänzen.

[Scarabol]

Hi,

und ähh Kaeru und die anderen ihr versteht genau schon wie bei mir nicht das Problem!

Thomas möchte nicht irgendeine Palette nehmen und diese benutzen, sondern völlig dynamisch und bildabhänigg die Palette jedesmal aus der Menge der Farben im Bild neu erzeugen.

Mein Ansatz bisher:
- Farben und ihre Anzahl in Liste speichern
-> das könnte man sich dann als Graph der Farbverteilung mal bildlich vorstellen....
- Nun wird festgelegt wie viele Farben es später geben soll z.B. 16
- Gesamtfeld der Farben durch 16 teilen
- die Mischfarbe der einzelnen Felder bestimmen
- die jeweiligen Farben im Bild suchen und durch die neue Mischfarbe ersetzten...

Klingt ganz einfach aber bei mir ist das spätere wiederfindne einfach zu zeitaufwendig...

Die Bilder sollten also nur so 256 mal 256 groß sein, je nachdem wie viel Zeit ihr halt habt...

Code: Alles auswählen

UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()

Structure color
  num.l
  var.l
  new.l
EndStructure

NewList color.color()


;OpenWindow(1, 0, 0, 1200, 800, "", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)

File$ = OpenFileRequester("", "", "", 0)
;File$ = PB_OpenFile(WindowID(1))

If File$ = ""
  End
EndIf

LoadImage(1, File$)
w = ImageWidth(1)-1
h = ImageHeight(1)-1

StartDrawing(ImageOutput(1))
  For x = 0 To w
    For y = 0 To h
      c = Point(x,y)
      AddElement(color())
      color()\var = c
    Next
  Next
StopDrawing()

SortStructuredList(color(), 0, OffsetOf(color\var), #PB_Sort_Long)

lastcolor = -1

ForEach color()
  If lastcolor = color()\var
    DeleteElement(color())
    color()\num+1
  Else
    PreviousElement(color())
    color()\num+1
    NextElement(color())
    lastcolor = color()\var
  EndIf
Next

a = 0

ForEach color()
  a + color()\num
  If color()\num = 0
    Debug "error"
    End
  EndIf
Next

a = Round(a / 4, 0)

c = 0
n = 0
cs = 0

For i = 1 To 4
  While c < a
    SelectElement(color(), n)
    ar + Red(color()\var)
    ag + Green(color()\var)
    ab + Blue(color()\var)
    c+color()\num
    n+1
    cs+1
  Wend
  an = RGB(ar/cs, ag/cs, ab/cs)
  For l = n-cs To n-1
    SelectElement(color(), l)
    color()\new = an
  Next
  cs = 0
  c = 0
  ar = 0
  ag = 0
  ab = 0
Next

Debug "plot"

StartDrawing(ImageOutput(1))
For x = 0 To w
  For y = 0 To h
    c = Point(x,y)
    ForEach color()
      If c = color()\var
        Plot(x,y,color()\new)
        Break
      EndIf
    Next
  Next
Next
StopDrawing()

Debug "fertig"

SaveImage(1, "kljasldföljaklsdkfja.bmp")

End
;ReduceColor(1)

CreateGadgetList(WindowID(1))
  ImageGadget(1, 150, 0, 10, 10, ImageID(1))

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow

CloseWindow(1)

Gruß
Scarabol