JPEG, PNG, GIF - Resize

[theo]

Der Code ist in gifwrite.pas. Den kannst du dir gerne anschauen.
Die Grafikformat Codes stammen ja nicht von mir. Der Beweggrund für OpBitmap war ja, Grafikcode der für Delphi geschrieben war in Lazarus zu verwenden, ohne viel Anpassungsarbeit bei den Fremdcodes.

[gocher]

Wo der Code drin steht hatte ich schon durch Debug herausgefunden und den Fehler auch, unsere Nachrichten haben sich wohl etwas durch meine Korrekturen überschnitten, also einfach noch einmal am Ende meine letzten Meldung nachsehen, dann ist bei Dir der Fehler auch raus.

Übrigens ich hasse Ihn auch, den Internet Explorer, aber dieser Browser der leider noch eine hohe Verbreitung hat konnte das Bild auch nicht anzeigen!

Übrigens die Erweiterung macht in der kompilierten Datei 491kb aus das ist mehr als eine Verdopplung der ursprünglichen Dateigröße!

Bildgröße Ursprungsbild 800x600 Zielgröße: 160x107 in 109ms ist glaube ich ok!

[theo]

Wo der Code drin steht hatte ich schon durch Debug herausgefunden und den Fehler auch, unsere Nachrichten haben sich wohl etwas durch meine Korrekturen überschnitten, also einfach noch einmal am Ende meine letzten Meldung nachsehen, dann ist bei Dir der Fehler auch raus.

Danke, sehr gut. Das ging ja schnell. Werde ich nächstens in die Download-Version einbauen.

Übrigens die Erweiterung macht in der kompilierten Datei 491kb aus das ist mehr als eine Verdopplung der ursprünglichen Dateigröße!

Verstehe nicht ganz. Das hängt von mit der Ursprungsqualität zusammen. Resampling transformiert immer auf 32 bit.
Wenn du nachher auf 16 Farben runter willst, geht das so:

Code: Alles auswählen

   bmp := TOPPicture.create;
   bmp.LoadFromFile('/home/theo/Bildschirmfoto3.png');
   bmp.Bitmap.Canvas.Resample(160,109);
   bmp.Bitmap.ReductionMode:=rmOptimized; //<<<
   bmp.Bitmap.PixelFormat:=pf4bit; //<<<
   bmp.SaveToFile('/home/theo/Bildschirmfoto3.gif');
   bmp.free;    

[gocher]

Ich glaube das hast Du falsch verstanden, das Package OpBitmap mach die .dll/.exe 491kb größer!
Das Bild ist ist ok!!!

[theo]

Ich glaube das hast Du falsch verstanden, das Package OpBitmap mach die .dll/.exe 491kb größer!
Das Bild ist ist ok!!!

Ist aber trotzdem ein guter Tipp, gerade bei Thumbnails dieser Grösse ist die Farbtreue nicht so wichtig, macht aber glatt ein halb so fettes GIF.

Du kannst das Package beliebig auseinanderpflücken. Eigentlich brauchst du nur opbitmap.pas und gifwrite.pas, sowie resample, ftbresenham und wincomp.

[gocher]

Für kleine Skizzen, Grafiken, Comics, etc. aber nicht für kleine Bilder, obwohl es hat schon wieder was künstlerisches !

pf4bit

Tiger~pf4bit.gif (5.09 KiB) 2105 mal betrachtet

pf8bit

Tiger~pf8bit.jpg (9.29 KiB) 2105 mal betrachtet

[theo]

Für kleine Skizzen, Grafiken, Comics, etc. aber nicht für kleine Bilder, obwohl es hat schon wieder was künstlerisches !

Naja, 16 Farben sind 16 Farben. Aber die Farbreduktion ist doch nicht übel...

Klar, kommt halt auf den Zweck und die Prioritäten an. Erkennen tut man das Bild.

[gocher]

Du kannst das Package beliebig auseinanderpflücken. Eigentlich brauchst du nur opbitmap.pas und gifwrite.pas, sowie resample, ftbresenham und wincomp.

Wenn ich das Package richtig verstehe wird TOPPicture in der Unit opbitmapformats zur Verfügung gestellt, ohne geht nicht oder?
Somit geht das nicht mit dem Auseinanderpflücken.

[theo]

Doch natürlich geht ohne, wenn du unbedingt ausmisten willst. Es ist aber dann nicht mehr so komfortabel.

Diesen Code aus opbitmapformats kannst du auch ohne diese Unit gebrauchen. "Self" bei AddBitmap ist einfach ein TOpBitmap (bzw. ein TCanvasOPBitmap)

Code: Alles auswählen

procedure TGIFImage.SaveToStream(Stream: TStream);
begin
  if Empty then raise EPasBitMapError.Create('OPBitmap empty');
  PixelFormat := pf8bit;
  Stream.Position := 0;
  fEncoder := TGif.Create;
  fEncoder.AddBitmap(self);
  if Transparent then
    fEncoder.TransparentColor := Transparentcolor;
  fEncoder.Interlaced := fInterlaced;
  fEncoder.SaveToStream(Stream);
  fEncoder.free;
end;

[gocher]

Jop, hat geklappt ich habe nun eine Klasse TFPWriterGIF (fpwritegif.pas) angelegt, die benötigt die Dateien opbitmap.pas, bmp.pas, bitmapimage, gifwrite.pas, gif.pas, gifdecoder.pas, gifInputfilestream.pas, gifinputstream.pas, giftype.pas, inputbytestream.pas und systemspecific.pas.

Jetzt ist die .dll/.exe nur 68kb größer, nicht mehr 491kb - aber 125ms Bearbeitungszeit, das sind 16ms mehr!!!

So die abgespeckte Variante ist nun auch fertig, sie macht die .dll/.exe nun 83kb größer - aber 109ms Bearbeitungszeit!

Der umgekehrte Weg wäre natürlich auch noch interessant, die Thumbnail-Routine in OpBitmap einzubauen!

Für die unter Euch die Interesse an diesem Thread gefunden habe und sich schon lange die Klasse TFPWrieGIF gewünscht haben nun ein kleines Abfallprodukt .

fpwritegif.pas

kann noch lange nicht alles, also keine animated GIFs, usw. aber zum speichern als normales GIF reicht es

(3.28 KiB) 81-mal heruntergeladen

[gocher]

Hallo Theo, damit auch das Setzen von bmp.fCurrentFormat.Monochrome := false; möglich ist und vor allem nicht zu einem Fehler führt!

opbitmap.pas:

Code: Alles auswählen

procedure TOPBitmap.SetMonochrome(const Value: Boolean);
var x, y: integer;
  gray: Byte;
  col: TColor;
  OrigPixelFormat:TPixelFormat;
begin
  if Value and not fMonochrome then //***neu
  begin
    OrigPixelFormat:=PixelFormat;
    if PixelFormat<pf15bit then PixelFormat:=pf24bit;
//    fMonochrome := True; //***neu
    for y := 0 to Height - 1 do
      for x := 0 to Width - 1 do
      begin
        col := Pixels[x, y];
        gray := (Byte(col) * 77 + Byte(col shr 8) * 151 + Byte(col shr 16) * 28) shr 8;
        Pixels[x, y] := gray shl 16 + gray shl 8 + gray;
      end;
    PixelFormat:=OrigPixelFormat;
  end;
  fMonochrome := Value; //***neu
end; 

[theo]

Hallo Theo, damit auch das Setzen von bmp.fCurrentFormat.Monochrome := false; möglich ist und vor allem nicht zu einem Fehler führt!

Zu welchem Fehler führt das denn?

Kann man so machen wie du vorschlägst, aber in welchem Szenario ergibt das Sinn?
Mmn sollte es eig. nur ein SetMonochrome geben, denn das ist ja nicht reversibel.
Aus Kompatibilitätsgründen (Delphi) habe ich es aber als Property realisiert.
Aber ich gebe zu, das ist etwas halbherzig umgesetzt.

[gocher]

Zu welchem Fehler führt das denn?

Kann man so machen wie du vorschlägst, aber in welchem Szenario ergibt das Sinn?
Mmn sollte es eig. nur ein SetMonochrome geben, denn das ist ja nicht reversibel.
Aus Kompatibilitätsgründen (Delphi) habe ich es aber als Property realisiert.
Aber ich gebe zu, das ist etwas halbherzig umgesetzt.

Also Du hast Monochrom als Property realisiert, aber beim setzen (write) wird immer die Methode SetMonochrom aufgerufen und in der wurde immer nach Monochrom konvertiert und dann der Wert auf True gesetzt!

[theo]

Ist schon klar, dass das grenzwertig ist.
Andererseits was soll denn Monochrome:=false bewirken? Wird das Bild dann farbig?
Bzw. was soll das Property überhaupt?

[gocher]

Also wenn man die Komponente irgendwo einsetzt und man optional eine Konvertierung nach Monochrome möchte wie z.B. im Beispiel:

Code: Alles auswählen

procedure TFPWriterGIF.InternalWrite(Str: TStream; Img: TFPCustomImage);
var
  opbmp: TOPPicture;
  MemoryStream: TMemoryStream;
  Writer: TFPWriterBMP;
begin
  MemoryStream := TMemoryStream.Create;
  Writer := TFPWriterBMP.Create;
  Writer.BitsPerPixel := 32;
  opbmp := TOPPicture.create;
 
  Writer.ImageWrite(MemoryStream, TheImage);
  opbmp.LoadFromStream(MemoryStream);
  case fBitsPerPixel of  //property from wrapper class
  4: begin                                                                     
       opbmp.fCurrentFormat.PixelFormat := pf4bit;
       opbmp.fCurrentFormat.ReductionMode := rmOptimized;
     end;
  8: opbmp.fCurrentFormat.PixelFormat := pf8bit;
  else opbmp.fCurrentFormat.PixelFormat:=pf8bit;
  end;
  opbmp.fCurrentFormat.Monochrome := fMonochrome;  //property from wrapper class  <--*** hier: Wert wird durchgereicht
  opbmp.SaveToStream(Str);
 
  opbmp.free;
  FreeAndNil(Writer);
  MemoryStream.Free;
end;  

Da aber schon das Setzen des Wertes zur Konvertierung führt, auch wenn der Wert false ist sehe ich da ein Problem!
Sonst sollte Monochrome nicht als Property angeboten werden, sondern nur eine Funktion.

Die kleinen Änderungen verhindern diesen Fehler und machen das Property abfragbar vorher stand der Wert nach dem Setzen immer auf True.