Home

News

Software
  - HTML
  - DHTML
  - Javascript
  - CGI
  - VRML
  - Linux
  - Dirty-Progs
    - CSS-DIV-Slicer
    - Sprite-Painter
    - FLV-CCC
    - CPU-Eater
    - Pixel-Evolution
    - MediaPanelyzer
    - OpenGL ISS
    - OpenGL Planets
    - PicOfPics
    - OpenGL Henrys
    - VidSplitt

  - PHP
    - Src2Textarea
    - Volltext-Suche
    - Hilfsfunktionen

Bilder

Texte

Alles fliesst

Comics

Musik

Leben

Links

Sitemap

Admin


Erotisches bei
AsianThumbs.org

PicOfPictures - Bilder bilden Bilder

PicOfPics-Tutorial von Daniel Schwamm (09.02.2008)

Aus "Heimat des Dilettantismus"
http://www.henrys.de/daniel/index.php?cmd=software_dirty-progs_picofpics_index.htm

Der schädliche Einfluss der Werbung

An dem Proggy ist mein Kollege Schuld. Er erwähnte, er habe in einem Werbeprospekt ein cooles Bild gesehen, das aus lauter Einzelbildern zusammengebaut war, die so geschickt arrangiert wurden, das sich daraus ein neues grosses Bild ergab.

Das hörte sich witzig an! Eine nette Herausforderung für den Schwamm! Und so hatte er seine Bechreibung noch nicht ganz beendet, da hatte mein verkorkstes Hirn schon eine wage Idee ausgebrütet, wie man so etwas würde selbst programmieren können.

Langeweile langt eine Weile

Gleicher Tag, Abends zuhause. In der Glotze kam mal wieder nichts. Also warf ich den PC an und hatte irgendwann im Morgengrauen meine erste Version von PicOfPics fertig.

Das entgültige Ergebnis liess deutlich länger auf sich warten. Klar. Zumal mir ohne Ende weitere Schikanen einfielen, wie man das Programm komplexer und optionsreicher gestalten könnten. Heraus kam letztlich ein nettes kleines Tool, das allemal gut genug ist, um ein paar Aha-Effekte beim staunenden Publikum hervorrufen zu können.

Masterplan

Die prinzipielle Vorgehensweise von PicOfPics ist folgende:

  1. Zuerst wird der Quader-Pool definiert. Hier werden die Bilder verwaltet, aus denen sich später das Ergebnis-Bild zusammen setzt. Diese Bilder nenne ich Quader. Man wählt hierzu einen Ordner, scannt die darin befindlichen JPG-Bilder, bestimmt ihre "Mittel-Farbe" und die 3 x 3 "Verlauf-Farben", und merkt sich die Ergebnisse in einer TStringgrid.

    Ein Histogramm zeigt an, wie gut die Mittel-Farben der Quader-Bilder die 255 möglichen Graustufen von Weiss bis Schwarz abgedecken.

    Die Grösse der Quader ist ohne Belang. Optimal sind quadratische Bilder.

    Alle Funktionen werden in der Delphi-Unit "qp_u.pas" gekapselt. Sie beginnen mit dem Prefix "qp_".

  2. Dann läd man das Original-Bild ein, welches "nachgebaut" werden soll.

    Auch hier zeigt ein Histogramm an, welche Graustufen, also welche Helligkeitsgrade, im Bild vorkommen. Idealerweise decken sich natürlich die Histogramme von Quader-Pool und Original-Bild einigermassen.

    Der Source zum Original-Bild wird in der Unit "ob_u.pas" untergebracht. Die Funktionen beginnen entsprechend mit "ob_".

  3. Jetzt kann man in der Optionen-Page Einstellungen vornehmen, die das Ergebnis-Bild beeinflussen.

    So kann die Anzahl der horizontalen Quader-Bilder angegeben werden, die im Ergebnis-Bild Verwendung finden sollen (die vertikale Anzahl ergibt sich automatisch, da stets mit quadratischen Quadern gearbeitet wird). Desweiteren kann die Breite der Quader in Pixeln angegeben werden, ob ihre Position "verwackelt" oder exakt berechnet plaziert werden sollen, ob sie einen Rand erhalten, usw.

    Fast alle Einstellungen lassen sich unmittelbar in der Vorschau betrachten und so im Voraus für das Ergebnis-Bild abschätzen. Per Mausklick wird letztlich die eigentlich PicOfPics-Prozedur gestartet.

    Das Originalbild wird dabei in eine "Pixel-Bitmap" umgewandelt, die so dimensioniert ist, wie es durch die Anzahl der Quader vorgegeben wurde. Das Programm betrachtet nun jeden Pixel der Pixel-Bitmap und sucht im Quader-Pool nach einem Bild, dessen Mittel-Farbe in etwa dem des Pixels entspricht. Der gefundene Quader wird dann an passender Stelle und mit der gewünschten Grösse in das Ergebnis-Bild kopiert.

    Die Unit "op_u.pas" umfasst alle - mit "op_" beginnenden - Options-Funktionen.

  4. Ist das Ergebnis-Bild fertig, kann - zur nachträglichen Verbesserung - das Original-Bild auf verschiedenen Arten in das Ergebnis-Bild eingeblendet werden.

    Zudem kann in das Ergebis-Bild rein oder rausgezoomt werden, was eine eingehendere Betrchtung erlaubt. Und nicht zuletzt kann das Ergebnis-Bild natürlich auch gespeichert werden.

    Die "eb_"-Funktionen befinden sich in der Unit "eb_u.pas".

Die Hauptform von PicOfPics

Wie bereits angedeutet, werden die vier Arbeitsschritte von PicOfPics jeweils durch ein eigenes "Modul" abgearbeitet, zusammengefasst in Units. Auf der Hauptform wird jede dieser Units durch eine Page eines TPageControls repräsentiert. Der Anwender blättert sich so quasi vom Anfang bis zum fertigen Ergebnis durch.

PicOfPictures - Page des Quader-Pool

Page des Quader-Pool

PicOfPictures - Page des Original-Bildes

Page des Original-Bildes

PicOfPictures - Page der Optionen

Page der Optionen

PicOfPictures - Page des Ergebnis-Bildes

Page des Ergebnis-Bildes

Funktions-Splitting

Die Funktionalität der meisten Buttons der Hauptform werden an die zugehörigen Modul-Units einfach durchgereicht, weswegen hier nicht näher drauf eingegangen wird.

Hauptsache Hauptform

Funktionen, die direkt die Hauptform betreffen oder die von mehreren Modulen benötigt werden, sind dagegen in der Unit "hauptu.pas" definiert worden.

Dazu gehören zum Beispiel FormCreate bzw. FormDestroy. Hier werden im wesentlichen nur diverse Bitmaps erzeugt bzw. zerstört, die in den Modulen benötigt werden. Zudem werden die Programmparameter aus der INI-Datei "picofpics.ini" geladen bzw. gespeichert.

const
  _caption='PicOfPics V1.0 (http://www.daniel-schwamm.de)';
  _inifn='picofpics.ini';
  _qpfn='qp.txt';
  _cr=#13#10;

  //counter-check fuer optimation
  _cc_ok=true;


type
  Thauptf = class(TForm)
   [...]
  public
    { Public-Deklarationen }
    homedir:string;

    //quad-pool------------------------
    qp_histobmp:tbitmap;
    qp_histoa:array[0..255]of double;

    //original---------------------------
    ob_bmp:tbitmap;
    ob_pixelbmp:tbitmap;
    ob_histobmp:tbitmap;
    ob_histoa:array[0..255]of double;

    //options--------------------------
    op_prevbmp:tbitmap;

    //result-----------------------------------
    eb_bmp,eb_pbbmp,eb_blendbmp,eb_quadbmp,eb_orgbmp:tbitmap;
    eb_hpos,eb_vpos:integer;
    eb_scrollok:bool;

    //counters for optimations
    cc_setbuttonsc:integer;
    cc_updateprevc:integer;

    //functions
    [...]
  end;

//------------------------------------------------------
procedure Thauptf.FormCreate(Sender: TObject);
begin
  caption:=_caption;
  homedir:=extractfilepath(application.exename);

  //counters for optimations
  cc_setbuttonsc:=0;
  cc_updateprevc:=0;

  //main-pagecontrol
  pctrl.align:=alclient;
  pctrl.ActivePageIndex:=0;

  //quad-pool-------------------------------
  qp_histobmp:=tbitmap.create;
  [...]

  //read programm-parameters
  with tinifile.create(homedir+_inifn) do begin

    //window-position
    top:=readinteger('param','top',top);
    left:=readinteger('param','left',left);
    width:=readinteger('param','width',width);
    height:=readinteger('param','height',height);
    if readbool('param','maximized',false) then
      windowstate:=wsmaximized;

    //quad-pool
    qp_dlb.directory:=readstring('qp','qp_dlb','c:\');
    qp_logchb.checked:=readbool('qp','qp_logchb',qp_logchb.checked);
    [...]

    free;
  end;

  qp_rdsg;

  //visible true => onresize!
  visible:=true;

  qp_imgp.Height:=qp_flb.Height;
  setbuttons;
end;

procedure Thauptf.FormDestroy(Sender: TObject);
begin
  deletefile(homedir+_inifn);

  with tinifile.create(homedir+_inifn) do begin

    //window-position
    if windowstate=wsmaximized then begin
      writebool('param','maximized',true);
    end
    else begin
      writeinteger('param','top',top);
      writeinteger('param','left',left);
      writeinteger('param','width',width);
      writeinteger('param','height',height);
      writebool('param','maximized',false);
    end;

    //quad-pool
    writestring('qp','qp_dlb',qp_dlb.directory);
    writebool('qp','qp_logchb',qp_logchb.checked);
    [...]

    free;
  end;

  //clean up
  qp_histobmp.free;
  [...]
end;

procedure Thauptf.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  canclose:=false;
  if
    not eb_u.eb_isempty and
    eb_bmp.Modified
  then begin
    if application.MessageBox(
      pchar(
        'Das Ergebnis-Bild wurde modifiziert.'+_cr+
        ' Wirklich Pics2Pic ohne Speichern verlassen?'
      ),
      '*** FRAGE ***',
      mb_yesno
    )=id_no then exit;
  end;
  canclose:=true;
end;

procedure Thauptf.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_escape then close;
end;

procedure Thauptf.FormResize(Sender: TObject);
begin
  eb_pbpaint(sender);
end;


Ohne Service geht es nicht

Einige Funktionen finden in mehreren Modulen Verwendung. Sie werden als "Service-Funktionen" ebenfalls in der Haupt-Unit implementiert.

Mit "getcoldiff" wird die Differenz zwischen zwei Farbwerten berechnet. Da sich Farben bei Windows aus drei Farbkanälen zusammensetzen, nämlich rot, grün und blau, ergibt sich die gesamte Farbdifferenz aus der Aditionen der absoluten Differenzen der Werte der drei Farbkanäle.

//calculate the difference between two colors
function thauptf.getcoldiff(c1,c2:tcolor):integer;
begin
  if(c1=-1)then begin
    result:=-1;
    exit;
  end;
  result:=
    abs(getrvalue(c1)-getrvalue(c2))+
    abs(getgvalue(c1)-getgvalue(c2))+
    abs(getbvalue(c1)-getbvalue(c2));
end;


Hell heisst grau

Um Farbwerte in Helligkeitswerte umzurechnen, werden diese in der Funktion "col2helligkeit" in Grauwerte konvertiert, indem die Werte der drei Farbkanäle aufaddiert und durch drei geteilt werden. Als Ergebnis erhält man einen Wert zwischen 0 und 255 zurück, wobei 0 schwarz und 255 weiss entspricht.

//calculate gray-value of a color
//=> 0=black, 255=white
function thauptf.col2helligkeit(col:tcolor):byte;
var
  r,g,b:byte;
begin
  r:=getrvalue(col);
  g:=getgvalue(col);
  b:=getbvalue(col);
  result:=trunc((r+b+g)/3);
end;


Scanline schlägt Pixel-Zugriff

Der direkte Zugriff auf die Pixel einer Canvas dauert in Delphi relativ lang. Weitaus schneller ist die Methode, sich mittels der Scanline-Funktion von TBitmap eine komplette Zeile einer Bitmap in ein PByteArray einzulesen, welches folgendermassen gefüllt wird:

blau grün rot blau grün rot blau grün rot ...
------------- ------------- -------------
Pixel 1       Pixel 2       Pixel 3

Beispiel:

0  0  0  255 255 255  0  0  0  0 0 255 ...
-------  -----------  -------  -----------
schwarz  weiss        schwarz  rot


Warum die Werte im PByteArray in der Reihenfolge "Blau-Grün-Rot" angeordnet sind, statt wie man erwarten könnte als "Rot-Grün-Blau" hat mich Anfangs auch ziemlich verwirrt. Das hat vermutlich was mit der internen Verarbeitung der Bitmaps zu tun, wo die Farbwerte durch eine einzige grosse 32 Bit-Zahl repräsentiert werden (nämlich als TColor), die sich wie folgt aufbaut:

Farbwert = 255*255*Blauanteil + 255*Grünanteil + Rotanteil


Naja, um nun die PByteArray-Werte eines Pixels an Position "x" in einen Farbwert umzurechnen, kann die Funktion "pba2col" verwendet werden.

//convert a scanline-value at x to color
function thauptf.pba2col(
  pba:pbytearray;
  x:integer
):tcolor;
var
  r,g,b:byte;
begin
  r:=pba[x*3+2];
  g:=pba[x*3+1];
  b:=pba[x*3+0];
  result:=rgb(r,g,b);
end;


Pixel-Shaker

In PicOfPics baut sich das Ergebnis-Bild aus mehreren "Quader"-Bildern zusammen. Diese Quader können später mittels der "verwackeln"-Prozedur zufällig abweichend von ihrerer idealen Positionen auf dem Ergebnis-Bild plaziert werden, was einige interessante Effekte erlaubt. Ebenso kann ihre Grösse variieren. Das Ausmass der "Verwacklung" ergibt sich aus der "idealen" Breite des Quaders "v" und einem optional veränderbaren Wert "proz".

//change quad-position and -size in random way
//(deoending on width of one quad)
function thauptf.verwackeln(v,proz:integer):integer;
var
  i:integeR;
  d:double;
begin
  //verwacklung aktiv?
  result:=0;if not op_wackelchb.Checked then exit;

  d:=v/op_qbreitese.value;
  i:=trunc(((op_qbreitese.value*proz)/100)/2);
  result:=trunc((random(i)-random(i))*$);
end;


Spektren der Helligkeit

Die folgende Funktion "mkhistoimg" generiert aus einem Array "ca" eine Histogramm-Grafik und kopiert diese nach "img". Das Array besteht aus ingesamt 255 Einzelwerten. Jeder dieser Werte gibt wieder, wie oft der zugehörige Index-Wert als Grauwert zuvor in einer Grafik ermittelt wurde. Wenn z.B. "ca[0]" den Wert "30" enthält, so bedeutet das, dass die Grafik exakt 30 Pixel mit dem Helligkeitswert 0 (also reines schwarz) enthält.

//transfer gray-value-array to histogram-image
procedure thauptf.mkhistoimg(
  img:timage;
  ca:array of double
);
var
  bmp:tbitmap;
  c,h:integer;
  max:double;
begin
  bmp:=tbitmap.Create;
  try
    bmp.PixelFormat:=pf24bit;

    //get maximum in gray-array
    max:=0;
    for c:=0 to 255 do begin
      if ca[c]>max then max:=ca[c];
    end;
    if max=0 then max:=1;

    //adapt histogramm dimension
    bmp.Width:=256;
    bmp.Height:=100+2+20;

    //clean up bitmap
    bmp.Canvas.Brush.color:=$0080FFFF;
    bmp.Canvas.FillRect(rect(0,0,bmp.width,bmp.Height));

    //paint histogramm
    for c:=0 to 255 do begin
      //change chart-color
      if c mod 2=0 then bmp.canvas.pen.color:=clblue
                   else bmp.canvas.pen.color:=clnavy;

      //norm to 100 percent
      h:=trunc(ca[c]*100/max);

      //set chart-hight to minimum 1 pixel
      if(h=0)and(ca[c]>0)then h:=1;

      //paint the chart
      bmp.Canvas.moveto(c,bmp.Height-20-2-h);
      bmp.Canvas.LineTo(c,bmp.Height-20-2);
      bmp.canvas.pen.color:=rgb(c,c,c);
      bmp.Canvas.moveto(c,bmp.Height-20);
      bmp.Canvas.LineTo(c,bmp.Height);
    end;

    //save to histogram-image
    img.Picture.Assign(bmp);
  finally
    bmp.Free;
  end;
end;


Was noch übrig bleibt

Die letzten Service-Funktionen aktivieren bzw. deaktivieren die Buttons der Hauptform je nach Programmstatus. So kann z.B. kein Ergebnis-Bild mittels des "Speichern"-Knopfes gepeichert werden, solange noch gar kein Ergebnis-Bild vorliegt.

Desweiteren werden die Hints von Scrollbars gesetzt, so dass sie den Wert der aktuelle Position wieder geben. Und dann werden noch ein paar Counter gesetzt, die anzeigen, wie oft bestimmte kritische Funktionen aufgerufen wurden, was bei der Programm-Optimierung hilfreiche Informationen liefert.

//enabled/disable buttons on form
procedure thauptf.setbuttons;
begin
  if not visible then exit;

  inc(cc_setbuttonsc);countercheck;

  //quad-pool---------------------------------
  qp_neub.Enabled:=(qp_flb.Items.count>0);
  if qp_neub.Enabled then qp_flb.color:=clwhite
                     else qp_flb.color:=clsilver;
  qp_entfernenb.enabled:=not qp_isempty;

  //original------------------------------
  ob_entfernenb.enabled:=not ob_isempty;
  [..]
end;

//set hints of scrollvars
procedure thauptf.setsbhint(sender:tobject);
var
  sb:tscrollbar;
begin
  if not(sender is tscrollbar) then exit;
  sb:=tscrollbar(sender);
  sb.hint:='Wert: '+inttostr(sb.position);
  sb.showhint:=true;
end;

//for optimations
procedure thauptf.countercheck;
begin
  if not _cc_ok then exit;
  caption:=
    _caption+' '+
   'SetButtons: '+inttostr(cc_setbuttonsc)+' | '+
   'UpdatePrev: '+inttostr(cc_updateprevc);
end;


Der Quader-Pool

Betrachten wir nun das Modul des "Quader-Pools". Hier werden die Bilder ("Quader") verwaltet, aus denen sich später das Ergebnis-Bild zusammensetzt.

PicOfPictures - Quader-Pool: Register-Page

Der Quader-Pool

Buntes Treiben im Pool

Ganz oben haben wir die Buttons "Neu", eine Progressbar und den Button "entfernen". Ein Klick auf "Neu" bewirkt, dass der Quader-Pool neu gefüllt wird. Je nach Anzahl der Quader kann dies einige Zeit benötigen, was in der Progressbar angezeigt wird. Über "Entfernen" kann der Quader-Pool jederzeit manuell gelöscht werden.

//fill quad-grid with colors auf quad-pics
procedure qp_fillsg;

  //get quality-value for quad-pic
  //(smaller pics wil set to better quality)
  function optscale(jpg:tjpegimage):tjpegscale;
  var
    w,h:integer;
  begin
    w:=jpg.width;
    h:=jpg.height;
    result:=jsEighth;
    if (h<8)or(w<8) then
      result:=jsfullsize
    else if (h<50)or(w<50) then
      result:=jshalf
    else if (h<400)or(w<400) then
      result:=jsquarter;
  end;

  //get and set smooth-colors in quad-grid
  procedure setverlaufcolors(
    bmp,pixelbmp:tbitmap;
    r:integer
  );
  var
    c,x,y:integer;
    pba:pbytearray;
  begin
    //reduce quad-pic to 3 x 3 pixels
    pixelbmp.canvas.StretchDraw(rect(0,0,3,3),bmp);

    //pixel-colors into quad-grid
    c:=ord(_qp_verlauf11);
    for y:=0 to 2 do begin
      pba:=pixelbmp.scanline[y];
      for x:=0 to 2 do begin
        hauptf.qp_sg.cells[c,r]:=
          inttostr(hauptf.pba2col(pba,x));
        inc(c);
      end;
    end;
  end;

var
  r,rr:integer;
  jpg:tjpegimage;
  bmp,pixelbmp:tbitmap;
begin
  if hauptf.qp_neub.Caption='Neu' then begin
    screen.cursor:=crhourglass;
    hauptf.qp_neub.Caption:='STOPP';
    qp_clrsg;

    jpg:=tjpegimage.Create;
    bmp:=tbitmap.Create;
    pixelbmp:=tbitmap.Create;
    try
      //pixelbmp-dimension 3 x 3
      pixelbmp.PixelFormat:=pf24bit;
      pixelbmp.Width:=3;
      pixelbmp.Height:=3;

      //bitmap-holder fuer jpg
      bmp.PixelFormat:=pf24bit;

      hauptf.qp_prgb.Max:=hauptf.qp_flb.items.count-1;
      rr:=1;
      for r:=0 to hauptf.qp_flb.items.count-1 do begin
        try
          hauptf.qp_flb.itemindex:=r;
          hauptf.qp_prgb.position:=r;
          application.processmessages;
          if hauptf.qp_neub.Caption<>'STOPP' then
            break;

          //read pic
          jpg.Scale:=jsfullsize;
          jpg.LoadFromFile(
            hauptf.qp_dlb.directory+'\'+
            hauptf.qp_flb.items[r]
          );

          //set quality (depends on size)
          jpg.Scale:=optscale(jpg);

          //convert to bmp
          bmp.Assign(jpg);

          //calculate middle-color
          hauptf.qp_sg.cells[ord(_qp_farbe),rr]:=
            inttostr(
              qp_middlecolor(
                bmp,
                0,0,bmp.Width,bmp.height
              )
            );
          hauptf.qp_sg.cells[ord(_qp_nr),rr]:=inttostr(rr);
          hauptf.qp_sg.cells[ord(_qp_fn),rr]:=hauptf.qp_flb.items[r];

          //set smooth-colors
          setverlaufcolors(bmp,pixelbmp,rr);

          inc(rr);
        except
          //ignore bad pics
        end;
      end;

      //adapt quad-grid-rowcount
      if rr=1 then rr:=2;
      hauptf.qp_sg.RowCount:=rr;

      //save quad-grid
      qp_wrsg;

      //build histogram
      qp_mkhistoimg;

      //check first entry
      hauptf.qp_sg.Row:=1;
      qp_sgClick;

      //clean up
      hauptf.qp_prgb.position:=0;
      hauptf.qp_neub.Caption:='Neu';
    finally
      pixelbmp.free;
      bmp.Free;
      jpg.Free;
      op_updateprev;
      hauptf.setbuttons;
      screen.cursor:=crdefault;
    end;
  end
  else begin
    //stopp-button clicked
    hauptf.qp_neub.Caption:='Neu';
  end;
end;

//set head of quad-grid-----------------
procedure qp_setheadsg;
begin
  hauptf.qp_sg.Cells[ord(_qp_nr),0]:='Nr';
  hauptf.qp_sg.Cells[ord(_qp_fn),0]:='Bild';
  hauptf.qp_sg.Cells[ord(_qp_farbe),0]:='Mittel';
  hauptf.qp_sg.Cells[ord(_qp_verlauf11),0]:='Verlauf';
end;

//delete quad-grid-------------------------
procedure qp_clrsg;
var
  c:integer;
begin
  for c:=0 to ord(_qp_c)-1 do
    hauptf.qp_sg.cols[c].Clear;

  hauptf.qp_sg.rowcount:=2;
  hauptf.qp_sg.ColCount:=ord(_qp_verlauf11)+1;
  qp_setheadsg;

  //delete histogram
  qp_mkhistoimg;

  //new quad-preview
  qp_sgClick;
  hauptf.setbuttons;
end;


Was wird hier gemacht?

In der Prozedur "qp_fillsg" stellen wir zunächst fest, ob das Füllen der Quader-Stringgrid "qp_sg" gestartet oder beendet werden soll. Das lässt sich anhand des "Neu"-Buttons ermitteln. Der wechselt nämlich die Caption je nach Aktion von "Neu" auf "STOPP" und umgekehrt.

Soll die Stringgrid gefüllt werden, so durchlaufen wir alle Einträge der FileListBox "qp_flb". Wir setzen jeweils die Progressbar auf die neue Position und prüfen, ob es inzwischen zu einer manuellen Unterbrechung gekommen ist.

Klein ist schnell

Falls nicht, laden wir das aktuelle Quader-Bild in "jpg" ein. Je nach Grösse des Bildes wird die Skalierung von "jpg" geändert. Dies regeln wir über die interne Funktion "optscale". Es gilt: Je kleiner das Bild ist, um so höher muss seine Qualität bleiben, damit die einzelnen Farbwerte nicht zu sehr verfälscht werden.

Natürlich könnte man generell mit der höchsten Qualitäts-Skalierung arbeiten. Das würde aber den Scan-Vorgang bei grossen Bildern erheblich verlangsamen, ohne nennenswert bessere Ergebnisse zu erbringen.

Bei der Skalierung wird die Dimension des Quader-Bildes verkleinert, sofern nicht "jsfullsize" vorliegt. Hat ein Bild nach dem Einladen z.B. die Breite "455" Pixel und die Höhe "341" Pixel, wird die Skalierung "jsquarter" gewählt, wodurch das resultierende Bild auf "114" Pixel Breite und "86" Pixel Höhe verkleinert wird. Das beschleunigt natürlich alle weiteren Aktionen mit diesem Image.

Mittel zum Mitteln

Im nächsten Schritt wird das "jpg"-Image in eine Bitmap "bmp" kopiert. Das ist nötig, damit wir auf die einzelnen Farbwerte des Bildes zugreifen können; dies ist generell nur bei Bitmaps möglich.

Die Bitmap wird an die Prozedur "qp_middlecolor" übergeben, die uns dann deren Mittel-Farbe zurückliefert:

//middlecolor of 'inner' bitmap
function qp_middlecolor(
  bmp:tbitmap;
  l,t,w,h:integer
):tcolor;
var
  anz,x,y:integer;
  //col:tcolor;
  rc,gc,bc:int64;
  pba:pbytearray;
begin
  rc:=0;gc:=0;bc:=0;
  for y:=t to t+h-1 do begin
    pba:=bmp.scanline[y];
    for x:=l to l+w-1 do begin
      //add colors of red,green,blue
      rc:=rc+pba[x*3+2];
      gc:=gc+pba[x*3+1];
      bc:=bc+pba[x*3+0];
    end;
  end;

  //calculate middle of color-sums
  anz:=w*h;
  rc:=round(rc/anz);
  gc:=round(gc/anz);
  bc:=round(bc/anz);

  //give back middle color
  result:=rgb(rc,gc,bc);
end;


Die Bitmap wird dazu zeilenweise durchlaufen. Wie bereits erwähnt, liefert uns die Scanline-Funktion jeweils eine komplette Zeile der Bitmap in einem PByteArray zurück. Dieses PByteArray gehen wir nun "pixelweise" durch, wobei jedes Pixel durch drei PByteArray-Werte repräsentiert wird, die die Werte der Farbkanäle rot, grün und blau enthalten. Die summieren wir einzeln auf. Danach teilen wir diese Summen durch die Anzahl der Pixel in der Bitmap und erhalten so die Durchschnittswerte der Farbkanäle über die gesamte Bitmap. Zuletzt machen wir daraus wieder einen "Gesamtfarbwert" und liefern diesen zurück.

Wieder in der "qp_fillsg"-Prozedur tragen wir den gerade ermittelten "Gesamtfarbwert" als Mittel-Farbe in die Quader-Stringrid "qp_sg" ein. Ausserdem merken wir uns hier den Namen des Quader-Bildes.

Exakter durch Verlauf

Über die Mittel-Farbe des Quader-Bildes kann PicOfPics später prüfen, ob sich ein Quader-Bild als Repräsentant für ein Pixel des Original-Bildes eignet. Je änlicher die Farbwerte sind, umso besser natürlich das Ergebnis.

Noch eine Stufe weiter geht der "Verlaufs-Modus". Hier werden jweils 3 x 3 Pixelblöcke des Orginalbildes mit 3 x 3 Verlauf-Farben der Quader-Pics verglichen. Die Verlauf-Farben der Quader-Bilder ermitteln wir in einem nächten Schritt über die interne Prozedur "setverlaufcolors".

Hier wird die Quader-Bitmap "bmp" zunächst über die "StretchtDraw"-Methode des Canvas in eine 3 x 3 Pixel grosse "pixelbmp" verkleinert. Windows erledigt dabei für uns den schwierigen Job, das Original möglichst exakt in die verkleinerte Form zu transferieren. Dann holen wir uns einfach alle 9 Farbwerte der "pixelbmp" und sichern sie als Verlauf-Farben in der Quader-Stringgrid "qp_sg".

PicOfPictures - Quader-Pool: Verlauf-Farben

Verlauf-Farben: Quader-Bilder als 3 x 3 Pixel-Bitmaps

Die Quelle des Pools

Auf der linken Seite der Quader-Pool-Page finden wir eine DriveCombobox, ein DirectoryListbox und die Filelistbox "qp_flb". Über diese Komponenten wird der Ordner ausgwählt, der die Quader-Bilder enthält.

Das sind reichlich antiquirte Form-Elemente. In meiner ursprünglichen Version von PicOfPics hatte ich hier etwas Schöneres verwendet. Doch da das Tutorial für jedermann gedacht ist und nicht jeder Willens ist, sich neue Komponenten in sein Delphi-System zu installieren, finden sich hier nun diese Standards.

Klickt man in die Filellistbox "qp_flb" wird das Ereignis "OnChange" ausgelöst, was wiederum die Funktion "qp_ldimg" aufruft:

//load quad-pic-------------------------
procedure qp_ldimg;
var
  r:integer;
  fn:string;
begin
  try
    hauptf.qp_img.Picture.Graphic:=nil;
    r:=hauptf.qp_flb.ItemIndex;
    if r=-1 then exit;

    fn:=hauptf.qp_flb.Items[r];
    try
      //file in quad-grid?
      for r:=1 to hauptf.qp_sg.RowCount-1 do begin
        if hauptf.qp_sg.cells[ord(_qp_fn),r]<>fn then
          continue;

        //mark entry-row
        hauptf.qp_sg.col:=ord(_qp_fn);
        hauptf.qp_sg.row:=r;
        break;
      end;

      //read from disk
      hauptf.qp_img.picture.loadfromfile(
        hauptf.qp_dlb.Directory+'\'+fn
      );
    except
      //shit happens
      hauptf.qp_img.Picture.Graphic:=nil;
    end;
  finally
    //set 'cursor' on histogram
    qp_sethistocursor;
  end;
end;


Hier wird zunächst der Name der angeklickten Datei ermittelt. Dann wird geprüft, ob sich das Bild bereits in der Quader-Stringgrid befindet. Falls ja, wird der entsprechende Eintrag markiert. Anschliessend wird das Bild in "qp_img" eingeladen und als Vorschau angezeigt.

Wie hell bin ich?

Zuletzt wird die Funktion "qp_sethistocursor" aufgerufen. Die sorgt dafür, dass der "Helligkeitswert" des Quader-Bildes im Histogramm als "Cursorlinie" eingezeichnet wird.

//set 'cursor' on histogramm--------------
//(gray-value of actually quad-pic)
procedure qp_sethistocursor;
var
  x,helligkeit,hfg:integer;
  bmp:tbitmap;
  col:tcolor;
  hfgproz:double;
  s:string;
begin
  hauptf.qp_sh.brush.color:=clsilver;
  hauptf.qp_helle.Text:='';
  hauptf.qp_haeufe.Text:='';

  if qp_isempty then exit;

  bmp:=tbitmap.create;
  try
    //get original histogram
    bmp.assign(hauptf.qp_histobmp);

    //get middle-color
    col:=strtoint(
      hauptf.qp_sg.cells[ord(_qp_farbe),hauptf.qp_sg.Row]
    );
    hauptf.qp_sh.Brush.color:=col;

    //calculate gray-value
    helligkeit:=hauptf.col2helligkeit(col);
    hauptf.qp_helle.Text:=inttostr(helligkeit);

    //number of that gray-value in histogram
    hfg:=trunc(hauptf.qp_histoa[helligkeit]);
    s:=inttostr(hfg);
    hfgproz:=(hfg*100)/(hauptf.qp_sg.RowCount-1);
    s:=s+' ('+format('%f',[hfgproz])+'%)';
    hauptf.qp_haeufe.Text:=s;

    //'cursor'-line for histogram
    x:=helligkeit;
    bmp.canvas.pen.width:=1;
    bmp.canvas.pen.color:=clgreen;
    bmp.Canvas.MoveTo(x,0);
    bmp.Canvas.lineTo(x,bmp.height);

  finally
    //show (new) histogram
    hauptf.qp_histoimg.picture.assign(bmp);
    bmp.free;
  end;
end;


Dazu wird zunächst die originale Histogramm-Bitmap aus "qp_histobmp" in "bmp" kopiert. "Original" deshalb, weil diese Bitmap das berechnete Histogramm ohne eingezeichnete Cursorlinie enthält. Wir wir die "qp_histobmp" genau generieren, sehen wir später noch.

Aus der Quader-Stringgrid erhalten wir die Mittel-Farbe des angeklickten Quader-Bildes. Wir wandeln diese Farbe nun mit der uns bereits bekannten Funktion "col2helligkeit" in einen Helligkeitswert (Grauwert) um.

Jetzt noch etwas Arithmetik und wir wissen, an welcher x-Koordinate sich der Cursor in der von 0 bis 255 reichenden Graustufen-Skala des Histogramms befinden muss.

An dieser Stelle tragen wir eine grüne Linie über die komplette Höhe des Histogramms ein und kopieren die Hilf-Bitmap "bmp" in "qp_histoimg", um sie so zur Anzeige zu bringen.

Okay, über die Sinnhaftigkeit des Histogramm-Cursors kann man streiten. Aber das bringt immerhin etwas Leben in die Quader-Pool-Page :-)

PicOfPictures - Quader-Pool: Histogramm Cursor I

Histogramm-Cursor I: Dark Angle, der Cursor ist ganz links

PicOfPictures - Quader-Pool: Histogramm Cursor II

Histogramm-Cursor II: Hell, wie ein Stern, der Cursor ist ganz rechts

Wir sehen nur ein Abbild der Welt

Rechts in der Quader-Pool-Page befindet sich die Quader-Stringgrid. Sie enthält die Namen der gescannten Quader-Bilder, ihre Mittel-Farben" und ihre 3 x 3 Verlauf-Farben.

Auch wenn es nicht so aussieht: Die Farbwerte sind tatsächlich als Strings in den einzelne Spalten der Stringgrid eingetragen worden. Der Index der Spalten ist folgendermassen definiert:

type
  //index for quad-stringgrid
  _qp_inx=(
    _qp_nr,
    _qp_fn,
    _qp_farbe,

    _qp_verlauf11,
    _qp_verlauf21,
    _qp_verlauf31,

    _qp_verlauf12,
    _qp_verlauf22,
    _qp_verlauf32,

    _qp_verlauf13,
    _qp_verlauf23,
    _qp_verlauf33,

    _qp_c
  );


Da nun aber die Farbwerte als reine Zahlen wenig informativ sind (ausser für die paar Helden, die in der "Matrix" lesen können), werden sie im "OnDrawCell"-Ereignis der Quader-Stringgrid "qp_sg" in eine optisch ansprechendere Form transferiert.

//painting the quad-grid-rcells--------------------------
procedure qp_sgDrawCell(
  Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState
);
var
  s:string;
  c,l,t,w,x,y:integer;
  cnv:tcanvas;
  rec:trect;
  dw,dh:double;
begin

  cnv:=hauptf.qp_sg.Canvas;
  s:=hauptf.qp_sg.cells[acol,arow];

  try
    //background color
    if state=[] then begin
      //not marked: set own color
      if acol=ord(_qp_fn) then
        cnv.brush.color:=clwhite
      else if acol=ord(_qp_farbe) then
        cnv.brush.color:=strtoint(s)
      else if acol=ord(_qp_verlauf11) then begin

        //paint a 3x3 color pattern
        c:=ord(_qp_verlauf11);
        dw:=(rect.Right-rect.Left)/3;
        dh:=(rect.Bottom-rect.Top)/3;

        for y:=0 to 2 do begin
          for x:=0 to 2 do begin
            cnv.brush.color:=strtoint(
              hauptf.qp_sg.cells[c,arow]
            );

            rec.Left:=rect.Left+trunc(x*dw);
            rec.Right:=rec.left+trunc(dw);

            rec.top:=rect.top+trunc(y*dh);
            rec.bottom:=rec.top+trunc(dh);

            cnv.FillRect(rec);
            inc(c);
          end;
        end;
        exit;
      end;
    end;
    cnv.FillRect(rect);

    //dont show values of color-entries
    if(arow>0)and(acol>=ord(_qp_farbe))then exit;

    //text-aligment
    if acol=ord(_qp_nr) then begin
      //right
      w:=cnv.textwidth(s);
      l:=rect.Right-w-4;
    end
    else begin
      //left
      l:=rect.left+2;
    end;

    //place it in the middle
    t:=
      rect.Top+
      (
        (
          rect.Bottom-
          rect.Top-
          cnv.textheight(s)
        ) div 2
      );

    //paint text
    cnv.TextOut(l,t,s);
  except
  end;
end;


Wir prüfen, in welcher Zeile und Spalte wir uns befinden. Bei den ersten beiden Spalten (Nr und Quader-Name) wird der Zelleninhalt einfach mit der Canvas-Funktion "textout" ausgegeben. Befinden wir uns in der "Mittelfarbe"-Spalte, wandeln wir den Inhalt zum Farbwert und setzen die Zellen-Hintergrund-Farbe über den Canvas-Brush auf den gleichen Wert. Wird dagegen die erste Verlauf-Farben-Spalte bearbeitet, dann verwenden wir die Inhaltswerten der letzten 9 Spalten, um damit eine 3 x 3 Grafik auf dem Canvas der Zelle auszugeben. Da die Eigenschaft "ColCount" von "qp_sg" künstlich auf 4 herabgesetzt wurde, werden alle restlichen "virtuellen" Spalten bei der Anzeige ignoriert.

Puhl den Pool von und auf Platte

PicOfPics speichert den jeweils zuletzt ermittelten Quader-Pool als Textfile "qp.txt" im Arbeitsordner. Als Delimeter wird "|" verwendet. Beim Neustart wird die Datei wieder eingelesen, wobei je Eintrag geprüft wird, ob die zugehörige Datei physikalisch noch vorhanden ist.

//reading quader-sg from disk------------------------
procedure qp_rdsg;
var
  r,c,cc:integer;
  tf:textfile;
  fn,s,ss:string;
begin
  //reset quad-pool.grid
  qp_clrsg;

  //read quad-sg from file
  if fileexists(hauptf.homedir+_qpfn)then begin
    r:=0;
    assignfile(tf,hauptf.homedir+_qpfn);
    try
      reset(tf);
      while not eof(tf) do begin
        readln(tf,s);
        for c:=0 to ord(_qp_c) do begin
          cc:=pos('|',s);if cc=0 then cc:=length(s)+1;
          ss:=copy(s,1,cc-1);
          hauptf.qp_sg.cells[c,r]:=ss;
          s:=copy(s,cc+1,length(s));
        end;
        inc(r);
      end;
    finally
      closefile(tf);
    end;

    //adapt rowcount of quad-grid
    if r<2 then r:=2;
    hauptf.qp_sg.rowcount:=r;

    //check quad-pics <-> picture-liste in directory
    for r:=hauptf.qp_sg.rowcount-1 downto 1 do begin
      fn:=
        hauptf.qp_dlb.directory+'\'+
        hauptf.qp_sg.cells[ord(_qp_fn),r];

      //ok?
      if fileexists(fn) then continue;

      //no - quad does not exitsts
      if hauptf.qp_sg.rowcount>2 then begin
         //del row in quad-grid
         hauptf.qp_sg.rows[r].clear;
      end
      else begin
        //del entry, but keep the row
        for c:=0 to ord(_qp_c)-1 do
          hauptf.qp_sg.cells[c,r]:='';
      end;
    end;

    //quad-grid totally empty?
    if qp_isempty then qp_clrsg;

    //save to disk
    qp_wrsg;

    //show histogram
    qp_mkhistoimg;
    qp_sgclick;
  end;
end;

//write quad-grid to disk--------------------
procedure qp_wrsg;
var
  tf:textfile;
  r,c:integer;
  s:string;
begin
  //del previous quad-pool
  deletefile(hauptf.homedir+_qpfn);

  //if quad-grid is empty, nothing to do
  if qp_isempty then exit;

  //save grid as textfile
  assignfile(tf,hauptf.homedir+_qpfn);
  try
    rewrite(tf);
    for r:=0 to hauptf.qp_sg.RowCount-1 do begin
      s:='';
      for c:=0 to ord(_qp_c)-1 do begin
        s:=s+hauptf.qp_sg.cells[c,r]+'|';
      end;
      writeln(tf,s);
    end;
  finally
    closefile(tf);
  end;
end;


Qualität des Pools

Im unteren Teil der Quader-Pool-Page zeigt ein Histogramm, welcher Helligkeitsbereich mit den Quader-Bildern abgedeckt wird. Die "Qualität" des Pools ist allgmein umso besser, je breiter das Spektrum ist. Für den Einzelfall wichtiger ist jedoch, dass sich das Histogramm einigermassen mit dem des Original-Bildes deckt.

Generiert wird das Histogramm des Quader-Pools mittels der Prozedur "qp_mkhistoimg". Um die Sache übersichtlich zu halten, wird nur die Mittel-Farbe der Quader beachtet, nicht deren Verlauf-Farben.

//create histogram over all quad-pics-----------------
procedure qp_mkhistoimg;
var
  ca:array[0..256]of double;
  c,r,helligkeit:integer;
  col:tcolor;
begin
  //reset gray-color-array
  for c:=0 to 255 do ca[c]:=0;

  //quad loaded?
  if not qp_isempty then begin
    for r:=1 to hauptf.qp_sg.rowcount-1 do begin
      //get color-entry of quad-grid
      col:=tcolor(
        strtoint(
          hauptf.qp_sg.cells[ord(_qp_farbe),r]
        )
      );

      //convert color-value to gray-color
      helligkeit:=hauptf.col2helligkeit(col);

      //increase counter in gray-array
      ca[helligkeit]:=ca[helligkeit]+1;
    end;

    //save back values of gray-array
    for c:=0 to 255 do
      hauptf.qp_histoa[c]:=ca[c];

    //want a logarithm norm of values?
    if hauptf.qp_logchb.checked then begin
      for c:=0 to 255 do
        ca[c]:=ln(1+ca[c]);
    end;
  end;

  //transfer gray-array to bitmap
  hauptf.mkhistoimg(
    hauptf.qp_histoimg,ca
  );

  //save histogram
  hauptf.qp_histobmp.assign(
    hauptf.qp_histoimg.Picture
  );
end;


Zunächst werden die 255 Werte des Array "ca" auf Null gesetzt. Dann durchlaufen wir den Quader-Pool, holen uns die jeweilige Mittel-Farbe, wandeln sie in einen Grauwert um, der ja von 0 bis 255 reichen kann, und benutzen diesen Grauwert als Index für den Array-Eintrag, der anschliessend inkrementiert wird. So steht am Schluss in "ca", wie oft welcher Grauwert im Quader-Pool gefunden wurde.

Optional können die Histogrammwerte "normiert" werden, um die Dominanz bestimmter Helligkeitswerte zu relativieren. Das sehen wir uns gleich nochmal beim Original-Bild näher an.

Das Original-Bild

Jetzt wenden wir uns der Verwaltung desjenigen Bildes zu, welches durch die eben bestimmten Quader "nachgebaut" werden soll.

PicOfPictures - Original: Register-Page

Page des Original-Bildes

Orginalität von Platte

Das Einladen geschieht über die Prozedur "ob_rdimg":

//remove original-pic-------------------------
procedure ob_entfernen;
begin
  hauptf.ob_img.Picture.Graphic:=nil;
  hauptf.ob_img.Hint:='Kein Quellbild';
  hauptf.ob_fne.Text:='';
  ob_mkhistoimg;
  op_updateprev;
  hauptf.setbuttons;
end;

//check if original-bild is loaded
function ob_isempty:bool;
begin
  result:=(hauptf.ob_img.Picture.Graphic=nil);
end;

//load original-image from file------------------------
procedure ob_rdimg(fn:string);
begin
  screen.Cursor:=crhourglass;
  try
    //remove previous
    ob_entfernen;
    if not fileexists(fn) then exit;

    try
      //get new one
      hauptf.ob_img.Picture.loadfromfile(fn);
      hauptf.ob_fne.text:=fn;

      //save original to bmp
      hauptf.ob_bmp.assign(
        hauptf.ob_img.Picture.graphic
      );

      //set hint informations
      hauptf.ob_img.Hint:=
        'Original-Bild '+hauptf.ob_fne.text+_cr+
        'Dimension: '+
        inttostr(hauptf.ob_bmp.width)+
        ' x '+
        inttostr(hauptf.ob_bmp.Height)+
        ' Pixel';
    except
    end;
  finally
    //make histogram und preview
    ob_mkhistoimg;
    op_updateprev;
    hauptf.setbuttons;
    screen.Cursor:=crdefault;
  end;
end;


Zuerst wird ein eventuell vorhandenen Original-Bild entfernt, dann das Bild über die "LoadFromFile"-Methode des TImage "ob_img" eingeladen. Für die weitere Arbeit wird das Original in der Bitmap "ob_bmp" gesichert. Zuletzt wird das zugehörige Histogramm erstellt und in der Options-Page die Vorschau neu generiert.

Das ganze Spektrum auf einen Blick

Das Histogram des Original-Bildes wird ähnlich erstellt, wie das des Quader-Pools. Nur dass diesmal nicht die Helligkeitswerte einzelner Mittel-Farben von Quadern verwendet werden, sondern die Helligkeitswerte jedes einzelnen Pixels des Original-Bildes:

//create gray-value-histogram of original
procedure ob_mkhistoimg;
var
  x,y,c,helligkeit:integer;
  col:tcolor;
  ca:array[0..255]of double;
  pba:pbytearray;
begin
  //reset gray-value-array
  for c:=0 to 255 do ca[c]:=0;

  if hauptf.ob_bmp.height>0 then begin
    //fill gray-array with numbers
    //of gray-values in original-bmp
    for y:=1 to hauptf.ob_bmp.height-1 do begin
      pba:=hauptf.ob_bmp.ScanLine[y];
      for x:=1 to hauptf.ob_bmp.width-1 do begin
        //get pixel-color
        col:=hauptf.pba2col(pba,x);

        //convert to gray
        helligkeit:=hauptf.col2helligkeit(col);

        //increase gray-value in array
        ca[helligkeit]:=ca[helligkeit]+1;
      end;
    end;

    //save gray-array
    for c:=0 to 255 do hauptf.ob_histoa[c]:=ca[c];

    //want logarithm norm?
    if hauptf.ob_logchb.checked then begin
      for c:=0 to 255 do ca[c]:=ln(1+ca[c]);
    end;

  end;

  //transfer gray-array to histogram-image
  hauptf.mkhistoimg(hauptf.ob_histoimg,ca);

  //save histogram
  hauptf.ob_histobmp.assign(hauptf.ob_histoimg.Picture);
end;


Bändigung von Dominanz

Da in einigen Bilder bestimmte Helligkeitswerte stark dominieren können, führt dies unter Umständen zu Histogrammen, deren Aussagekraft eingeschränkt wird, weil feinere Abstufungen nicht mehr zu erkennen sind.

PicOfPictures - Original: Histogramm unnormiert

Histogramm unnormiert: Weiss dominiert, andere Graustufen sind nicht oder nur kaum zu erkennen

Um diesen Effekt abzumildern, können die Histogramm-Werte optional normiert werden, indem die "Ausreisser" mittels einer Logarithmus-Funktion "geglättet" werden:

PicOfPictures - Original: Histogramm normiert

Histogramm normiert: Das Helligkeitsspektrum lässt feinere Abstufungen erkennen

Der Cursor verrät die Helligkeit

Ähnlich wie beim Quader-Pool wollen wir auch in das Histogramm des Original-Bildes einen "Cursor" einzeichnen. Er soll den Helligkeitswert anzeigen, den das Pixel besitzt, über dem wir uns mit der Maus gerade befinden. Dazu fangen wir das TImage-Ereignis "OnMouseMove" ab:

//mouse moves on original image----------------------
//set 'cursor' in histogram
procedure ob_imgMouseMove(
  Sender: TObject;
  Shift: TShiftState;
  X,Y: Integer
);
var
  l,t,w,h,
  helligkeit,hfg:integer;
  bmp:tbitmap;
  col:tcolor;
  d,hfgproz:double;
  s:string;
begin
  hauptf.ob_sh.brush.color:=clsilver;
  hauptf.ob_helle.Text:='';
  hauptf.ob_haeufe.Text:='';

  if ob_isempty then exit;

  bmp:=tbitmap.create;
  try
    //get backup of histogram
    bmp.assign(hauptf.ob_histobmp);

    //calculate position of 'inner' image in paintbox
    hauptf.getinnerbounds(
      hauptf.ob_img.Width,
      hauptf.ob_img.height,
      hauptf.ob_bmp.Width,
      hauptf.ob_bmp.height,
      l,t,w,h
    );

    //mouse over image?
    x:=x-l;if(x<0)or(x>w)then exit;
    y:=y-t;if(y<0)or(y>h)then exit;

    //convert position to original-image
    d:=hauptf.ob_bmp.Width/w;
    x:=trunc(x*d);
    y:=trunc(y*d);

    //get color-value under mouse
    col:=hauptf.ob_bmp.canvas.Pixels[x,y];
    hauptf.ob_sh.Brush.color:=col;

    //convert to gray-value
    helligkeit:=hauptf.col2helligkeit(col);
    hauptf.ob_helle.Text:=inttostr(helligkeit);

    //show number of gray-values in hitogram-array
    hfg:=trunc(hauptf.ob_histoa[helligkeit]);
    s:=inttostr(hfg);
    hfgproz:=(hfg*100)/(hauptf.ob_bmp.Width*hauptf.ob_bmp.height);
    s:=s+' ('+format('%f',[hfgproz])+'%)';
    hauptf.ob_haeufe.Text:=s;

    //paint 'cursor'-line in histogram
    x:=helligkeit;
    bmp.canvas.pen.width:=1;
    bmp.canvas.pen.color:=clgreen;
    bmp.Canvas.MoveTo(x,0);
    bmp.Canvas.lineTo(x,bmp.height);

  finally
    //show (new) histogram
    hauptf.ob_histoimg.picture.assign(bmp);
    bmp.free;
  end;
end;


Es muss ermittelt werden, über welchem Pixel wir uns mit der Maus befinden. Dazu wird zunächst berechnet, ab wo das im Image-Bereich zentrierte "innere" Bild eigentlich beginnt. Diese Information erhalten wir von der bereits beschriebene Funktion "getinnerbounds".

Befinden wir uns mit der Maus im "Aus", wird nichts weiter gemacht. Befinden wir uns jedoch über dem "inneren" Bild, so rechnen wir nun die aktuellen Maus-Koordinaten auf das Original-Bild hoch - denn das kann ja grösser oder kleiner sein als das proportional angepasst angezeigte Bild. Haben wir die konvertierten Koordinaten, können wir den Farbwert des entspechenden Pixels im Original-Bild holen. Umgewandelt in einen Grauwert, der als Index im Histogramm-Array verwendet wird, lassen sich weitere Informationen gewinnen. Zuletzt wird der "Cursor" an passender Stelle in das Histogramm eingezeichnet.

PicOfPictures - Original: Histogramm-Cursor

Histogramm-Cursor: Die Maus befindet sich gerade über Victorias dunklem Haar

Zusammengequetschte Pixelhaufen

Bleibt noch eine Prozedur zu beschreiben, nämlich "ob_mkpixelbmp". Hier wird das Original-Bild in "komprimierter" Form auf die Bitmap "ob_pixelbmp" kopiert. Sie bekommt die Dimension, die durch die in der Optionen-Page vorgegebene Anzahl horizontaler Quader vorgegeben ist. So steht jedes Pixel der "ob_pixelbmp" für ein Quader-Bild im späteren Ergebnis-Bild. Sollte der "Verlaufsmodus" aktiv sein, verdreifachen sich entsprechend Breite und Höhe, da nun jeweils 3 x 3 Pixel für ein Quader-Bild stehen.

//create pixelbmp: reduce original to quad-dimension
//=> every pixel represents one quader
procedure ob_mkpixelbmp(prevok:bool);
var
  rec:trect;
  w,h:integer;
begin
  //set options-infos
  op_u.op_setebinfo;

  //is there an original-pic
  if ob_isempty then exit;

  //get dimension of quads
  w:=hauptf.op_qhorzse.value;
  h:=strtoint(hauptf.op_qverte.text);

  //just preview?
  if not prevok then begin
    //no: want smooth-mode?
    if hauptf.op_verlaufchb.checked then begin
      //yep, increase dimension
      //(smooth needs 3x3 pixels for one quader)
      w:=w*3;
      h:=h*3;
    end;
  end;

  //set dimension of pixelbmp
  hauptf.ob_pixelbmp.width:=w;
  hauptf.ob_pixelbmp.Height:=h;

  //reduce original to pixelbmp
  if prevok or (w<4) then begin
    //fast stretch
    rec:=rect(0,0,w,h);
    hauptf.ob_pixelbmp.Canvas.StretchDraw(rec,hauptf.ob_bmp);
  end
  else begin
    //optimized thumb
    op_u.op_optthumb(hauptf.ob_bmp,hauptf.ob_pixelbmp);
  end;
end;


Die Optionen

Das grundsätzliche Aussehen des Ergebnis-Bildes wird durch die Einstellungen in der Optionen-Page vorgegeben: Original-Bild als Hintergrundbild, Anzahl horizontaler Quader, die Breite jedes Quaders in Pixeln, Verlaufsmodus, Verwacklungsmodus, Quader-Rand, Mal-Wahrscheinlichkeit, Qualität der Quader usw.

PicOfPictures - Optionen: Register-Page

Optionen-Page: Viele Schrauben zum Drehen

Zeige, wie ist, was sein wird

Fast alle Änderungen an den Optionen bewirken die sofortige Neuberechnung des Vorschau-Bildes über die Prozedur "op_mkprevbmp". Wie wir noch sehen werden, arbeitet diese Prozedur ähnlich wie die "echte" PicOfPics-Prozedur, nur dass statt Quader-Bilder einfach passend gefärbte Rechtecke verwendet werden (tatsächlich wäre es möglich und sinnvoll gewesen, Vorschau und Original-Bild mit der gleichen Prozedur zu generieren, aber als ich endlich auf diese Idee kam, war's schon zu spät, als dass mir das noch Vorteile gebracht hätte).

//make preview-bmp: original width quads as pixels
procedure op_mkprevbmp(zbmp:tbitmap);

  //convert int to byte------------
  function i2b(i:integer):byte;
  begin
    if i<0 then i:=0;
    if i>255 then i:=255;
    result:=byte(i);
  end;

var
  ql,qt,qw,qh,
  ww,hh,
  l,t,w,h,
  x,y,
  helligkeit,
  vy,
  yanz:integer;
  dx,dy,dvy:double;
  col:tcolor;
  in_hellbereich:bool;
  pba:pbytearray;
  r,g,b,rc,gc,bc:byte;
begin
  if not hauptf.visible then exit;

  //for optimation
  inc(hauptf.cc_updateprevc);hauptf.countercheck;

  //set preview-bmp dimension to paintbox-dimension
  hauptf.op_prevbmp.Width:=hauptf.op_prevpb.width;
  hauptf.op_prevbmp.height:=hauptf.op_prevpb.height;

  //paint plane background
  hauptf.op_prevbmp.Canvas.Brush.color:=clsilver;
  hauptf.op_prevbmp.Canvas.FillRect(
    rect(
      0,
      0,
      hauptf.op_prevbmp.width,
      hauptf.op_prevbmp.height
    )
  );

  //preview mode?
  if not hauptf.op_prevchb.checked then exit;

  //is there an original-pic?
  if ob_u.ob_isempty then exit;

  //get dimension of inner preview-pic in paintbox
  hauptf.getinnerbounds(
    hauptf.op_prevpb.Width,
    hauptf.op_prevpb.height,
    hauptf.ob_bmp.width,
    hauptf.ob_bmp.height,
    l,t,w,h
  );

  //save width and hight
  ww:=w;
  hh:=h;

  //creating the result-pic?
  if zbmp<>nil then begin
    //copy actually pic to result-bitmap
    hauptf.op_prevbmp.Canvas.StretchDraw(
      rect(l,t,l+w,t+h),
      zbmp
    );
    exit;
  end;

  //only a preview depends on options---------------
  randseed:=123;

  //coNvert original to (small) pixelbmp
  //=> every pixel stands for a quad
  ob_u.ob_mkpixelbmp(true);

  if hauptf.op_backpicchb.checked then begin
    //original as background
    hauptf.op_prevbmp.Canvas.StretchDraw(
      rect(l,t,l+w,t+h),
      hauptf.ob_bmp
    );
  end
  else begin
    //set background-color
    hauptf.op_prevbmp.Canvas.Brush.color:=
      hauptf.op_backsh.Brush.color;
    hauptf.op_prevbmp.Canvas.FillRect(
      rect(l,t,l+w,t+h)
    );
  end;


  //paint dummy-quads on preview--------------------

  //calculate width of a quad on preview
  dx:=w/hauptf.op_qhorzse.value;

  //calculate hight of a quad on preview
  yanz:=strtoint(hauptf.op_qverte.text);
  dy:=h/yanz;

  //transform dimension from float to int
  w:=trunc(dx);
  h:=trunc(dy);

  //border_color: black as default
  hauptf.op_prevbmp.Canvas.brush.style:=bssolid;
  hauptf.op_prevbmp.Canvas.pen.width:=1;
  hauptf.op_prevbmp.Canvas.pen.color:=clblack;

  for y:=0 to yanz-1 do begin
    //calc top of actually quad on preview
    qt:=trunc(y*dy);

    //get line of colors
    pba:=hauptf.ob_pixelbmp.scanline[y];

    for x:=0 to hauptf.op_qhorzse.value-1 do begin

      //set quad randomly
      if random(100)>hauptf.op_malwkse.value then continue;

      //calc left of actually quad on preview
      ql:=trunc(x*dx);

      //get pixel-color
      col:=hauptf.pba2col(pba,x);

      //is gray-value of the color in chosen limits?
      helligkeit:=hauptf.col2helligkeit(col);
      in_hellbereich:=
        (helligkeit>=hauptf.op_hellvonsb.position)and
        (helligkeit<=hauptf.op_hellbissb.position);
      if
        ((hauptf.op_hellmodecb.itemindex=0)and not in_hellbereich)or
        ((hauptf.op_hellmodecb.itemindex=1)and in_hellbereich)
      then continue;


      //quader dimension randomazation
      ql:=ql+hauptf.verwackeln(w,hauptf.op_wxse.value);
      qt:=qt+hauptf.verwackeln(h,hauptf.op_wyse.value);
      qw:=w+hauptf.verwackeln(w,hauptf.op_wwse.value);
      qh:=h+hauptf.verwackeln(h,hauptf.op_whse.value);

      if hauptf.op_verlaufchb.Checked then begin

        //no border? Then border color=brush color
        if not hauptf.op_qrandchb.checked then
          hauptf.op_prevbmp.Canvas.pen.Color:=col;

        r:=getrvalue(col);
        g:=getgvalue(col);
        b:=getbvalue(col);

        dvy:=qh/3;
        for vy:=0 to 2 do begin
          rc:=i2b(r+random(30)-random(30));
          gc:=i2b(g+random(30)-random(30));
          bc:=i2b(b+random(30)-random(30));
          col:=rgb(rc,gc,bc);
          hauptf.op_prevbmp.Canvas.brush.Color:=col;
          hauptf.op_prevbmp.Canvas.pen.Color:=col;
          hauptf.op_prevbmp.Canvas.rectangle(
            l+ql,t+qt+trunc(vy*dvy),
            l+ql+qw,t+qt+trunc(vy*dvy+dvy)
          );
        end;

        if hauptf.op_qrandchb.checked then begin
          hauptf.op_prevbmp.Canvas.pen.color:=clblack;
          hauptf.op_prevbmp.Canvas.brush.style:=bsclear;
          hauptf.op_prevbmp.Canvas.rectangle(
            l+ql,t+qt,l+ql+qw,t+qt+qh
          );
          hauptf.op_prevbmp.Canvas.brush.style:=bssolid;
        end;

      end
      else begin
        //no border? Then border color=brush color
        if not hauptf.op_qrandchb.checked then
          hauptf.op_prevbmp.Canvas.pen.Color:=col;
        hauptf.op_prevbmp.Canvas.brush.Color:=col;

        //paint the dummy-quad on preview
        hauptf.op_prevbmp.Canvas.rectangle(
          l+ql,t+qt,l+ql+qw,t+qt+qh
        );
      end;
    end;
  end;

  if not hauptf.op_wackelchb.Checked then exit;

  //to repaint quads out of inner frame
  hauptf.op_prevbmp.Canvas.Brush.color:=clsilver;

  hauptf.op_prevbmp.Canvas.FillRect(
    rect(0,0,hauptf.op_prevbmp.width,t-1)
  );
  hauptf.op_prevbmp.Canvas.FillRect(
    rect(0,0,l-1,hauptf.op_prevbmp.height)
  );
  hauptf.op_prevbmp.Canvas.FillRect(
    rect(l+ww+1,0,hauptf.op_prevbmp.width,hauptf.op_prevbmp.height)
  );
  hauptf.op_prevbmp.Canvas.FillRect(
    rect(0,t+hh+1,hauptf.op_prevbmp.width,hauptf.op_prevbmp.height)
  );

end;


Zunächst wird die Vorschau-Bitmap "op_prevbmp" auf die Dimension der Paintbox "op_prevpb" gesetzt, die das Vorschau-Bild letztlich anzeigt. Dann wird die Bitmap komplett silberfarbend eingefärbt. Ist der Vorschau-Modus nicht aktiv oder liegt kein Original-Bild vor, gibt es nichts weiter zu tun und wir verlassen die Prozedur.

Ansonsten berechnen wir, an welchen Koordinaten sich das "innere" Bild innerhalb der Paintbox befinden soll - ganz ähnlich, wie wir das auch schon beim "OnMouseMove"-Ereignis des Original-Bildes gemacht haben.

Nun prüfen wir, ob wir uns bereits bei der Generierung des "echten" Ergebnis-Bildes befinden. In diesem Fall enthält die übergebene Bitmap "zbmp" das bisherige Ergebnis-Bild, welches wir nun einfach an passender Stelle in die Vorschau-Bitmap reinkopieren. Anschliessend wird die Prozedur verlassen.

PicOfPictures - Optionen: Vorschau-Bild

"Echte" Vorschau: Das Ergebnis-Bild wird gerade berechnet, das bisher generierte Bild in der Vorschau angzeigt

Zufall muss kein Zufall sein

Im Vorschau-Modus müssen wir weitermachen. Wir setzen den Zufallsgenerator auf einen definierten Startwert, so dass immer die gleichen Zufallszahlen generiert werden. Das hat den Vorteil, dass die Wirkung der Änderungen an den Optionen sich hinsichtlich des Ergebnis-Bildes besser abschätzen lässt, weil sie nicht unnötig durch Zufallsereignisse "verschleiert" wird.

Hintergründiges

Das "innere" Bild wird je nach Einstellung entweder mit einer planen Hintergrundfarbe oder mit dem Orginal-Bild versehen.

PicOfPictures - Optionen: Hintergrund I

Hintergrund I: Einfarbiger Hintergrund

PicOfPictures - Optionen: Hintergrund II

Hintergrund II: Das Original-Bild scheint als Hintergrund durch

Ein Balance-Akt zwischen Detail und Schärfe

Nun wird die Bitmap "ob_pixelbmp" über die vorhin beschriebene Prozedur "ob_mkpixelbmp" generiert, und zwar stets in der "einfachen" Variante, d.h., der Verlaufsmodus bleibt unberücksichtigt. Die Dimension der Pixel-Bitmap - und damit auch das Aussehen der Vorschau - wird bestimmt durch die optionale Anzahl horizontaler Quader.

PicOfPictures - Optionen: Dimension I

Dimension I: Unscharfes Bild mit wenigen, aber detaillierten Quadern

PicOfPictures - Optionen: Dimension II

Dimension II: Mehr Schärfe durch mehr Quader

Casino Quadro

In der Folge betrachten wir jedes Pixel der "ob_pixelbmp". Je nach Einstellung der Mal-Wahrscheinlichkeit "op_malwkse" prüfen wir, ob der Zufall will, dass wir dieses Pixel ignorieren oder in der Vorschau in ein Rechteck umsetzen. Der Aufruf "random(100)" liefert eine Zufallszahl zwischen 0 und 99 zurück. Die Auswahl ist gleichverteilt, d.h., jede Zahl wird mit gleicher Warscheinlichkeit "gezogen". Bei z.B. 50% Mal-Wahscheinlichkeit wird nun einfach geprüft, ob die Zufallszahl im Bereich 0-50 liegt. Bei 20% muss sie in dem unwahrscheinlicheren, weil kleineren Bereich von 0-20 liegen. Bei 1% muss exakt die "1" getroffen werden, was im Schnitt einmal bei 100 Versuchen klappt. 100% Mal-Wahrscheinlichkeit ist immer erfüllt, da jede Zufallszahl von 0 bis 99 kleiner als 100 ist, "continue" also nie ausgeführt wird.

PicOfPictures - Optionen: Mal-Wahrscheinlichkeit I

Mal-Wahrscheinlichkeit I: Die Rechtecke sollen mit nur 50 prozentiger Wahrscheinlichkeit gemalt werden.

PicOfPictures - Optionen: Mal-Wahrscheinlichkeit II

Mal-Wahrscheinlichkeit II: Standardmässig werden 100% der Rechtecke gemalt

Helligkeit wird mit Ignoranz bestraft

Im nächsten Schritt bestimmen wir den Helligkeitswert "helligkeit" des aktuellen Pixels. Liegt der innerhalb (oder ausserhalb) bestimmter, in den Optionen angegebenen Grenzen, fahren wir entweder fort oder ignorieren einmal mehr das Pixel.

PicOfPictures - Optionen: Pixel-Helligkeit I

Pixel-Helligkeit I: Pixel mit Helligkeitswert unter "100" (grau bis schwarz) werden ignoriert

PicOfPictures - Optionen: Pixel-Helligkeit II

Pixel-Helligkeit II: Pixel mit Helligkeitswert über "150" (hellgrau bis weiss) werden ignoriert

Zerüttete Quaderierung

Fahren wir fort, berechnen wir basierend auf der Position des aktuellen Pixels die exakte Position und Grösse des Vorschau-Rechtecks in der Vorschau-Bitmap "op_prevbmp". Um die optionale "Verwacklung" zu erreichen, verwenden wir die bereits bekannte Funktion "verwackeln" aus der Haupt-Unit.

PicOfPictures - Optionen: Verwacklung

Verwacklung: Die Rechtecke werden zufällig verteilt

Wo laufen sie denn?

Weiter ist zu prüfen, ob der Verlauf-Modus aktiv ist. Ist dies nämlich der Fall, wird nicht nur ein "planes" Rechteck mit der Pixelfarbe in die Vorschau gemalt, sondern gleich drei zusammenhängende Rechtecke mit leicht variierenden Farben. Das gibt zwar die Wirkung des Verlauf-Modus nicht korrekt wieder, jedoch kann man zumindestens erahnen, welche Auswirkungen das auf das Ergebnis-Bild hat.

PicOfPictures - Optionen: Verlauf-Modus inaktiv

Verlauf-Modus inaktiv: Einfarbige Rechtecke in der Vorschau

PicOfPictures - Optionen: Verlauf-Modus aktiv

Verlauf-Modus aktiv: Dreifarbige Rechtecke in der Vorschau

Ausser Rand und Band

Zuletzt muss noch berücksichtigt werden, ob die Quader-Bilder einen Rand erhalten sollen. Ist dem so, werden die Rechtecke der Vorschau mit einem schwarzen Rand versehen. Ansonsten erhält der Rand die gleiche Farbe wie das Rechteck. Die in den Optionen einstellbaren individuellen Ränderfarben werden in der Vorschau nicht berücksichtigt.

PicOfPictures - Optionen: Rand aus

Rand aus: Rechtecke ohne Rand

PicOfPictures - Optionen: Rand an

Rand an: Rechtecke mit schwarzem Rand

Ausreisser ausmerzen

Haben wir letztendlich alle Pixel durchlaufen, verlassen wir die Prozedur. Es sei denn, der Verwacklungsmodus ist aktiv. In diesem Fall kann es nämlich passieren, dass die Rechtecke über das Ziel hinaus gemalt wurden - dem "inneren" Bild innerhalb der Vorschau-Paintbox. Da das unschön aussieht, werden die Bereiche ausserhalb des "inneren" Bildes mit silbergauen Blöcken neu gezeichnet und so die "Ausreisser-Rechtecke" überdeckt.

PicOfPictures - Optionen: Ausreisser-Rechtecke I

"Ausreisser-Rechtecke" I: Die "Verwacklung" lässt die Vorschau-Rechtecke ausserhalb des "inneren" Bildes wandern.

PicOfPictures - Optionen: Ausreisser-Rechtecke II

"Ausreisser-Rechtecke" II: Nach der Korrektur sieht's ordentlicher aus

"Kernel" von PicOfPics

Liefert uns die Vorschau ein befriedigendes Ergebnis, kann mittels des "Start"-Buttons die eigentliche Generierung des Ergebnis-Bildes vorgenommen werden. Dazu wird die Prozedur "op_picofpics" aufgerufen. Wie bereits erwähnt, gibt es hier Parallelen zur Abarbeitung der Vorschau-Prozedur "op_mkprevbmp".

//------------------------------------------------------------------------
//'kernel' of PicOfPics
//
//- transform orginal pic to pixelbmp with quad-dimension
//- find a quad with best color to every pixel in pixelbmp
//- paint founded quads on result-bmp
//
//------------------------------------------------------------------------
procedure op_picofpics;
var
  zbmp,quadbmp,thquadbmp:tbitmap;
  qvert,qhorz,qw,qh,
  rr,px,py,x,y:integer;
  qcol:tcolor;
  fn:string;
  rec:trect;
  jpg:tjpegimage;
  breakok:bool;
  helligkeit,
  verlauf:integer;
  in_hellbereich:bool;
  pba:pbytearray;

  //paint founded quad to target bmp
  procedure setquader(l,t:integer);
  var
    w,h:integer;
  begin
    w:=hauptf.op_qbreitese.value;h:=w;

    //randomize quad dimension
    l:=l+hauptf.verwackeln(w,hauptf.op_wxse.value);
    w:=w+hauptf.verwackeln(w,hauptf.op_wwse.value);
    t:=t+hauptf.verwackeln(h,hauptf.op_wyse.value);
    h:=h+hauptf.verwackeln(h,hauptf.op_whse.value);

    //copy quad to target
    if hauptf.op_qqualicb.itemindex=0 then begin
      //super-quality
      quadbmp.assign(jpg);

      //make a fine thumb
      thquadbmp.width:=w;
      thquadbmp.Height:=h;
      op_optthumb(quadbmp,thquadbmp);

      //copy thumb to target
      zbmp.Canvas.Draw(l,t,thquadbmp);

    end
    else begin
      //do only window-stretch-draw
      rec:=rect(l,t,l+w,t+h);
      zbmp.Canvas.StretchDraw(rec,jpg);
    end;

    if hauptf.op_qrandchb.checked then begin
      //quader will have a border
      zbmp.Canvas.Pen.Width:=1;

      //border on top and left
      zbmp.Canvas.pen.color:=
        hauptf.op_qrandolsh.brush.color;
      zbmp.canvas.MoveTo(l,t  );
      zbmp.canvas.lineto(l,t+h);
      zbmp.canvas.MoveTo(l,t  );
      zbmp.canvas.lineto(l+w,t);

      //border on bottom and right
      zbmp.Canvas.pen.color:=
        hauptf.op_qrandursh.brush.color;
      zbmp.canvas.MoveTo(l+w-1,t+h-1);
      zbmp.canvas.lineto(l,    t+h-1);
      zbmp.canvas.MoveTo(l+w-1,t+h-1);
      zbmp.canvas.lineto(l+w-1,t    );
    end;
  end;

begin
  screen.Cursor:=crhourglass;

  //real random-mode
  randomize;

  //original to pixelbmp with quad-dimension
  ob_u.ob_mkpixelbmp(false);

  //define some 'help'-images
  jpg:=tjpegimage.Create;
  zbmp:=tbitmap.create;
  quadbmp:=tbitmap.create;
  thquadbmp:=tbitmap.create;
  thquadbmp.PixelFormat:=pf24bit;

  //reset sum of color-errors
  hauptf.op_erre.text:='0';

  try

    //set jpg-scale-quality
    if hauptf.op_qqualicb.itemindex=0 then begin
      //super-quality
      jpg.scale:=jsFullSize;
    end
    else begin
      jpg.scale:=tjpegscale(
        hauptf.op_qqualicb.ItemIndex-1
      );
    end;

    //quad-dimension
    qhorz:=hauptf.op_qhorzse.value;
    qvert:=strtoint(hauptf.op_qverte.text);
    qw:=hauptf.op_qbreitese.value;
    qh:=qw;

    //init target bmp
    zbmp.PixelFormat:=pf24bit;
    zbmp.Width:=qhorz*qw;
    zbmp.height:=qvert*qh;

    if hauptf.op_backpicchb.checked then begin
      //target-background is original
      rec:=rect(0,0,zbmp.width,zbmp.height);
      zbmp.Canvas.StretchDraw(rec,hauptf.ob_bmp);
    end
    else begin
      //target-background is plane color
      zbmp.canvas.brush.color:=hauptf.op_backsh.Brush.Color;
      zbmp.canvas.pen.color:=hauptf.op_backsh.Brush.Color;
      zbmp.Canvas.Brush.Style:=bssolid;
      zbmp.Canvas.Rectangle(0,0,zbmp.width,zbmp.height);
    end;

    //bool for manually break
    breakok:=false;

    //Find best top-x quader for
    //every pixel of pixelbmp

    //adapt progressbar to 100 steps
    hauptf.op_prgb.Max:=qvert;
    rr:=qvert div 100;
    if rr=0 then rr:=1;

    //work on pixelmap in height
    py:=0;
    for y:=0 to qvert-1 do begin

      //set progressbar
      if y mod rr=0 then
        hauptf.op_prgb.Position:=y;
      application.processmessages;

      //manually break?
      if hauptf.op_mkpicb.caption<>'STOPP' then begin
        breakok:=true;
        break;
      end;

      //get line of colors in pixelbmp
      pba:=hauptf.ob_pixelbmp.scanline[y];

      //work on pixelmap in width
      px:=0;
      for x:=0 to qhorz-1 do begin

        //random setting of quads
        if random(100)<hauptf.op_malwkse.value then begin

          //get color you fant to replace thru quad-pic
          if not hauptf.op_verlaufchb.checked then begin
            //normal-mode: replace only one pixel
            qcol:=hauptf.pba2col(pba,x);
          end
          else begin
            //smooth-mode: replace group of 3 x 3 pixels
            qcol:=qp_u.qp_middlecolor(
              hauptf.ob_pixelbmp,
              x*3,y*3,3,3
            );
          end;

          //is gray-value of the color in chosen limits?
          helligkeit:=hauptf.col2helligkeit(qcol);
          in_hellbereich:=
            (helligkeit>=hauptf.op_hellvonsb.position)and
            (helligkeit<=hauptf.op_hellbissb.position);
          if
            ((hauptf.op_hellmodecb.itemindex=0)and in_hellbereich)or
            ((hauptf.op_hellmodecb.itemindex=1)and not in_hellbereich)
          then begin

            //ok: find the best quad-pic in quad-grid
            fn:=op_col2sgfn(qcol,x*3,y*3);

            //load the founded quad
            jpg.LoadFromFile(fn);

            //copy quad to target bmp
            setquader(px,py);
          end;
        end;

        //increase target-position with quader-width
        px:=px+qw;
      end;

      //increase target-position with quader-height
      py:=py+qh;

      //preview?
      if hauptf.op_prevchb.Checked then begin
        op_mkprevbmp(zbmp);
        hauptf.op_prevpbpaint(nil);
      end;
    end;

    //copy created target bmp to result
    hauptf.eb_bmp.assign(zbmp);

    //set hint-informations
    hauptf.eb_pb.Hint:=
      inttostr(zbmp.width)+
      ' x '+
      inttostr(zbmp.Height)+
      ' Pixel';
    hauptf.eb_pb.showhint:=true;

    //reset scrollbars an size of result-image
    hauptf.eb_hsb.Position:=0;
    hauptf.eb_vsb.Position:=0;
    eb_u.eb_orgsz;

    //copy result to result-paintbox
    eb_u.eb_paintboxpaint;


    //set merge-base to created target-pic
    hauptf.eb_blendbmp.assign(zbmp);

    //save target-pic (quad-pic)
    hauptf.eb_quadbmp.assign(zbmp);

    //save original for merging
    hauptf.eb_orgbmp.Width:=zbmp.width;
    hauptf.eb_orgbmp.height:=zbmp.height;
    rec:=rect(0,0,zbmp.width,zbmp.height);
    hauptf.eb_orgbmp.Canvas.StretchDraw(rec,hauptf.ob_bmp);

    //opts of result to default
    hauptf.eb_hellmodecb.itemindex:=0;
    hauptf.eb_hellvonsb.Position:=0;
    hauptf.eb_hellbissb.Position:=255;
    hauptf.eb_blendorgrb.checked:=true;
    hauptf.eb_blendmodecb.ItemIndex:=0;
    hauptf.eb_blendsb.Position:=0;

    //manually break?
    if not breakok then begin
      //no: adapt preview
      op_updateprev;
      //change to result-page of page control
      hauptf.pctrl.ActivePage:=hauptf.eb_ts;
    end;

    //adapt sum of color-errors
    verlauf:=1;
    if hauptf.op_verlaufchb.checked then
      verlauf:=9;
    hauptf.op_erre.Text:=format(
      '%f',
      [
        strtoint64(hauptf.op_erre.Text)/
        (qhorz*qvert*verlauf)
      ]
    );

  finally
    //clean up the shit
    quadbmp.Free;
    zbmp.Free;
    jpg.Free;
    hauptf.op_prgb.Position:=0;
    screen.Cursor:=crdefault;
  end;
end;


Im Gegensatz zur Vorschau (siehe dort) wird bei der Generierung des Ergebnis-Bildes mit echten Zufallswerten gearbeitet. Dazu wird die Delphi-Funktion "randomize" aufgerufen.

Anschliessend wird aus dem Original-Bild wieder unsere Pixel-Bitmap "ob_pixelbmp" konstruiert. Ist der Verlauf-Modus aktiv, so stehen jeweils 3 x 3 Pixel der Pixel-Bitmap für ein zu findendes Quader-Bild. Ist er inaktiv, dann wird jedes Pixel einzeln betrachtet.

Es werden dann einige Hilfs-Malflächen initialisiert. Das TJPegImage "jpg", welches die Quader-Bilder einladen wird, bekommt die gewünschte Skalierungs-Qualität verpasst. Und die Zielbitmap "zbmp" - unser Ergebnis-Bild - wird passend zur Anzahl und Breite/Höhe der Quader-Bilder dimensioniert.

Je nach Einstellung in der Optionen-Page wird anschliessend die "zbmp" mit einer einheitlichen Hintergrundfarbe versehen bzw. bekommt als Hintergrund das Original-Bild hineinkopiert.

Nun folgt eine Schleife über die gewünschte Anzahl vertikaler Quader. Es ist hier zu beachten, dass diese Anzahl von der Höhe der Pixel-Bitmap "ob_pixelbmp" abweichen kann, nämlich dann, wenn der Verlauf-Modus aktiv ist (in diesem Fall ist die Pixel-Bitmap ja dreimal höher, siehe bei "ob_mkpixelbmp").

Insofern ist es im Verlauf-Modus eigentlich auch sinnlos, sich per "scanline"-Methode die Pixelfarben einer Zeile aus der Pixel-Bitmap zu holen, wir wir es im nächsten Schritt machen. Das ist nur nötig für den "Einfach-Modus". Da der Delphi-Compiler aber eine hässliche Warning auswirft, wenn diese Zeile per "op_verlaufchb.checked"-Prüfung übergangen wird, lesen wir sie trotzdem ein. Das geht so schnell, dass wir es ignorieren können.

Die nächste Schleife durchläuft die gewünschte Anzahl horizontaler Quader. Auch hier gilt, dass im Verlauf-Modus die Breite der Pixel-Bitmap dreimal so gross ist.

Ähnlich wie bei der Vorschau-Prozedur wird anschliessend geprüft, ob uns die Mal-Wahrscheinlichkeit grünes Licht für ein zu setzendes Quader-Bild gibt oder nicht. Falls nicht, wird der aktuelle Quader ignoriert und mit dem nächsten fortgefahren.

Soll der Quader gemalt werden, bestimmen wir zunächst die Mittel-Farbe des Bereichs im Original-Bild, der durch einen Quader zu ersetzen ist.

Im Falle des "Normal-Modus" ist dies einfach der Farbwert des aktuellen Pixels der Pixel-Bitmap. Die bereits bekannte Funktion "pba2col" liefert uns hierzu das passsende Ergebnis.

Im "Verlauf-Modus" muss jedoch die Durchnschittsfarbe eines 3 x 3 Pixel-Blocks aus der Pixel-Bitmap ermittelt werden. Auch dafür kennen wir bereits eine Funktion, nämlich "qp_middlecolor" aus der Unit des Quader-Pools.

In beiden Fällen steht hinterher in "qcol" ein Farbwert, für den wir eventuell ein passendes Quader-Bild finden müssen. Denn erst müssen wir noch prüfen, ob dieser Farbwert überhaupt im gewünschten Helligkeitsbereich liegt. Ist dies nicht der Fall, wird dieser Bereich des Original-Bildes ignoriert.

Passt der Farbwert zu den Optionen, rufen wir als nächstes die Funktion "op_col2sgfn" auf, die uns aus unserem zuvor definierten Quader-Pool ein geeignetes, sprich: farbähnliches Quader-Bild heraus sucht. Diese Prozedur sehen wir uns gleich noch etwas näher an.

Der gefundene Quader wird anschliessend mit der "loadfromfile"-Methode des TJPegImages "jpg" eingeladen. Über die interne Prozedur "setquader" plazieren wir dann den Quader an passender Stelle in die Ziel-Bitmap "zbmp" hinein. Auch dazu gleich mehr.

So arbeiten wir nach und nach alle horizontalen Quader ab. Sind wir damit fertig, prüfen wir, ob die Vorschau aktiv ist. Ist dies der Fall, so zeigen wir die bisherige Ziel-Bitmap "zbmp" mittels der weiter oben beschriebenen Vorschau-Prozedur "op_mkprevbmp" auf dem Bildschirm an.

Anschliessend nehmen wir uns die nächste Zeile des Original-Bildes vor und durchlaufen sie pixelweise, bis auch die alle abgearbeitet sind.

Am Schluss kopieren wir die fertige Ziel-Bitmap "zbmp" in die Ergebnis-Bitmap "eb_bmp". Ausserdem setzen wir die Parameter der Ergebnis-Bild-Page auf ihre Standards zurück. Und zuletzt berechnen wir noch die "Farbfehler-Summe", die sich durch die Abweichungen der Mittel-Farbe der Quader-Bilder zur Mittel-Farbe der Pixel-Bitmap ergeben hat.

Quader-Bild in Ziel-Bitmap

Sehen wir uns jetzt noch an, was in der internen Prozedur "setquader" geschieht. Ähnlich wie die Rechtecke in die Vorschau, so müssen auch die Quader-Bilder an passender Stelle in die Ziel-Bitmap eingefügt werden.

Die korrekten Koordinaten werden an die Prozedur übergeben, müssen aber je nach "Verwacklungsgrad" noch adaptiert werden. Dies geschieht in vertrauter Weise mittels der "verwackeln"-Funktion.

Jetzt gilt es, das in "jpg" vorliegende Quader-Bild an die Quader-Dimension in der Ziel-Bitmap anzupassen. Wurde in den Optionen für die Quader-Bilder "Super"-Qualität gewählt, berechnet die Prozedur "op_optthumb" ein Thumbnail passender Grösse. Diese Prozedur ist nicht von mir; ich fand sie vor ein paar Jahren im Internet. Sie ist umglaublich kompliziert. Ich verstehe nicht einmal näherungsweise, wie sie arbeitet. Ist mir aber auch egal. Sie liefert jedenfalls sehr schöne verkleinerte Bilder zurück.

//------------------------------------------------------------------
//Creates optimize Thumbs
//
//Stolen from Internet a view years ago.
//So I don't know the author of the Source.
//
//Difficult stuff! Good work, (wo)man!
//
//-------------------------------------------------------------------
procedure op_optthumb(Src,Dst:TBitmap);
type
  // Contributor for a pixel
  TContributor = record
    pixel: integer; // Source pixel
    weight: single; // Pixel weight
  end;

  TContributorList = array[0..0] of TContributor;
  PContributorList = ^TContributorList;

  // List of source pixels contributing to a destination pixel
  TCList = record
    n : integer;
    p : PContributorList;
  end;

  TCListList = array[0..0] of TCList;
  PCListList = ^TCListList;

  TRGB = packed record
    r, g, b : single;
  end;

  // Physical bitmap pixel
  TColorRGB = packed record
    r, g, b : BYTE;
  end;
  PColorRGB = ^TColorRGB;

  // Physical bitmap scanline (row)
  TRGBList = packed array[0..0] of TColorRGB;
  PRGBList = ^TRGBList;

var
  xscale, yscale : single; // Zoom scale factors
  i, j, k : integer; // Loop variables
  center : single; // Filter calculation variables
  width, fscale, weight : single; // Filter calculation variables
  left, right : integer; // Filter calculation variables
  n,cc,ccmod : integer; // Pixel number
  Work : TBitmap;
  contrib : PCListList;
  rgb : TRGB;
  color : TColorRGB;
  SourceLine ,
  DestLine : PRGBList;
  SourcePixel ,
  DestPixel : PColorRGB;
  Delta ,
  DestDelta : integer;
  SrcWidth ,
  SrcHeight ,
  DstWidth ,
  DstHeight : integer;
  fwidth:single;
  ok:bool;

  function Color2RGB(Color: TColor): TColorRGB;
  begin
    Result.r:=Color AND $000000FF;
    Result.g:=(Color AND $0000FF00) SHR 8;
    Result.b:=(Color AND $00FF0000) SHR 16;
  end;

  function RGB2Color(Color: TColorRGB): TColor;
  begin
    Result := Color.r OR (Color.g SHL 8) OR (Color.b SHL 16);
  end;

  function Lanczos3Filter(Value:Single):Single;

    function SinC(Value:Single):Single;
    begin
      if Value<>0.0 then begin
        Value:=Value*Pi;
        Result:=sin(Value)/Value;
      end
      else begin
        Result:=1.0;
      end;
    end;

  begin
    if Value<0.0 then Value:=-Value;
    if Value<3.0 then Result:=SinC(Value)*SinC(Value/3.0)
                 else Result:=0.0;
  end;

begin
  ok:=false;
  fwidth:=3.0;
  DstWidth:=Dst.Width;
  DstHeight:=Dst.Height;
  SrcWidth:=Src.Width;
  SrcHeight:=Src.Height;
  if (SrcWidth<1)or(SrcHeight<1) then
    raise Exception.Create('Source bitmap too small');

  // Create intermediate image to hold horizontal zoom
  Work:=TBitmap.Create;
  try
    Work.Height:=SrcHeight;
    Work.Width:=DstWidth;
    if SrcWidth=1 then xscale:=DstWidth/SrcWidth
                  else xscale:=(DstWidth-1)/(SrcWidth-1);
    if SrcHeight=1 then yscale:=DstHeight/SrcHeight
                   else yscale:=(DstHeight-1)/(SrcHeight-1);
    Src.PixelFormat:=pf24bit;
    Dst.PixelFormat:=Src.PixelFormat;
    Work.PixelFormat:=Src.PixelFormat;

    // --------------------------------------------
    // Pre-calculate filter contributions for a row
    // -----------------------------------------------
    GetMem(contrib,DstWidth*sizeof(TCList));

    // Horizontal sub-sampling
    // Scales from bigger to smaller width
    if xscale<1.0 then begin
      width:=fwidth/xscale;
      fscale:=1.0/xscale;

      for i := 0 to DstWidth-1 do begin

        contrib^[i].n := 0;
        GetMem(contrib^[i].p,trunc(width*2.0+1)*sizeof(TContributor));
        center:=i/xscale;
        // Original code:
        // left := ceil(center - width);
        // right := floor(center + width);
        left := floor(center - width);
        right := ceil(center + width);
        for j := left to right do begin
          weight := Lanczos3Filter((center - j) / fscale) / fscale;
          if (weight = 0.0) then continue;
          if (j < 0) then n := -j
          else if (j >= SrcWidth) then n := SrcWidth - j + SrcWidth - 1
          else n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end
    else begin
      // Horizontal super-sampling
      // Scales from smaller to bigger width
      for i := 0 to DstWidth-1 do begin

        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        // Original code:
        // left := ceil(center - fwidth);
        // right := floor(center + fwidth);
        left := floor(center - fwidth);
        right := ceil(center + fwidth);
        for j := left to right do begin
          weight := Lanczos3Filter(center - j);
          if (weight = 0.0) then continue;
          if (j < 0) then n := -j
          else if (j >= SrcWidth) then n := SrcWidth - j + SrcWidth - 1
          else n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;

    // ----------------------------------------------------
    // Apply filter to sample horizontally from Src to Work
    // ----------------------------------------------------

    for k:=0 to SrcHeight-1 do begin

      SourceLine:=Src.ScanLine[k];
      DestPixel:=Work.ScanLine[k];
      for i := 0 to DstWidth-1 do begin
        rgb.r := 0.0;
        rgb.g := 0.0;
        rgb.b := 0.0;
        for j := 0 to contrib^[i].n-1 do begin
          color := SourceLine^[contrib^[i].p^[j].pixel];
          weight := contrib^[i].p^[j].weight;
          if weight=0.0 then continue;
          rgb.r := rgb.r + color.r * weight;
          rgb.g := rgb.g + color.g * weight;
          rgb.b := rgb.b + color.b * weight;
        end;
        if (rgb.r > 255.0) then color.r := 255
        else if (rgb.r < 0.0) then color.r := 0
        else color.r := round(rgb.r);
        if (rgb.g > 255.0) then color.g := 255
        else if (rgb.g < 0.0) then color.g := 0
        else color.g := round(rgb.g);
        if (rgb.b > 255.0) then color.b := 255
        else if (rgb.b < 0.0) then color.b := 0
        else color.b := round(rgb.b);
        // Set new pixel value
        DestPixel^ := color;
        // Move on to next column
        inc(DestPixel);
      end;
    end;

    // Free the memory allocated for horizontal filter weights
    for i:=0 to DstWidth-1 do FreeMem(contrib^[i].p);
    FreeMem(contrib);

    // -----------------------------------------------
    // Pre-calculate filter contributions for a column
    // -----------------------------------------------
    GetMem(contrib, DstHeight* sizeof(TCList));
    // Vertical sub-sampling
    // Scales from bigger to smaller height
    if yscale<1.0 then begin
      width := fwidth / yscale;
      fscale := 1.0 / yscale;

      for i := 0 to DstHeight-1 do begin

        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        // Original code:
        // left := ceil(center - width);
        // right := floor(center + width);
        left := floor(center - width);
        right := ceil(center + width);
        for j := left to right do begin
          weight := Lanczos3Filter((center - j) / fscale) / fscale;
          if (weight = 0.0) then continue;
          if (j < 0) then n := -j
          else if (j >= SrcHeight) then n := SrcHeight - j + SrcHeight - 1
          else n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end
    end
    else begin
      // Vertical super-sampling
      // Scales from smaller to bigger height
      for i := 0 to DstHeight-1 do begin

        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        // Original code:
        // left := ceil(center - fwidth);
        // right := floor(center + fwidth);
        left := floor(center - fwidth);
        right := ceil(center + fwidth);
        for j := left to right do begin
          weight := Lanczos3Filter(center - j);
          if (weight = 0.0) then continue;
          if (j < 0) then n := -j
          else if (j >= SrcHeight) then n := SrcHeight - j + SrcHeight - 1
          else n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;

    // --------------------------------------------------
    // Apply filter to sample vertically from Work to Dst
    // --------------------------------------------------
    SourceLine := Work.ScanLine[0];
    Delta := integer(Work.ScanLine[1]) - integer(SourceLine);
    DestLine := Dst.ScanLine[0];
    DestDelta := integer(Dst.ScanLine[1]) - integer(DestLine);
    for k := 0 to DstWidth-1 do begin

      DestPixel := pointer(DestLine);
      for i := 0 to DstHeight-1 do begin
        rgb.r := 0;
        rgb.g := 0;
        rgb.b := 0;
        // weight := 0.0;
        for j := 0 to contrib^[i].n-1 do begin
          color := PColorRGB(integer(SourceLine)+contrib^[i].p^[j].pixel*Delta)^;
          weight := contrib^[i].p^[j].weight;
          if (weight = 0.0) then continue;
          rgb.r := rgb.r + color.r * weight;
          rgb.g := rgb.g + color.g * weight;
          rgb.b := rgb.b + color.b * weight;
        end;
        if (rgb.r > 255.0) then color.r := 255
        else if (rgb.r < 0.0) then color.r := 0
        else color.r := round(rgb.r);
        if (rgb.g > 255.0) then color.g := 255
        else if (rgb.g < 0.0) then color.g := 0
        else color.g := round(rgb.g);
        if (rgb.b > 255.0) then color.b := 255
        else if (rgb.b < 0.0) then color.b := 0
        else color.b := round(rgb.b);
        DestPixel^ := color;
        inc(integer(DestPixel), DestDelta);
      end;
      Inc(SourceLine,1);
      Inc(DestLine,1);
    end;

    // Free the memory allocated for vertical filter weights
    for i := 0 to DstHeight-1 do FreeMem(contrib^[i].p);
    FreeMem(contrib);
    ok:=true;

  finally
    Work.Free;

    if not ok then begin
      application.messagebox(
        'OptThumb misslungen',
        '*** FEHLER **',
        mb_ok
      );
    end;
  end;
end;


Bei minder guter Qualität verwenden wir zum Anpassen des Quader-Bildes die Canvas-Funktion "StretchDraw". Sie liefert ebenfalls brauchbare Ergebnisse, arbeitet aber ungleich schneller als "op_optthumb".

Habe wir das Quader-Bild in die Ziel-Bitmap plaziert, müssen wir eigentlich nur noch prüfen, ob wir einen Rand einzeichnen müssen oder nicht. Falls ja, wird die Pen-Color der Ziel-Bitmap entsprechend gesetzt und zuerst die obere und linke, dann die untere und rechte Rand-Linie hineingemalt. That 's it!

You are simply the best

Wir ermitteln in "op_picofpics" die Mittel-Farbe der Teile des Original-Bildes, die wir durch Quader-Bilder ersetzen wollen. Dort wird die Funktion "op_col2sgfn" aufgerufen, die uns zu diesen Farben die am besten passenden Quader-Bilder aus der Quader-Stringgrid sucht. Die wollen wir uns jetzt einmal ansehen:

//find best quad-file in quad-grid to a given color
function op_col2sgfn(col:tcolor;l,t:integer):string;
var
  row,cmax,cdiff,r,rr,rmax:integer;
  cdiffa:array of integer;
  rowa:array of integer;
begin
  setlength(cdiffa,hauptf.op_quaderbestse.value);
  setlength(rowa,hauptf.op_quaderbestse.value);

  row:=0;
  for r:=1 to hauptf.qp_sg.RowCount-1 do begin

    //get color difference of actually quad-entry
    cdiff:=op_sgcoldiff(col,r,l,t);

    //save best top-x of color diffs
    if row<hauptf.op_quaderbestse.value then begin
      //top-x not full: save every cdiff
      cdiffa[row]:=cdiff;
      rowa[row]:=r;
      inc(row);
    end
    else begin
      //top-x full: save only better cdiffs

      //find wirst hit in top-x
      cmax:=-1;rmax:=0;
      for rr:=0 to hauptf.op_quaderbestse.value-1 do begin
        if cdiffa[rr]>cmax then begin
          cmax:=cdiffa[rr];
          rmax:=rr;
        end;
      end;

      //new cdiff better then worst of top-x?
      if cdiff<cmax then begin
        //ok: replace enties
        cdiffa[rmax]:=cdiff;
        rowa[rmax]:=r;
      end;

    end;

    //Top-1-Mode?
    //Break, if there is cdiff-error=0
    if
      (hauptf.op_quaderbestse.value=1)and
      (cdiff=0)
    then break;
  end;

  //random access of top-x
  r:=random(hauptf.op_quaderbestse.value);

  //save sum of error of colors
  hauptf.op_erre.Text:=inttostr(
    strtoint64(hauptf.op_erre.Text)+
    cdiffa[r]
  );

  //return founded quad-file
  r:=rowa[r];
  result:=
    hauptf.qp_dlb.directory+'\'+
    hauptf.qp_sg.cells[ord(_qp_fn),r];
end;


Um zu verhindern, das gleichfarbige Flächen stets mit dem gleichen, weil allerbesten Quader-Bildern abgedeckt werden, kann man in den Optionen angeben, dass aus den besten "x" Quader-Bildern zufällig eines gewählt wird. "x" ist dabei über das TSpinEdit "op_quaderbestse" optional einstellbar. Im ersten Schritt dimensionieren wir daher zwei Arrays auf die passende Grösse, "cdiffa" und "rowa".

Danach durchlaufen wir alle Elemente der Quader-Stringgrid. Die Funktion "op_sgcoldiff" liefert uns die Differenz "cdiff" der gesuchten, als Parameter übergebenen Farbe "col" zur Mittel-Farbe bzw. zu den Verlauf-Farben des aktuellen Quader-Bildes. Diese Funktion schauen wir uns nachher noch näher an.

Wir prüfen dann, ob bereits "x" Bilder gefunden wurden. Falls nicht, können wir den Fehler "cdiff" an das Array "cdiffa" und die Quader-Stringgrid- Zeilennummer an das Array "rowa" einfach angehängt.

Haben wir bereits "x" Bilder gefunden, müssen wir zuerst prüfen, ob der aktuelle Fehler "cdiff" kleiner ist als einer der im Array "cdiffa" notierten Werte. Dazu ermitteln wir das grösste "cdiffa"-Element und merken es uns in "cmax". Ist "cmax" grösser als "cdiff", dann ist das aktuelle Quader-Bild ein besserer Treffer und wir tauschen die Array-Elemente von "cdiffa" und "rowa" entsprechend aus.

Nach Beenden der Schleife haben wir die besten "x" Treffer gefunden und wählen nun per Zufalls einen davon aus. Wir kalkulieren die Farbfehler-Summe, die sich daraus ergibt und geben sie auf dem Bildschirm aus. Zuletzt liefern wir den Namen der gewählten Quader-Bild-Datei an die aufrufende Prozedur "op_picofpics" zurück.

Rechnen mit Farben

Wie eben beschrieben, nutzen wir die Funktion "op_sgcoldiff" um den Farb-Fehler zwischen einer Farbe "col" und den Farben (Mittefarbe oder Verlauf-Farben) der Zeile "r" in der Quader-Stringgrid "qp_sg" zu ermitteln.

//get diffenrence between col to col in quad-grid
function op_sgcoldiff(col:tcolor;r,l,t:integer):int64;
var
  cdiff:int64;
  qcol:tcolor;
  c,x,y:integer;
  pba:pbytearray;
begin
  if not hauptf.op_verlaufchb.checked then begin
    //check only middle color
    qcol:=strtoint(
      hauptf.qp_sg.cells[ord(_qp_farbe),r]
    );
    cdiff:=hauptf.getcoldiff(col,qcol);
  end
  else begin
    //check all 3 x 3 'smooth-points'
    cdiff:=0;
    c:=ord(_qp_verlauf11);
    for y:=t to t+2 do begin
      pba:=hauptf.ob_pixelbmp.ScanLine[y];
      for x:=l to l+2 do begin
        col:=hauptf.pba2col(pba,x);
        qcol:=strtoint(hauptf.qp_sg.cells[c,r]);
        cdiff:=cdiff+hauptf.getcoldiff(col,qcol);
        inc(c);
      end;
    end;
  end;
  result:=cdiff;
end;


Suchen wir nur nach der Differenz zur Mittel-Farbe, ist der Fall einfach, denn die liegt in der Quader-Stringgrid ja direkt als Einzelwert vor. Wir holen uns den Wert, wandeln ihn in ein Integer und lassen den Rest von der uns bereits bekannten Funktion "getcoldiff" berechnen.

Suchen wir dagegen nach der Differenz zu den Verlauf-Farben, müssen wir etwas komplizierter vorgehen. Hier gilt es, 3 x 3 Pixel der Bitmap "op_pixelbmp" mit den 9 Verlauf-Farben des Quader-Stringgrid-Eintrags zu vergleichen und die Farbdifferenzen in "cdiff" aufzusummieren.

Wie man vielleicht bemerken wird, dürfte "cdiff" im Falle der 9 Verlauf-Farben deutlich grösser ausfallen als im Falle der einfachen Mittel-Farbe. Aus diesem Grund sind die Farb-Fehlersummen, die wir auf dem Bildschirm ausgeben, auch nicht mit einander zu vergleichen, wenn ein Ergebnis-Bild einmal im Verlauf-Modus und einmal im Normal-Modus generiert wird. Das ist etwas unschön, weshalb ganz am Schluss - in "op_picofpics" - diese Fehlersumme noch etwas nachkorrigiert wird. Dennoch, ein direkter Vergleich bleibt zweiflhaft.

PicOfPictures - Optionen: Bild-Fehler-Summe I

Bild-Fehler-Summe I: Deutlich kleinere Fehlersumme im "Normal-Modus" als in II

PicOfPictures - Optionen: Bild-Fehler-Summe II

Bild-Fehler-Summe II: Fehlersumme im "Verlauf-Modus" viel grösser, obwohl Ergebnisse vergleichbar mit I

Ergebnis-Bild

Wir haben einen Quader-Pool definiert, ein Original-Bild ausgesucht, die Optionen eingestellt und ein Ergebnis-Bild generieren lassen. Die letzte Page der PageControl in PicOfPics, die wir uns jetzt ansehen werden, dient der Verwaltung und Modifizierung des Ergebnis-Bildes.

PicOfPictures - Ergebnis: Register-Page

Page des Ergebnis-Bildes

Ganz oben sehen wir die Buttons "Speichern" und "Entfernen". Der Delphi-Source für ihre Funktionalität sieht folgendermassen aus:

//check if result exists---------------------
function eb_isempty:bool;
begin
  result:=(hauptf.eb_bmp.width=1);
end;

//remove actally result----------------------
procedure eb_entfernen;
begin
  hauptf.eb_fne.text:='';
  hauptf.eb_bmp.width:=1;
  hauptf.eb_bmp.height:=1;
  hauptf.eb_bmp.modified:=false;
  eb_paintboxpaint;
  hauptf.setbuttons;
end;

//save result as jpg or bmp---------------------------
procedure eb_wrimg(fn:string);
var
  jpg:tjpegimage;
begin
  if extractfileext(fn)='' then begin
    if hauptf.eb_picwrdlg.FilterIndex=1 then
      fn:=fn+'.jpg'
    else if hauptf.eb_picwrdlg.FilterIndex=2 then
      fn:=fn+'.bmp';
  end;

  if fileexists(fn) then begin
    if application.MessageBox(
      pchar(
        'Bild '+fn+' existiert bereits.'+_cr+
        'Wirklich überschreiben?'
      ),
      '*** FRAGE ***',
      mb_yesno
    )=id_no then exit;
  end;

  screen.Cursor:=crhourglass;
  if lowercase(extractfileext(fn))='.bmp' then begin
    try
      hauptf.eb_bmp.SaveToFile(fn);
      hauptf.eb_bmp.Modified:=false;
      hauptf.eb_fne.Text:=fn;
    except
      application.messagebox(
        pchar(
          'Konnte Ergebnisbild '+
          fn+
          ' nicht als Bitmap speichern!'
        ),
        '*** FEHLER **',
        mb_ok
      );
    end;
  end
  else begin
    jpg:=tjpegimage.Create;
    try
      jpg.assign(hauptf.eb_bmp);
      jpg.CompressionQuality:=70;
      try
        jpg.SaveToFile(fn);
        hauptf.eb_bmp.Modified:=false;
        hauptf.eb_fne.Text:=fn;
      except
        application.messagebox(
          pchar(
            'Konnte Ergebnisbild '+
            fn+
            ' nicht als JPEG speichern!'
          ),
          '*** FEHLER **',
          mb_ok
        );
      end;
    finally
      jpg.Free;
    end;
  end;
  screen.Cursor:=crdefault;
end;


Programm-technisch interessant ist hier eigentlich nur, dass wir das Bild entweder als JPG oder als Bitmap abspeichern können. Das wird entschieden durch die Auswahl der File-Extension im Speicher-Dialog "eb_picwrdlg". Im Falle einer Bitmap können wir die Ergebnis-Bitmap "eb_bmp" direkt abspeichern. Im Falle eines JPGs konvertieren wir die Ergebnis-Bitmap über die "assign"-Methode von TJpegImage in ein JPG, bevor wir es mit einer fixen Qualität von 70% abspeichern.

Und es hat "Zoom" gemacht!

Um das Ergebnis-Bild besser analysieren zu können, lässt es sich mittels diverser Zoom-Methoden vergrössern ("eb_zplus") und verkleinern ("eb_zminus"). Ebenso kann es mit einem Maus-Klick an den sichtbaren Bereich angepasst werden, so dass es vollständig zu sehen ist ("eb_optsz"). Alternativ lässt es sich mit einem Maus-Klick auf 100% Grösse setzen ("eb_orgsz").

//adapt result-bmp to paintbox---------------------------
//=> get zoom-value
procedure eb_optsz;
var
  z:double;
begin
  if
    (hauptf.eb_bmp.height/hauptf.eb_pb.Height)>
    (hauptf.eb_bmp.width/hauptf.eb_pb.width)
  then begin
    z:=(hauptf.eb_pb.height/hauptf.eb_bmp.Height);
  end
  else begin
    z:=(hauptf.eb_pb.width/hauptf.eb_bmp.width);
  end;
  hauptf.eb_ztb.position:=trunc(z*100);
  eb_ztbChange;
end;

//set result to original-size-------------------
//=> zoom-value is 100%
procedure eb_orgsz;
begin
  hauptf.eb_ztb.position:=100;
  eb_ztbChange;
end;

//zoom into result------------------------
procedure eb_zplus(step:integer);
begin
  hauptf.eb_ztb.position:=hauptf.eb_ztb.position+step;
  eb_ztbChange;
end;

//zoom out of result-----------------------
procedure eb_zminus(step:integer);
begin
  hauptf.eb_ztb.position:=hauptf.eb_ztb.position-step;
  eb_ztbChange;
end;

//adapt zoom-trackbar to zoom-value-------------
procedure eb_ztbChange;
begin
  hauptf.zl.Caption:=inttostr(hauptf.eb_ztb.position)+'%';
  eb_paintboxpaint;
end;


Bei obigen Prozeduren wird im wesentlichen nur auf verschiedene Weisen der Zoom-Grad modifiziert und als Position in der Trackbar "eb_ztb" gemerkt.

Originalgrösse bedeutet einen Zoom-Grad von 100. Bei optimaler Grösse ergibt sich die Zoom-Grösse aus dem Verhältnis der Paintbox-Grösse zur Grösse des Ergebnis-Bildes, welches in "eb_bmp" gespeichert ist. Je nachdem, ob die Breite bzw. die Höhe überwiegt, wird dabei entweder das Seiten- oder das Höhenverhältnis berücksichtigt.

PicOfPictures - Ergebnis: Zoom I

Zoom I: Das Bild besitzt einen Zoom-Grad von 100 und damit Original-Grösse

PicOfPictures - Ergebnis: Zoom II

Zoom II: Das Bild besitzt einen Zoom-Grad von 17 und damit in diesem
Beispiel optimale Grösse, um in der Paintbox komplett angezeigt zu werden.

Scrolling

Die exakte Berechnung und Ausgabe des gezoomten Bildes erfolgt erst später, nämlich in der "eb_mkpbbmp"- und "eb_PaintBoxPaint"-Prozedur. Die sehen wir uns gleich an. Aber zuerst widmen wir uns den Scroll-Funktionen, die ebenfalls Einfluss auf den sichtbaren Ausschnitt des Ergebnis-Bildes in der Paintbox "eb_pb" haben.

//set scrollbars in dependence of
//zoom-value and result dimension
procedure eb_setsbs;
var
  w,h:integer;
  sbv,sbh:tscrollbar;
  z:double;
begin
  z:=hauptf.eb_ztb.position/100;

  try
    h:=
      round(hauptf.eb_bmp.height*z)-
      hauptf.eb_pb.height;
    if h<0 then h:=0;
    w:=
      round(hauptf.eb_bmp.width*z)-
      hauptf.eb_pb.width;
    if w<0 then w:=0;

    sbv:=hauptf.eb_vsb;
    sbh:=hauptf.eb_hsb;

    sbv.Max:=h;
    sbh.max:=w;

    w:=sbv.Max div 10;if w<1 then w:=1;
    h:=sbv.Max div 10;if h<1 then h:=1;

    sbv.smallchange:=w;sbv.largechange:=w;
    sbh.smallchange:=h;sbh.largechange:=h;
  except
  end;
end;


Egal, in welche Richtung gescrollt wird, es wird immer nur die eine Prozedur "eb_setsbs" aufgerufen. Die Scrollwerte stehen ja automatisch in den Positions-Attributen der Scrollbars "eb_vsb" und "eb_hsb".

Modifiert werden müssen aber - je nach Zoom-Grad und dadurch bedingte Grösse des Ergebnis-Bildes - die Maxima der beiden Scrollbars, sowie auch ihre Scroll-Schritt-Grössen. Letztere werden so definiert, dass mit 10 Schritten jeweils komplett von oben nach unten bzw. von links nach rechts gescrollt werden kann.

Tiefer Blick in den Ausschnitt

Kennen wir den Zoom-Grad und die Scroll-Positionen, können wir den Ausschnitt berechnen, der in der Paintbox "eb_pb" des Ergebnis-Bildes angezeigt werden soll. Den Ausschnitt speichern wir dazu in "eb_pbbmp".

//transform result to paintbox-bitmap
//look at zoom-value and scroll-position
procedure eb_mkpbbmp;
var
  l,t,w,h,pw,ph:integer;
  z:double;
begin
  eb_setsbs;

  z:=hauptf.eb_ztb.position/100;

  pw:=hauptf.eb_pb.Width;
  ph:=hauptf.eb_pb.height;
  hauptf.eb_pbbmp.width:=pw;
  hauptf.eb_pbbmp.height:=ph;

  h:=round(hauptf.eb_bmp.Height*z);
  if h<ph then t:=(ph-h)div 2 else t:=0;
  if h>ph then h:=ph;
  w:=round(hauptf.eb_bmp.width*z);
  if w<pw then l:=(pw-w)div 2 else l:=0;
  if w>pw then w:=pw;

  hauptf.eb_pbbmp.canvas.pen.Color:=clsilver;
  hauptf.eb_pbbmp.canvas.brush.Color:=clsilver;
  hauptf.eb_pbbmp.canvas.Rectangle(0,0,pw,ph);
  SetStretchBltMode(
    hauptf.eb_pbbmp.canvas.handle,coloroncolor
  );
  try
    stretchblt(
      hauptf.eb_pbbmp.canvas.handle,
      l,t,w,h,
      hauptf.eb_bmp.canvas.handle,
      trunc(hauptf.eb_hsb.position/z),
      trunc(hauptf.eb_vsb.position/z),
      round(w/z),round(h/z),
      srccopy
    );
  except
  end;
end;

//paint (part of) result in dependence
//of zoom-value and scroll-positions
procedure eb_PaintBoxPaint;
begin
  try
    eb_mkpbbmp;
    bitblt(
      hauptf.eb_pb.Canvas.Handle,
      0,0,hauptf.eb_pb.width,hauptf.eb_pb.Height,
      hauptf.eb_pbbmp.canvas.handle,0,0,
      srccopy
    );
  except
  end;
end;


Wir setzen in "eb_mkpbbmp" die Grösse der "eb_phbmp" gleich mit der Grösse der Paintbox "eb_ph" des Ergebnis-Bildes. Durch ein "OnResize"-Ereignis der Hauptform kann sich diese Grösse ja jederzeit verändert haben.

Dann berechnen wir Breite und Höhe des "virtuellen" Bildes, welches sich aus dem aktuellen Zoom-Grad ergibt, den wir in "z" gespeichert haben. Ausserdem berechnen wir die Koordinaten Left "l" und Top "t" des "inneren" Bildes, welches vorliegt, wenn der Ausschnitt des Ergebnis-Bildes kleiner sein sollte als der Paintbox-Bereich.

Die Paintbox bekommt im nächsten Schritt einen silbergraue Hintergrundfarbe verpasst. Anschliessend kopieren wir über die Windows-API-Funktion "StretchBlt" das Ergebnis-Bild "eb_bmp" ab den Scroll-Positionen mit dem vorgegebenen Zoom-Grad in die "eb_phbmp" hinein. Der vorherige Aufruf von "SetStretchBltMode" ist hier übrigens nötig, da Windows standardmässig eine geringere "Stretch"- Qualität als "coloroncolor" beim Canvas verwendet.

Löst die Ergebnis-Paintbox das Ereignis "OnPaint" aus, wird die Prozedur "eb_PaintBoxPaint" ausgeführt. Die macht nun nichts anderes, als die Bitmap "eb_phbmp" auf die eben beschriebene Weise zu generieren und dann auf den Canvas der Piantbox "eb_ph" zu kopieren, wodurch sie für den Benutzer sichtbar wird.

Viel ist scharf ist undeutlich

Wie wir gesehen haben, baut PicOfPics das Original-Bild aus einer bestimmten Anzahl Quader-Bilder auf. Je mehr Quader-Bilder eingesetzt werden, desto "schärfer" wird das Ergebnis-Bild. Diese "Schärfe" hat aber zweierlei Nachteile: Erstens wird das Ergebnis-Bild unter Umständen sehr gross, was lange Berechnungszeiten und viel Speicherbedarf mit sich bringt. Schwerer wiegt aber wohl zweitens, dass nämlich irgendwann die Quader-Bilder gar nicht mehr als Einzelbilder zu erkennen sind.

Anders herum bedeuten wenige Quader-Bilder logischerweise "Unschärfe", was im ungünstigen Fall zur Folge hat, dass das Original-Bild völlig "verschwimmt".

PicOfPictures - Ergebnis: Quader-Schärfe I

"Quader-Schärfe" I: Viele Quader-Bilder bringen zwar sehr schön Jessicas scharfe
Kurven zur Geltung, lassen aber die Einzelbilder zu Beinahe-Punkten verkümmern.

PicOfPictures - Ergebnis: Quader-Schärfe II

"Quader-Schärfe" II: Wenige Quader-Bilder zeigen Jessica öfter, aber insgesamt undeutlicher

Blending

Um dem eben geschilderten "Unschärfe"-Problem etwas entgegenzusetzten, verfügt PicOfPics über eine Technik, mit der das Original-Bild auf vielfältige Weise in das Ergebnis-Bild eingeblendet werden kann.

PicOfPictures - Ergebnis: Verblendung

Verblendung: Das Original-Bild wird in das Ergebnis-Quader-Bild einblendet.

Diese "Blend"-Funktionen schauen wir uns jetzt noch etwas näher an:

//merge orgiginal or quad-result-bmp into result-image---------------------
procedure eb_blend;
var
  bmp:tbitmap;
begin
  if not hauptf.Visible then exit;

  screen.Cursor:=crhourglass;
  try
    //copy blend-bmp to result-bmp
    hauptf.eb_bmp.assign(hauptf.eb_blendbmp);

    if hauptf.eb_blendorgrb.checked then begin
      //merge original to result
      bmp:=hauptf.eb_orgbmp;
    end
    else begin
      //merge quader-result-pic to result
      bmp:=hauptf.eb_quadbmp;
    end;

    //do merging, adapt eb_bmp
    eb_blendbmps(
      hauptf.eb_bmp,
      bmp,
      hauptf.eb_hellmodecb.itemindex,
      hauptf.eb_hellvonsb.position,
      hauptf.eb_hellbissb.position,
      hauptf.eb_blendmodecb.itemindex,
      hauptf.eb_blendsb.Position,
    );

  finally
    screen.Cursor:=crdefault;
    hauptf.eb_pbpaint(nil);
  end;
end;


Die Prozedur "eb_blend" wird jedemal aufgerufen, wenn irgendetwas an den Verblendungs-Optionen geändert wird.

Zunächst kopieren wir das letzte Ergebnis-Blend-Bild "eb_blendbmp" in die Ergebnis-Bitmap "eb_bmp". Die "eb_blendbmp" entspricht dabei solange dem originalem Ergebnis-Quader-Bild, bis der der Benutzer den Button "Übernehmen" anklickt; dann wird das aktuelle Ergebnis-Bild "eb_bmp" zur neuen "eb_blendbmp", und damit zur Basis möglicher weiterer Verblendungen.

Danach wird entschieden, welches Bild denn nun genau in die Blend-Bitmap einblendet werden soll: Das Original-Bild, vergrössert/verkleinert auf die Dimension des Ergebnis-Bildes - das steht in "eb_orgbmp" -, oder das originale Ergebnis-Quader-Bild, also das Bild, dass uns die PicOfPics-Prozedur generiert hat, welches in "eb_quadbmp" gespeichert wurde.

Die Verblendung selbst geschieht über die Prozedur "eb_blendbmps", wodurch die Ergebnis-Bitmap "eb_bmp" den Einstellungen entsprechend modifiziert wird. Zu der Prozedur kommen wir gleich noch.

Kaskadierende Verblendung

Wie beschrieben kann das (durch die Verblendung modifizierte) Ergebnis-Bild duch einen Klick auf "Übernahme" zur neuen Blend-Bitmap gemacht werden, indem die folgende Funktion aufgerufen wird (aus Faulheit befindet sie sich in der Haupt-Unit, gehört aber eigentlich in die Ergebnis-Bild-Unit):

procedure Thauptf.eb_blendsvbClick(Sender: TObject);
begin
  screen.Cursor:=crhourglass;
  eb_blendbmp.Assign(hauptf.eb_bmp);
  eb_blendsb.Position:=0;
  screen.Cursor:=crdefault;
end;


Dadurch kann das Ergebnis-Bild "kaskadierend" modifiziert werden, indem abwechselnd das Original-Bild bzw. das Ergebnis-Quader-Bild als Quell-Bild in das Ergebnis-Bild einblendet wird. Das erlaubt interessante Effekte. Und wenn das Quell-Bild zu 100% eingeblendet wird, können zudem alle vorherigen Modifikationen auch jederzeit wieder übermalt werden.

PicOfPictures - Ergebnis: Verblendung

Kaskade: I) Die Blend-Bitmap enthält das Ergebnis-Quader-Bild.
II) In die Blend-Bitmap wird das Original-Bild eingeblendet, das Ergebnis übernommen.
III) In die neue Blend-Bitmap wird nun das Quader-Bild eingeblendet (im "additiv"-Modus).

Pixel-Mischmasch

Sehen wir uns jetzt die eigentlich Verblendungs-Kern-Prozedur "eb_blendbmps" an, die die Pixel der zwei gewählten Bitmaps miteinander vermischt.

//merge blendbmp into basisbmp----------------------------
procedure eb_blendbmps(
  basisbmp:tbitmap;      //target and source
  blendbmp:tbitmap;      //source to merge in
  hellmode:byte;         //gray-value-mode
  hellvon:integer;       //gray-value start for hellmode
  hellbis:integer;       //gray-value end for hellmode
  blendmode:byte;        //merge-mode
  transp:integer         //strength of merging
);
var
  basishelligkeit,blendhelligkeit,
  basisgewicht,blendgewicht,
  basisr,basisg,basisb,
  blendr,blendg,blendb,
  mischr,mischg,mischb,
  x,y:integer;
  basisba,blendba:pbytearray;
  basiscol,blendcol:tcolor;
  is_hellbereich:bool;

  //convert int to byte------------
  function i2b(i:integer):byte;
  begin
    if i>255 then i:=255;
    if i<0 then i:=0;
    result:=byte(i);
  end;

begin
  blendgewicht:=transp;
  basisgewicht:=255-blendgewicht;

  for y:=0 to basisbmp.height-1 do begin

    //get line of color from source
    blendba:=blendbmp.scanline[y];

    //get line of colors from target
    basisba:=basisbmp.scanline[y];

    for x:=0 to basisbmp.width-1 do begin

      //gray-value of source
      blendr:=blendba[x*3+2];
      blendg:=blendba[x*3+1];
      blendb:=blendba[x*3+0];
      blendcol:=rgb(blendr,blendg,blendb);
      blendhelligkeit:=hauptf.col2helligkeit(blendcol);

      //acceptable gray-value?
      is_hellbereich:=
        (blendhelligkeit>=hellvon)and
        (blendhelligkeit<=hellbis);
      if
        ((hellmode=0)and not is_hellbereich)or
        ((hellmode=1)and is_hellbereich)
      then continue;

      //gray-value of target
      basisr:=basisba[x*3+2];
      basisg:=basisba[x*3+1];
      basisb:=basisba[x*3+0];
      basiscol:=rgb(basisr,basisg,basisb);
      basishelligkeit:=hauptf.col2helligkeit(basiscol);

      //do blend-mode----------------------
      mischr:=0;
      mischg:=0;
      mischb:=0;
      if blendmode=0 then begin
        //merge always
      end
      else if blendmode=1 then begin
        //merge if source is darker
        if blendhelligkeit>basishelligkeit then
          continue;
      end
      else if blendmode=2 then begin
        //merge if source is brighter
        if blendhelligkeit<basishelligkeit then
          continue;
      end
      else if blendmode=3 then begin
        //merge additiv
        mischr:=i2b((basisr*255+blendr*blendgewicht)div 255);
        mischg:=i2b((basisg*255+blendg*blendgewicht)div 255);
        mischb:=i2b((basisb*255+blendb*blendgewicht)div 255);
      end
      else if blendmode=4 then begin
        //merge subractive
        mischr:=i2b((basisr*255-blendr*blendgewicht)div 255);
        mischg:=i2b((basisg*255-blendg*blendgewicht)div 255);
        mischb:=i2b((basisb*255-blendb*blendgewicht)div 255);
      end;

      if blendmode<3 then begin
       //calculate new mix color (merge-color)
        mischr:=i2b((basisr*basisgewicht+blendr*blendgewicht)div 255);
        mischg:=i2b((basisg*basisgewicht+blendg*blendgewicht)div 255);
        mischb:=i2b((basisb*basisgewicht+blendb*blendgewicht)div 255);
      end;

      //bring new color to target
      basisba[x*3+2]:=mischr;
      basisba[x*3+1]:=mischg;
      basisba[x*3+0]:=mischb;

    end;
  end;
end;


Für das Beispiel nehmen wir an, wir wollen die Original-Bitmap in das aktuelle Ergebnis-Bild (das ist die Ergebnis-Quader-Bitmap der PicOfPics-Prozedur) einblenden. Dann entspricht der Parameter "basisbmp" der Ergebnis-Bitmap "eb_bmp" und der Parameter "blendbmp" der Original-Bitmap "eb_orgbmp".

Wir durchlaufen die beiden Bitmaps zeilenweise und füllen jeweils ein PByteArray ("basisba" und "blendba") mit den Pixelfarben.

In der inneren Schleife durchlaufen wir die Arrays "pixelweise". Den Array-Index "x" müssen wir dabei jeweils mit 3 multiplizieren, da die PbyteArrays ja für jeden Pixel 3 Werte enthalten, nämlich für die Farbkanäle blau, grün und rot (siehe weiter oben).

Ausgrenzung durch Helligkeit

Zuerst betrachten wir das aktuelle Pixel der "blendbmp", also unseres Original-Bildes. Wir konvertieren die drei Farbkanalwerte von "blendba" mittels "rgb"-Funktion zu einer Farbe. Diese Farbe rechnen wir anschliessend mit "col2helligkeit" in einen Helligkeitswert um. Jetzt können wir prüfen, ob wir uns im optional erlaubten Helligkeitsbereich befinden.

Ist das Pixel der Blend-Bitmap zu dunkel oder zu hell, wird es ignoriert. Das heisst, das Pixel wird nicht in das Ergebnis-Bild eingeblendet. Was wiederum heisst, an der Stelle bleibt die Basis-Bitmap komplett erhalten.

PicOfPictures - Ergebnis: Verblendung Helligkeit I

Verblendung Helligkeit I: Der komplette Helligkeitsbereich von 0 bis 255 wird beachtet.
Die hellen Pixel des Orginal-Bildes überdecken die Pixel der Quader-Bilder.
Der Hintergrund verschwindet dadurch geradezu.

PicOfPictures - Ergebnis: Verblendung Helligkeit II

Verblendung Helligkeit II: Nur der Helligkeitsbereich von 0 bis 235 wird beachtet.
Hellere Farben des Original-Bildes werden entsprechend ignoriert.
In diesem Bereich bleiben die Quader-Bilder zu 100% unverändert.
Der Hintergrund ist deutlich sichtbar.

PicOfPictures - Ergebnis: Verblendung Helligkeit III

Verblendung Helligkeit III: Umkehrung der Beachtung des Helligkeitsbereichs ("Helligkeit ignorieren").
Nun bleiben überall dort die Quader erhalten, wo das Original-Bild dunkler ist als "235".

Blend-Modi

Als nächstes bestimmen wir die Helligkeit des aktuellen Pixels der "basisbmp", in unserem Fall also der Ergebnis-Quader-Bitmap. Das Verfahren ist das gleiche wie bei der "blendbmp", nur dass diesmal auf das Pixel-Array "basisba" zugegriffen wird.

Wir haben nun zwei Helligkeitswerte zur Verfügung, "blendhelligkeit" und "basishelligkeit". Über diese Kriterien können wir das weitere Verhalten von PicOfPics bezüglich des Blend-Modus steuern.

Mach 's mir immer und überall

Im Falle des Blend-Modus "immer einblenden" müssen wir nichts weiter prüfen; Basis- und Blendpixel werden unabhängig von ihrer Helligkeit zu einem neuen Farbwert vermischt. Dazu gleich mehr.

Black is beautiful

Wurde jedoch der Blend-Modus "einblenden, wenn dunkler" gewählt, dann gilt: Sollte die "blendhelligkeit" grösser als die "basishelligkeit" sein, sprich: heller, dann ignorieren wir das aktuelle Pixel im Ziel, lassen es also unverändert.

PicOfPictures - Ergebnis: Blend-Modus: einblenden, wenn dunkler

Blend-Modus "einblenden, wenn dunkler": Jessicas schwarzes Kleid überdeckt die Basis-Bitmap,
ihr helles Gesicht dagegen kann sich nicht "durchsetzen".

Blondinen bevorzugt

Genau umgekehrt verhält es sich beim Modus "einblenden, wenn heller": In diesem Fall werden die Blend- und Basi-Pixel nur vermischt, wenn die "blendhelligkeit" grösser als die "basishelligkeit" ist. Ansonsten wird das Pixel erneut unverändert gelassen. So kann man helle Partien des Originals sehr schön aus den Quader-Bildern "herausscheinen" lassen.

PicOfPictures - Ergebnis: Blend-Modus: einblenden, wenn heller

Blend-Modus "einblenden, wenn heller": Jessicas Gesichtsfarbe scheint überall durch.
Ihre dunklen Haar- und Augenpartien lassen dagegen die Quader-Bilder unverändert.

Pixel-Stapel

Der Blend-Modus "additiv einblenden" bewirkt, dass die Farbwerte der Blend- und Basis-Pixel aufaddiert, sie also quasi übereinander gestapelt werden. Dazu werden die einzelnen Farbkanäle aufsummiert, und zwar so, dass die Basis-Farbwerte zu 100% gewichtet werden, während die Blend-Farbwerte nur mit dem optionalen Grad der Verblendung berücksichtigt werden. Dadurch werden die Farbwerte generell grösser, das Bild also ingesamt heller.

PicOfPictures - Ergebnis: Blend-Modus: additiv

Blend-Modus "additiv einblenden": Die Farbwerte der Quader und des Originals werden aufaddiert.
Dadurch wird der ohnehin schon helle Hintergrund fast durchgehend weiss.

Negativität schafft Dunkelheit

Ähnlich arbeitet der "Blend-Modus "subtraktiv einblenden", nur dass diesmal die Werte der Farbkanäle von einander abgezogen werden. Das Gesamtbild wird dadurch logischerweise dunkler. Auch hier gilt, das die Farbwerte der Basis-Pixel vollständig beibehalten, und die Blend-Pixel nur in Abhängigkeit vom Blend-Grad berücksichtig werden.

PicOfPictures - Ergebnis: Blend-Modus: subtraktiv

Blend-Modus "subtraktiv einblenden": Hier diente das Original als Basis- und die Quader als Blend-Bitmap.
Jessicas schwarzes Kleid bleibt schwarz, ihr Gesicht wird dagegen um die Farbwerte der Quader verdunkelt.

Auf die richtige Mischung kommt es an

Die Blend-Modi wurden abgearbeitet. Im Falle des addiven sowie des subtraktiven Blend-Modus haben wir bereits die neuen Mischfarbwerte berechnet. Bei den anderen Modi steht diese Berechnug noch aus.

Der Verblendungs-Grad kann einen Wert von 0 bis 255 annehmen. 0 bedeutet, dass jedes Basis-Pixel zu 100% und jedes Blend-Pixel zu 0% berücksichtigt werden soll. Beim Blend-Grad 255 gilt genau das Gegenteil. Bei allen Werten dazwischen müssen Mischfarben berechnet werden.

Die Gewichtung der Farbwerte von Basis- und Blend-Bitmap verläuft umgekehrt proportional. Daher gilt: Das Blendgewicht entspricht dem Verblendungs-Grad, das Basisgewicht dem Wert "255-Blendgewicht". In Prozent ausgedrückt heisst das z.B.: Die Blend-Bitmap soll zu 30% eingeblendet werden, also darf die Basis-Bitmap nur zu 70% berücksichtigt werden.

Bei der Kalkulation der Mischfarbe werden daher die Rot-, Grün- und Blau-Anteile des Basis-Pixels jeweils mit dem Wert von "basisgewicht" multipliziert. Entsprechend wird mit dem Blend-Pixel verfahren, jetzt aber natürlich mit "blendgewicht" gerechnet. Die beiden Werte werden je Farbkanal aufsummiert und anschliessend durch 255 geteilt, so dass sie sich wieder im erlaubten Bereich von 0 bis 255 bewegen. Als Ergebnis erhalten wir die gewünschte Mischfarbe je Farbkanal.

In einem letzten Schritt muss jetzt nur noch das Basis-PByteArray mit den eben berechneten Werten der Mischfarbkanäle gefüllt werden. Dadurch wird die Zielbitmap an passender Stelle umgefärbt. Sind alle Pixel abgearbeitet, liegt das neue Bild in "basisbmp" vor und kann in der aufrufenden Prozedur "eb_blend" weiter behandelt werden (siehe weiter oben).

Maus-Kontrolle

Damit hätten wir auch die Ergebnis-Page abgearbeitet. Bis auf eine Kleinigkeit. Um sich beim Finetuning den ständigen Wechsel zwischen der Verblendungs- und Zoom-Page zu ersparen, habe ich nachträglich noch eine Maussteuerung für das Scrollen und Zoomen des Ergebnis-Bildes eingebaut. Hier ist der Source dazu:

//click on result-bmp-------------------------------
procedure eb_pbMouseDown(
  Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState;
  X, Y: Integer
);
begin
  if button=mbmiddle then begin
    //change size to optimum
    eb_optsz;
    exit;
  end
  else if button=mbright then begin
    //change size to original
    eb_orgsz;
    exit;
  end;

  //save actually scroll-positions
  hauptf.eb_hpos:=hauptf.eb_hsb.Position+x;
  hauptf.eb_vpos:=hauptf.eb_vsb.Position+y;
  hauptf.eb_scrollok:=true;
end;

//moving the mouse on result
procedure eb_pbMouseMove(
  Sender: TObject;
  Shift: TShiftState;
  X,Y: Integer
);
begin
  //left mousebutton down?
  if not hauptf.eb_scrollok then exit;

  //yep: scroll to new position
  hauptf.eb_hsb.Position:=(hauptf.eb_hpos-x);
  hauptf.eb_vsb.Position:=(hauptf.eb_vPos-y);
end;

//mouse button up over result
procedure eb_pbMouseUp(
  Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState;
  X, Y: Integer
);
begin
  //disable scroll-mode
  hauptf.eb_scrollok:=false;
end;

procedure Thauptf.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if pctrl.ActivePage<>eb_ts then exit;
  if wheeldelta<0 then eb_u.eb_zplus(1)
                  else eb_u.eb_zminus(1);
end;


Klickt der Anwender auf das Ergebnis-Bild, wird das "OnMouseDown"-Ereignis ausgelöst, welches die Prozedure "eb_pbMouseDown" aufruft. Hier wird zunächst geprüft, welcher Mausbutton gedrückt wurde. Ist es der mittlere, dann wird das Bild auf optimale Grösse vergrössert/verkleinert. Ist es der rechte, dann wird das Bild auf Original-Grösse gebracht. War es dagegen der linke, dann merken wir uns die aktuelle Mausposition in den globalen Form-Variablen "eb_hsv" und "eb_vsb". Ausserdem aktivieren wir den Scrollmodus "eb_scrollok".

Verschiebt man die Maus über dem Ergebnis-Bild, dann wird "OnMouseMove" ausgelöst, was die Prozedur "eb_pbMouseMove" aufruft. Hier wird zuerst geprüft, ob die linke Maustaste überhaupt gedrückt ist. Das können wir über den boolschen Wert des Scrollmodus "eb_scrollok" feststellen. Die Abfrage ist nötig, da sonst jede Mausänderung ein Scrollen des Ergebnis-Bildes bewirken würde. Ist der Scollmodus aktiv, setzen wir die Scrollbars neu, in Abhängigkeit zur aktuellen Positionsänderung seit dem letzten Klick mit der linken Maustaste.

Lässt der Anwender irgendwann die linke Maustaste wieder los, wird "OnMouseUp" aufgerufen, was die Prozedur "eb_pbMouseUp" aufruft. Die macht dann nichts anderes, als den Scrollmodus (wieder) zu deaktivieren.

Das Zoomen des Ergebnis-Bildes mittels des mittleren Maus-Rades musste über das Form-Ereignis "OnMouseWheel" gelöst werden, da die TPaintbox "eb_ph" nicht selbst über dieses Ereignis verfügt. In der dadurch aufgerufenen Prozedur "FormMouseWheel" wird daher zunächst festgestellt, ob wir uns derzeit auf der Page des Ergebnis-Bildes befinden. Ist dies nicht der Fall, verlassen wir die Prozedur. Ansonsten wird - je nachdem, ob das Mausrad hoch oder runter bewegt wurde - in das Ergebnis-Bild hinein- ("eb_zplus") oder heraus ("eb_zminus") gezoomt.

Beispiele

Geniessen wir am am Schluss noch ein paar Beispiele aus der Welt von PicOfPics. Einfach, damit wir sehen, wofür die ganze Schufterei gut war :-)

Beispiel I
PicOfPictures - Demo: Jessica Alba in spektraler Wiederholung

Jessica Alba in spektraler Wiederholung
Beispiel II
PicOfPictures - Demo: Schwarz-Weiss-Pixelblöcke in minderer Qualität

Schwarz-Weiss-Pixelblöcke in minderer Qualität
Beispiel III
PicOfPictures - Demo: Schwarz-Weiss-Pixelblöcke in bester Qualität plus Verlauf-Modus

Schwarz-Weiss-Pixelblöcke in bester Qualität plus Verlauf-Modus
Beispiel IV
PicOfPictures - Demo: Einheitlich gefärbte Blöcke als Quader-Bilder

Einheitlich gefärbte Blöcke als Quader-Bilder
Beispiel V
PicOfPictures - Demo: Beste Quader-Bilder, Dominanz dunkler Farben des Originals

Beste Quader-Bilder, Dominanz dunkler Farben des Originals
Beispiel VI
PicOfPictures - Demo: Flug in den Wolken

Flug in den Wolken
Beispiel VII
PicOfPictures - Demo: Billardkugeln aus Textur-Quader-Bildern

Billardkugeln aus Textur-Quader-Bildern
Beispiel VIII
PicOfPictures - Demo: Kelly und Al bestehen aus einer TV-Bilder-Orgien

Kelly und Al bestehen aus einer TV-Bilder-Orgien

Buntes Bündel Bytes

PicOfPics wurde in Delphi7 programmiert. Im ZIP-File enthalten ist der vollständige Source-Code, einige Original-Bilder, mehrere Quader-Pools, ein paar Ergebnis-Bilder, sowie die EXE. Das ganze Packet, etwa 4 MB, gibt's hier:

PicOfPics.zip



Es wurde auf die Verwendung von Fremd-Komponenten verzichtet. Auch werden keine speziellen DLLs benötigt. Der Source-Code lässt sich sicher leicht auf andere Delphi-Versionen anpassen. Das ausführbare Programm ist mit 750 KB im Vergleich zu manch anderem Grafik-Programm sehr klein. Ausserdem nimmt es keine Änderungen an der Registry vor; alle Programm-Parameter werden über eine INI-Datei im Arbeistordner verwaltet.

Have fun!

Abschliessendes

Bleibt noch zu sagen, dass eine ganze Reihe von Ideen, die ich ausprobiert habe, nicht von Erfolg gekrönt waren.

Pixel zu Quader versus Quader zu Pixel

So hatte ich ein Verfahren entwickelt, dass nicht - wie jetzt - zu jedem Pixel der Pixel-Bitmap des Original-Bildes ein Quader-Bild gesucht hat, sondern umgdreht zu jedem Quader-Bild den oder die am besten passenden Pixel. Auf diese Weise wurde sichergestellt, dass jedes Quader-Bild mindestens einmal verwendet wurde (sofern die Anzahl Quader gross genug war). Zwar wurde dadurch das Ergebnis-Bild abwechslungsreicher, das Original-Bild ging aber regelmässig derart "unter" in dem bunten Treiben, dass ich diesen Weg nicht weiter verfolgte.

Quadratisch, praktisch, gut

Einige Experimente betrieb ich auch wegen der Form der Quader-Bilder im Ergebnis-Bild. In PicOfPics werden nämlich die Pool-Bilder durch die Bank weg wie Quadrate eingesetzt (sofern keine "Verwacklung" von Breite und Höhe aktiv ist). Es gilt ganz einfach: Ein Pixel, ein Quader.

Nun zeigt die Praxis aber, dass weitaus die meisten Bilder, die man so findet, keineswegs quadratisch sondern rechteckig sind. Verwendet man diese, hat das zwangsläufig zur Folge, dass die Quader-Bilder im Ergebnis-Bild verzerrt auftauchen. Das ist unschön.

Eine Möglichkeit, dem zu begegnen, wäre, im Quader-Pool in einer eigenen Spalte zu vermerken, ob das Quader-Bild nun hochkant-rechteckig, waagrecht-rechteckig oder quadratisch ist. Den Abgleich der Quader-Bilder zur Pixel-Bitmap könnte man dann folgendermassen erweitern: Ein Hochkant-Rechteck bestünde aus 2 x 3 Pixel, ein Waagrecht-Rechteck aus 3 x 2 Pixel und ein Quadrat aus 2 x 2 Pixel. Wie man sich jedoch leicht ausrechnen kann, ergibt sich daraus das Problem, dass die ganze Sache am Schluss "aufgeht", d.h., alle Teile in diesem Puzzel so zusammenpassen, dass es keine "Leerstellen" gibt.

Erfolgsversprechender war der umgedrehte Weg, den ich dann einschlug: Das Verfahren "ein Pixel, ein Quader", hielt ich aufrecht, nur adaptierte ich jetzt das Quader-Bild, "quadrierte" es gewissermassen. Lag es bereits als Quadrat vor, beliess ich es dabei. War es ein Rechteck, dann "schnitt" ich mir einfach einen möglichst grossen quadratischen Teil davon heraus. Diesen Ausschnitt zentrierte ich in Breite oder Höhe, je nachdem, ob ein Waagrecht- oder Senkrecht-Rechteck vorlag. Das Ergebnis enttäuschte aber. Zwar gab's nun keine Verzerrungen mehr, aber das Schnitt-Quadrat traf nur relativ selten das eigentliche Motiv des Quader-Bildes. Gerade bei Senkrecht-Quadern wurden häufig die Köpfe der dargestellten Personen abgeschnitten. Ne, ne, das war so nix.

Farbkanäle, Rahmen und Spiegelungen

Weiter spielte ich damit herum, die Histogramme von Quader-Pool und Original-Bild auf die einzelnen Farbkanäle hin zu erweitern. Statt also nur die verwendeten Helligkeitsstufen anzuzeigen, konnte man sich optional auch alle Rot-, Grün- oder Blau-Stufen präsentieren lassen. Der Informationsgewinn tendierte aber gegen Null, ja, er verwirrte eher als dass er etwas nutzte.

Dann überlegte ich mir noch diverse "Einrahmungs"-Methoden, mit denen man das Ergebnis-Bild verschönern könnte. Denn so ein Rahmen um das Bild macht manchmal schon was was her. Aber hey, warum sich einen Kopf machen? Dafür gibt's schiesslich genügend andere Programme (z.B. beherrscht das u.a. auch meine eigenes Grafik-Programm mit dem etwas einfallslosen Tiel "Graf").

Schliesslich startete ich Versuche, mehr Abwechslung in das Ergebnis-Bild zu bringen, indem ich die Quader-Bilder gemäss ihrer Verlauf-Farben spiegelte, so dass sie sich farblich noch besser zum Original-Bild arrangieren liessen. Aber nicht jedes Motiv macht gespieglt Sinn, etwa wenn Schrift darauf zu lesen ist. Und woran sollte der Computer dies erkennen?

Soetwas verdirbt mir jedenfalls nicht den Spass an meinem Proggy. Ist halt nichts 100%iges. But who cares?


| Home | News | Software | HTML | DHTML | Javascript | CGI | VRML | Linux | Dirty-Progs | CSS-DIV-Slicer | Sprite-Painter | FLV-CCC | CPU-Eater | Pixel-Evolution | MediaPanelyzer | OpenGL ISS | OpenGL Planets | PicOfPics | OpenGL Henrys | VidSplitt | PHP | Src2Textarea | Volltext-Suche | Hilfsfunktionen | Bilder | Texte | Alles fliesst | Comics | Musik | Leben | Links | Sitemap | Admin |

© by DanPHPEd - Letzte Änderung: 09. Mai 2009