Helligkeit von Bitmaps ändern

[jscnetcore]

Hallo zusammen,

ich bin dabei einige Programme von Kylix auf Lazarus zu umzustellen.
Ich suche ein einfaches Mittel um ein Bildchen zu laden und dann per Knopf heller bzw. dunkler zu machen.

Ich habe leider kein passendes Beispiel im Netz gefunden. Alles was ich gefunden habe sind die Delphi Geschichten
mit "Scanline" und diese laufen nicht unter Lazarus.

Mit BGRABitmap bin ich auch nicht weiter gekommen, obwohl es sehr gute Tutorials gibt.

Kann mir hier jemand einen TIP geben?

Gruß Josch

[theo]

Hast du das schon gelesen? Braucht keine zusätzlichen Libs.

http://wiki.freepascal.org/Developing_with_Graphics/de

[jscnetcore]

Hallo Theo,,
danke für den TIP. Ich habe mir das mal angesehen und das funktioniert auch soweit.
--> Arbeiten mit TLazIntfImage, Beispiel: Bild ausblenden

Das Bild kann man von 1 bis 32, also von quasi schwarz bis hin zum OriginalBild in der Helligkeit verändern.
Ich würde das Bild auch gerne noch Heller bekommen. Hab aber leider keine Ahnung wie.

Ich habe mal die original Procedure angehängt. Bei dieser ist es möglich die Helligkeit z.B. um den Factor 0.1 bzw. -0.1
von einer in die andere Richtung zu verändern.

Hast Du eine Idee?

Code: Alles auswählen

Procedure BrightnessBitmap(SourceBitmap: TBitmap; out DestBitmap: TBitmap; Factor: Double);
Var
  X, Y : Integer;
   OriginalRow : pPixelArray;
   ChangedRow  : pPixelArray;
Begin
  DestBitmap.Width := SourceBitmap.Width;
  DestBitmap.Height := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf32bit;
  For X := DestBitmap.Height-1 Downto 0 Do Begin
     ChangedRow := DestBitmap.Scanline[X];
     OriginalRow := SourceBitmap.Scanline[X];
     For Y := DestBitmap.Width-1 Downto 0 Do Begin
       ChangedRow[Y] := OriginalRow[Y];
       If (OriginalRow[Y].rgbBlue + Round(OriginalRow[Y].rgbBlue * Factor) >= 0)
       And (OriginalRow[Y].rgbBlue + Round(OriginalRow[Y].rgbBlue * Factor) <= 255) Then
         ChangedRow[Y].rgbBlue := OriginalRow[Y].rgbBlue + Round(OriginalRow[Y].rgbBlue * Factor);
       If (OriginalRow[Y].rgbGreen + Round(OriginalRow[Y].rgbGreen * Factor) >= 0)
       And (OriginalRow[Y].rgbGreen + Round(OriginalRow[Y].rgbGreen * Factor) <= 255) Then
         ChangedRow[Y].rgbGreen := OriginalRow[Y].rgbGreen + Round(OriginalRow[Y].rgbGreen * Factor);
       If (OriginalRow[Y].rgbRed + Round(OriginalRow[Y].rgbRed * Factor) >= 0)
       And (OriginalRow[Y].rgbRed + Round(OriginalRow[Y].rgbRed * Factor) <= 255) Then
         ChangedRow[Y].rgbRed := OriginalRow[Y].rgbRed + Round(OriginalRow[Y].rgbRed * Factor);
     End;
  End;
End;  
 

Vielen Dank schon mal!

Josch

[Michl]

Bin zwar nicht Theo, anworte trotzdem mal (auch wenn Theo mir wahrscheinlich den beigefügten Code nicht so abnehmen würde, da viel viel zu langsam )

Bitte für Code den Code-Highlighter verwenden!

Ich habe dir mal eine Procedure gemacht, in der du als Parameter die Helligkeit in Prozent angeben kannst (-100 - dunkel/schwarz / +100 - heller/weiß). Ist zwar nicht schnell, geht aber (und man kann als Einsteiger gut die Pixelfarben manipulieren).

Code: Alles auswählen

Procedure BrightnessBitmap(SourceBitmap: TBitmap; out DestBitmap: TBitmap; Prozent:integer);
var
  x,y,farbe:Integer;
  r,g,b:byte;
begin
  DestBitmap.Assign(SourceBitmap);
 
  if Prozent<0 then begin                      //Wenn abdunkeln
    for y:=0 to DestBitmap.Height-1 do
      for x:=0 to DestBitmap.Width-1 do begin
        farbe:=DestBitmap.Canvas.Pixels[x,y];
        b:=byte(farbe shr 16);                 //b=Blau (0..255 oder $00..$FF)
        g:=byte(farbe shr 8);                  //g=Grün (0..255 oder $00..$FF)
        r:=byte(farbe);                        //r=rot(0..255 oder $00..$FF)
        r:=round(r*(100+prozent)/100);
        g:=round(g*(100+prozent)/100);
        b:=round(b*(100+prozent)/100);
        DestBitmap.Canvas.Pixels[x,y]:=b shl 16 + g shl 8 + r;
      end;
  end else begin                               //ansonsten aufhellen
    for y:=0 to DestBitmap.Height-1 do
      for x:=0 to DestBitmap.Width-1 do begin
        farbe:=DestBitmap.Canvas.Pixels[x,y];
        b:=byte(farbe shr 16);
        g:=byte(farbe shr 8);
        r:=byte(farbe);
        r:=round(r+((255-r)*(prozent)/100));
        g:=round(g+((255-g)*(prozent)/100));
        b:=round(b+((255-b)*(prozent)/100));
        DestBitmap.Canvas.Pixels[x,y]:=b shl 16 + g shl 8 + r;
      end;
  end;
end;

[jscnetcore]

vielen besten Dank für die Procedure, sie macht das was sie soll. Für mich als Einsteiger erst mal genau das Richtige.

Und das nächste mal verwende ich auch den Code-Highlighter!!!! Sorry

[Michl]

So, habs nun noch etwas schneller gemacht ...

Code: Alles auswählen

Procedure BrightnessBitmap(SourceBitmap, DestBitmap: TBitmap; Prozent:integer);
var
  Stream:Tmemorystream;
  neuwert:array[0..255] of byte;
  i:Integer;
  b:byte;
begin
//  i:=gettickcount;
 
  if Prozent<0 then        //Abdunkeln
    for i:=0 to 255 do neuwert[i]:=round(i * (100+prozent)/100)
  else                     //Aufhellen
    for i:=0 to 255 do neuwert[i]:=round(i + (255-i) * (prozent)/100);
 
  Stream:=TMemorystream.Create;
  try
    Sourcebitmap.SaveToStream(Stream);
 
    Stream.Position:=55;   //Header Bitmap weg, nur Daten nutzen (http://de.wikipedia.org/wiki/Windows_Bi ... tionsblock)
 
    for i:=Stream.Position to Stream.Size-1 do begin
      b:=Stream.Readbyte;
      Stream.Position:=i;
      Stream.WriteByte(neuwert[b]);
    end;
 
    Stream.Position:=0;
    DestBitmap.LoadFromStream(Stream);
 
  finally
    Stream.Free;
  end;
 
//  form1.caption:=inttostr(gettickcount-i);
end;
 

[jscnetcore]

Hammer!
Dieser Code ist wesentlich schneller als dein erster.
Für meine Zwecke perfekt..
Damit ist mein Problem behoben.

Nochmal vielen besten Dank! Ihr habt mir sehr geholfen

[theo]

Nochmal vielen besten Dank! Ihr habt mir sehr geholfen

Aber hast du denn jetzt irgendwas gelernt oder begriffen? Nö oder?
Ich persönlich finde diese Art der "Hilfe" nicht so gut.

[Michl]

Hmm, das finde ich nicht.

Wenn ich bei einem Problem nicht weiter komme, suche ich zuerst im Netz. Probiere dort alle möglichen Varianten durch, falls ich dann immer noch nicht weiter komme, frage ich halt. Wenn mir jemand nur ein paar Brocken hinwirft, verliere ich schnell die Lust weiter zu fragen, bzw. man wird nicht ernst genommen.
Bekomme ich nun einen fertigen Code serviert, montiviert mich das, weiter zu machen! Dann nutze ich diesen auch um ihn zu variieren und zu testen, was man dann wie machen kann. Das bringt mir dann viele Aha-Effekte!

Trockene Theorie ist für mich immer nicht gut zum lernen gewesen, bin eher auf learning by doing eingestellt. Daher versuche ich immer eine funktionierende Lösung zu bieten!

[theo]

Da kann ich mich nicht anschliessen.
Vor allem dein "schnellerer" Code ist afaics auch ziemlich gefährlich.
Du machst da einige Voraussetzungen, wie das Bitmap in dem Stream vorliegt.
Ich mache mit dir jede Wette, dass der OP und einige Forenuser keinen blassen Dunst haben, was da warum abgeht.
Einfach unverstandene, fremde Codeschnippsel zu verwenden (auf diesem Level) finde ich nicht gut.

Der OP hätte besser die beiden Ansätze die er hatte kombiniert.

Also sowas:

Code: Alles auswählen

 
For X := SourceBitmap.Height-1 Downto 0 Do Begin
OriginalRow := SourceBitmap.Scanline[X];
For Y := SourceBitmap.Width-1 Downto 0 Do Begin
(OriginalRow[Y].rgbRed:=

Mit sowas ersetzt:

Code: Alles auswählen

    for py:=0 to SrcIntfImg.Height-1 do begin
       for px:=0 to SrcIntfImg.Width-1 do begin
         CurColor:=SrcIntfImg.Colors[px,py];
         CurColor.Red:=

Dann hätte er am Ende auch verstanden was er tut. (Achtung Curcolor.Red ist ein Word, kein Byte).

[Michl]

Aber deutlicher als in meinem ersten geposteten Code (bis auf den einen Fehler, den ich noch drin habe), kann man doch die Verwendung von Pixeln fast nicht darstellen?! Ist langsam aber bestens geeignet damit zu spielen!

Der Ansatz mit Scanline ist da schon um einiges komplizierter und wenn einfach kopiert genauso wenig zu verstehen, wie mein zweiter Post...

Das TBitmap liegt (afaik immer) als 24-Bit (nur dann funktioniert 2. Code) vor, daher sollte das doch unter FCL ohne Probleme funktionieren - da hast du aber weit mehr Erfahrung als ich und ich lasse mich da auch gerne eines Besseren belehren (wenn keiner einen Einspruch macht, lerne ich ja dann auch nichts dazu )

Habe kurz noch mal nachgeschaut und siehe http://wiki.freepascal.org/Developing_with_Graphics/de#Bildformat-spezifisches_Beispiel steht da: "Wie Sie wissen verwendet eine TBitmap für blau 8 Bit, für grün 8 Bit und für rot 8 Bit." Sollte also doch so sein oder?!

[theo]

Habe kurz noch mal nachgeschaut und siehe http://wiki.freepascal.org/Developing_with_Graphics/de#Bildformat-spezifisches_Beispiel steht da: "Wie Sie wissen verwendet eine TBitmap für blau 8 Bit, für grün 8 Bit und für rot 8 Bit." Sollte also doch so sein oder?!

Das sagt aber nichts aus darüber, wie es im Stream vorliegt. Das kann alle Möglichen Varianten haben (1bpp - 32bpp), auch komprimierte:
http://de.wikipedia.org/wiki/Windows_Bitmap#Bilddaten

Es kann auch sein, dass es Lazarus standardmässig als 24 bpp ablegt, aber das ist ein Annahme, die nicht dauerhaft garantiert sein muss.

Ich finde den Code (Variante 2) einfach ohne warnenden Kommentar zu sportlich und nicht allgemein empfehlenswert.

[Michl]

Das sagt aber nichts aus darüber, wie es im Stream vorliegt. Das kann alle Möglichen Varianten haben (1bpp - 32bpp), auch komprimierte:
http://de.wikipedia.org/wiki/Windows_Bitmap#Bilddaten

Es kann auch sein, dass es Lazarus standardmässig als 24 bpp ablegt, aber das ist ein Annahme, die nicht dauerhaft garantiert sein muss.

Ich finde den Code (Variante 2) einfach ohne warnenden Kommentar zu sportlich und nicht allgemein empfehlenswert.

Da hast du natürlich recht! Der Code funktioniert nur bei 24 Bit je Bildpunkt! Das hätte ich mit dazu schreiben können/sollen! Da das TBitmap unkomprimiert im Speicher vorliegt, kopiert TBitmap.SaveToStream auch die Pixel 1:1, daher geht die 2.Variante nur mit diesem unkomprimierten Bildformat "TBitmap" (was ja im Kopf der Procedure so verankert ist).

Wie sich das TBitmap in Zukunft darstellen wird, weiss ich natürlich auch nicht! Daher danke für deine Kritik!

[theo]

Hier wäre noch mein Vorschlag. Sollte schnell, sauber und verständlich sein.
Zur Helligkeit gäbe es auch noch viel zu sagen, aber zum Veranschaulichen des Prinzips sollte das reichen.

Code: Alles auswählen

uses LCLType, 
  IntfGraphics,
  fpImage,
  math;
...
procedure Brightness(SourceBitmap, DestBitmap: TBitMap; Offset: integer);
var
  SrcIntfImg, TempIntfImg: TLazIntfImage;
  ImgHandle, ImgMaskHandle: HBitmap;
  px, py: integer;
  CurColor: TFPColor;
begin
  Offset:=Offset * $FF;
  SrcIntfImg := TLazIntfImage.Create(0, 0);
  SrcIntfImg.LoadFromBitmap(SourceBitmap.Handle, SourceBitmap.MaskHandle);
  TempIntfImg := TLazIntfImage.Create(0, 0);
  TempIntfImg.DataDescription := GetDescriptionFromDevice(0);
  TempIntfImg.SetSize(SrcIntfImg.Width,SrcIntfImg.Height);
  for py := 0 to SrcIntfImg.Height - 1 do
  begin
    for px := 0 to SrcIntfImg.Width - 1 do
    begin
      CurColor := SrcIntfImg.Colors[px, py];
      CurColor.red := EnsureRange(CurColor.red + Offset,0,$FFFF);
      CurColor.green := EnsureRange(CurColor.green + Offset,0,$FFFF);
      CurColor.blue := EnsureRange(CurColor.blue + Offset,0,$FFFF);   
      TempIntfImg.Colors[px, py] := CurColor;
    end;
  end;
  TempIntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle, False);
  DestBitmap.Handle := ImgHandle;
  DestBitmap.MaskHandle := ImgMaskHandle;
  SrcIntfImg.Free;
  TempIntfImg.Free;
end;  
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Brightness(Image1.Picture.Bitmap,Image2.Picture.Bitmap, 30); //Werte von -255 bis +255
end;     

[Michl]

Hier wäre noch mein Vorschlag.

Super Code...und ich verbiege so den Stream...EnsureRange kannte ich bisher noch nicht...Danke für das Bsp und die Erleuchtung!

[EDIT] EnsureRange "schneidet" größere/kleinere Werte einfach ab... Weiß nicht, ob es günstig ist, die Helligkeit in absoluten Werten zu erhöhen, mein Ansatz war, die Helligkeit prozentual zu erhöhen, habe wahrscheinlich wieder zu kompliziert gedacht?! Ansonsten habe ich einfach in deinem Code die Zeilen ersetzt, entsprechend meinem Bsp.,

Code: Alles auswählen

      CurColor.red := NeuWert[CurColor.red shr 8] shl 8; ...

probiert und geht auch.

Wenn der OP evtl. nicht so viel dazu gelernt hat, habe ICH doch wieder was dazu gelernt (vor allem das direkte Ersetzen von Bitmaps habe ich bisher nicht genutzt), daher hat es sich doch gelohnt, dass ich dich (als heimlichen König der Lazarusforummeritokratie) dazu animiert habe etwas Code zu schreiben...