Benutzer-Passwort

Kritisches bei

Sprite-Painter - Malen mit Sprites

Sprite-Painter-Tutorial von Daniel Schwamm (13.11.2009 - 20.11.2009)

Aus "Heimat des Dilettantismus"
http://www.daniel-schwamm.de/index.php?pg=delphi-tutorials/sprite-painter

Inhalt

Der VVV (Virus der Verklärung der Vergangenheit) befällt bisweilen auch mein Hirn. Dachte daher neulich an alte Amiga-Zeiten zurück und wie viel Spass ich mit dem genialen Grafik-Programm von Dan Silva hatte: "Deluxe Paint".

Deluxe Paint auf dem Amiga: Unvergessenes Mal-Programm aus alten Zeiten.

Bildausschnitte mit der Maus selektieren und diese wie Pinsel zu verwenden, das war das, was mir daran am besten gefiel (die Animationsfähigkeiten - bis heute konkurrenzlos - hatte DP damals noch nicht). Das war simpel, das war effektiv, das erbrachte unmittelbare Ergebnisse. Kein anderes Grafik-Programm hat mich je wieder so lange bei Laune gehalten wie Deluxe Paint. Nicht einmal MS Paint :-)

1.1.2. GrafiX2

Selig grinsend dachte ich: "Malen mit Sprites! Ja, das war schon was ..." Und im nächsten Moment auch schon: "Das will ich wieder haben!". Dann die Überlegung: "Mh ... suche ich im Web nach passenden Alternativen? Gibt es es da nicht dieses kostenlose GrafX2-Programm?".

GrafX2: Ein liebevoll programmierter Freeware-Clone von Deluxe Paint, der auch auf PCs einsetzbar ist. URL: http://code.google.com/p/grafx2/

1.1.3. Mein Sprite-Painter

Schliesslich die Entscheidung: "Nö, doch lieber selbst machen!" Und exakt zwei Tage später war die Chose erledigt: Mein "Sprite-Painter" ward geboren.

Sprite-Painter: Ein Tool, welches es erlaubt, Bildausschnitte als Pinsel zu verwenden, um damit Sprites zu generieren. Die Bilder, die dabei entstehen, können in einem eigenen Format gespeichert werden, bei dem alle Sprites erhalten bleiben.

2. Die Delphi-Units von Sprite-Painter

Sprite-Painter wurde in Delphi 7 programmiert und verwendet die folgenden Units:

service_u: unit mit Konstanten, Typen und Hilfsfunktionen.
bmp_u: unit mit "TBMP"-Klassendefinition.
selection_u: unit mit "TSelection"-Klassendefinition.
sprite_u: unit mit "TSprite"-Klassendefinition.
sprite_list_u: unit mit Funktionen zur Verwaltung der Sprite-ListBox.
main_u: Haupt-unit mit Form "main_f".

Schauen wir uns den Kram näher an ...

2.1. Unit "service_u-pas": Hilfestellung

Die unit "service_u.pas" wird von allen anderen Units inkludiert. Sie beinhaltet diverse Konstanten, Typen und Hilfsfunktionen, die überall im Programm Verwendung finden.

2.1.1. Konstanten

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014

_caption='SPRITE-PAINTER V1.0';
_background_color=clbtnface;
_cr=#13#10;

//definition of transparent color
_transp_col_r=254;
_transp_col_g=1;
_transp_col_b=2;

//max number of sprites
_sprite_max=100;

//max number of freestyle-points
_freestyle_max=5000;

Um transparente Bereiche in Bitmaps/Sprites zu kennzeichnen, bekommen diese eine zuvor definierte Farbe zugeordnet. Bei mir ist das eine leichte Abart von reinem rot (siehe "transp_col*"-Konstanten mit Rot-Grün-Blau-Anteil). Es findet im Programm übrigens weiter keine Prüfung statt, ob diese Farbe nicht zufällig auch für "echte" Pixel Verwendung findet. Das wäre allerdings bei mehr als 16 Millionen möglichen Farben (255*255*255) schlicht lausiges Pech.

Die Anzahl Sprites, die innerhalb eines Sprite-Painter-Bildes verwaltet werden kann, darf die 100 nicht übersteigen. Die maximale Anzahl Freestyle-Punkte (Punkte einer Selektionsumrandung, die mit Hand gezeichnet wird) liegt bei 5000. Beide Grenzwerte lassen sich hier erweitern, sollte das je nötig sein.

Freestyle-Selection: Sprite-Painter erlaubt es, beliebige Bildbereiche freihändig zu umranden. Bis zu 5000 Randpunkte können dabei mit der Maus vergeben werden. Das genügt sogar für die vielen Kurven der Alba.

2.1.2. Typen

00001
00002
00003
00004
00005
00006
00007

TRGBCol=record
r,g,b:byte;
end;

TSelection_Style=(ss_rectangle,ss_ellipse,ss_freestyle);

TMerge_Style=(ms_always,ms_lighter,ms_darker);

Sprite-Painter operiert intern nur mit 24-Bit-Bitmaps. Deren Pixel setzen sich aus den drei Grundfarben rot, grün und blau zusammen. Diese haben jeweils einen Wertebereich von 0-255. Besitzen also Byte-Grösse. 0 bedeutet Farbe nicht vorhanden, 255 bedeutet Farbe voll vorhanden.

Repräsentiert wird eine solche RGB-Farbe im Sprite-Painter durch den Typ "TRGBCol". Die Farbe gelb etwa ist eine Mischfarbe aus rot und grün ohne blau. In "TRGBCol"-Form ergibt dies: (r=255,g=255,b=0)

RGB-Spektrum: Aus den drei Grundfarben rot, grün und blau lassen sich prinzipiell alle anderen Farben zusammenmischen. Da Windows je Grundfarbe ein Byte spendiert, sind insgesamt 255*255*255 ~ 16 Millionen verschiedene Farben darstellbar.

2.1.2.1. Selection-Styles

Drei Methoden gibt es, um Ausschnitte aus einem Bild auszuwählen ("TSelection_Style"): Man zeichnet mit der Maus ein Rechteck ("ss_rectangle"), eine Ellipse ("ss_ellipse") oder umrandet das Ziel freihändig ("ss_freestyle").

Ellipse-Selektion: Hier wurde über die Ellipsen-Selektion ein runder Bildbereich aus dem Gesicht von Scarlet ausgewählt.

2.1.2.2. Merge-Styles

"TMerge_Style" gibt an, unter welchen Bedingungen ein Sprite-Pixel auf dem Untergrund erscheint, auf dem er liegt. Entweder immer ("ms_always"), oder nur wenn er heller ("ms_lighter") bzw. dunkler ("ms_darker") als der Pixel des Untergrundes ist.

Merge-Style "ms_darker": Nur diejenigen Punkte des Sprites werden gemalt, die dunkler sind als der Untergrund. Dadurch sind etwa bei obigem Bild die hellen Stirnpartien des grossen Gesichts transparent geworden.

2.1.3. Hilfsfunktionen

Nun zu den Hilfsfunktionen. Die ersten beiden dienen uns beim Umgang mit den eben kennengelernten "TRGBCol"-Farben:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013

//transform TColor to TRGBCol
function col2rgb_col(col:TColor):TRGBCol;
begin
  result.r:=getrvalue(col);
  result.g:=getgvalue(col);
  result.b:=getbvalue(col);
end;

//transform TRGBCol to TColor
function rgb_col2col(rgb_col:TRGBCol):TColor;
begin
  result:=rgb(rgb_col.r,rgb_col.g,rgb_col.b);
end;

Windows speichert Farbwerte über den Typ "TColor". Die Funktionen "col2rgb_col" und "rgb_col2col" erlauben die Transformation der Farbwerte von "TColor" in "TRGBCol" und umgekehrt.

Um festzustellen, ob eine Farbe "col1" dunker als eine andere "col2" ist, ziehen wir in der Funktion "rgb_col_is_darker" die einzelnen Grundfarben der beiden Farben voneinander ab und summieren das Ergebnis anschliessend. Kommt dabei insgesamt ein negativer Wert heraus, dann waren die Farbwerte von "col2" offenbar grösser. Und grösser bedeutet heller, weil farbintensiver. Ergo ist "col1" dunkler als "col2".

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015

//check if rgb_col1 is darker than rgb_col2
function rgb_col_is_darker(rgb_col1,rgb_col2:TRGBCol):bool;
begin
  result:=(
    (rgb_col1.r-rgb_col2.r)+
    (rgb_col1.g-rgb_col2.g)+
    (rgb_col1.b-rgb_col2.b)<0
  );
end;

//check if rgb_col1 is lighter than rgb_col2
function rgb_col_is_lighter(rgb_col1,rgb_col2:TRGBCol):bool;
begin
  result:=not rgb_col_is_darker(rgb_col1,rgb_col2);
end;

2.1.4. Sprite-Painter-Pic-Streaming

2.1.4.1. Stream-Aufbau

Zum Speichern von Bildern, die Sprites beinhalten, verwenden wir Streams. Innerhalb der Streams werden "Tags" abgelegt, die mit "Values" gefüllt sind. Das Ganze ähnelt einer Mischung aus XML- und INI-Datei. Der typische SPP-Stream ("Sprite-Painter-Pic"-Stream), den ich mir dazu überlegt habe, ist folgendermassen aufgebaut:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032

<sprite-painter>
<header>
<Author>Daniel Schwamm</Author>
...
<sprite_c>7</sprite_c>
</header>

<pic_bmp>
<size>1613845</size>
... [BMP-Daten] ...

<sprite_list>
<count>2</count>
</sprite_list>

<sprite>
<header>
<name>Sprite 1</name>
...
</header>
<org_bmp>
<size>1613845</size>
... [BMP-Daten] ...

<sprite>
<header>
<name>Sprite 2</name>
...
</header>
<org_bmp>
<size>1613845</size>
... [BMP-Daten] ...

2.1.4.2. Stream-Verwaltung

Die Funktionen zur Verwaltung solcher "SPP"-Streams sind:

//-------------------------------------------------------
//read a complete tag-section out of stream
//
//a tag-section is build like in HTML-pages:
//
//<tag>....</tag>
//
//-------------------------------------------------------
function stream_tag_section_read(stream:TStream;tag:string):string;
const
  _max=10*1024;
var
  s,ss:string;
  tag_ok:bool;
  ch:char;
  c:integer;
begin
  //search beginning of tag-section
  tag_ok:=false;s:='';ss:='';c:=0;
  repeat
    stream.read(ch,1);
    s:=s+ch;

    //tag-start found?
    if not tag_ok then
      if pos('<'+tag+'>',s)>0 then
        tag_ok:=true;

    //if tag-flag set, save characters of string
    if tag_ok then ss:=ss+ch;
    inc(c);

    //end of tag-section found?
  until (pos('</'+tag+'>',s)>0)or(c>_max);

  //too much characters found?
  if c>_max then begin
    //yep: exit with error
    result:='-ERR';
    exit;
  end;

  //cut off some unnecessary chars
  s:=copy(ss,2,length(ss)-length(tag)-4);
  result:=s;
end;

Mit der Funktion "stream_tag_section_read" liefern wir einen string zurück, der einen kompletten Tag-Block umfasst. Dazu wird im übergebenen Stream "stream" nach der ebenfalls übergebenen Zeichenfolge von "tag" gesucht (eingerahmt von "<" und ">").

Wir diese gefunden, wird die boolesche Variable "tag_ok" auf "true" gesetzt. Ab jetzt fliessen aller weiteren Zeichen des Streams in den string "ss".

Der Stream wird so lange ausgelesen, bis das Tag erneut gefunden wird, diesmal aber umrahmt von "</" und ">". Ein Abbruch erfolgt zudem, wenn die Anzahl gelesener Bytes den Wert "_max" überschreitet. Das verhindert, dass Sprite-Painter auf der Suche nach nicht vorhandenen Tags in Streams eine kleine Ewigkeit benötigt.

Haben wir die Tag-Section komplett in "ss" stehen, wird zuletzt noch die Tag-Umrahmung abgeschnitten und als Ergebnis zurückgeliefert.

//get string-value of a special tag out of
//the string-tag-section 's'
function string_tag(section,tag,default:string):string;
var
  c:integer;
begin
  result:=default;
  c:=pos('<'+tag+'>',section);
  if c=0 then exit;
  s:=copy(section,c+length(tag)+2,length(section));
  c:=pos('</'+tag+'>',section);
  if c=0 then exit;
  result:=copy(section,1,c-1);
end;

//get integer-value of a special tag out of
//the string-tag-section 's'
function string_tag_int(
  section,tag:string;default:integer
):integer;
begin
  try
    result:=strtoint(
      string_tag(section,tag,inttostr(default))
    );
  except
    result:=default;
  end;
end;

//save a string in stream
procedure stream_write(stream:TStream;s:string);
begin
  stream.Writebuffer(s[1],length(s));
end;

Den Funktionen "string_tag" und "string_tag_int" wird eine Tag-Section "section" als string übergeben, und darin nach dem Tag "tag" gesucht. Wird es gefunden, wird dessen "Value" isoliert, in den richtigen Typ konvertiert und zurückgeliefert. Falls "tag" nicht in "section" auftaucht, wird "default" das Ergebnis sein.

Die Prozedur "stream_write" schreibt schliesslich einen beliebig langen string "s" in den Stream "stream".

2.1.4.3. "SPP"-Streams und die Windows-Ablage

"TFileStream" nutzen wir zum Abspeichern unserer Bilder auf Festplatte. In ganz ähnlicher Weise können wir "TMemoryStream" einsetzen, um Sprites in der Windows-Ablage zu speichern. Diese Funktionalität benötigen wir später für die Copy- & Paste-Operationen.

//copy a stream into clipboard, tagged as 'sprite-painter-picture'
procedure stream_clipboard_copy(fmt:Cardinal;stream:TStream);
var
  hMem:THandle;
  pMem:Pointer;
begin
  stream.Position:=0;

  hMem:=GlobalAlloc(GHND or GMEM_DDESHARE,stream.Size);
  if hMem=0 then begin
    application.MessageBox('out of memory','ERROR',mb_ok);
    exit;
  end;

  pMem:=GlobalLock(hMem);
  if pMem=nil then begin
    GlobalFree(hMem);
    application.MessageBox('out of memory','ERROR',mb_ok);
    exit;
  end;

  stream.read(pMem^,stream.Size);
  stream.Position:=0;
  GlobalUnlock(hMem);
  Clipboard.Open;
  try
    Clipboard.SetAsHandle(fmt,hMem);
  finally
    Clipboard.Close;
  end;
end;

//paste a stream from clipboard if tagged as 'sprite-painter-pic'
function stream_clipboard_paste(fmt:Cardinal;stream:TStream):bool;
var
  hMem:THandle;
  pMem:Pointer;
begin
  result:=false;
  hMem:=Clipboard.GetAsHandle(fmt);
  if hMem=0 then begin
    application.MessageBox(
      'Clipboard-GetHandle-Error','ERROR',mb_ok
    );
    exit;
  end;

  pMem:=GlobalLock(hMem);
  if pMem=nil then begin
    application.MessageBox(
      'Could not lock global handle','ERROR',mb_ok
    );
    exit;
  end;

  stream.write(pMem^,GlobalSize(hMem));
  stream.Position:=0;
  GlobalUnlock(hMem);
  result:=true;
end;

Sprite-Copy: Ein Sprite wurde im Freestyle-Modus generiert und anschliessend in die Windows-Ablage kopiert.

Sprite-Paste #1: Der zuvor in der Windows-Ablage abgelegte Sprite wurde in ein anderes Bild kopiert. Auch hier kann seine Position oder Grösse nachträglich beliebig variiert werden.

Sprite-Paste #2: Und weil es so schön war, gibt es Elisha hier gleich noch einmal in doppelter Ausfertigung. Von manchen Frauen kann man halt nie genug bekommen ...

2.2. Unit "bmp_u.pas": Kapselung von Echtfarben-Bitmaps

Wie bereits erwähnt, arbeitet Sprite-Painter ausschliesslich mit 24-Bit-Bitmaps zusammen. Der Zugriff darauf wird über die Klasse "TBMP" verwaltet, die in der unit "bmp_u.pas" abgelegt ist.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020

TBMP=class(TBitmap)
public
  ba:PByteArray; //ScanLine-pointer
  ba_y:integer;  //ScanLine-row

  constructor create;override;
  procedure clr;
  procedure size_set(w,h:integer);
  procedure fill_col(col:TColor);
  procedure fill_rgb_col(col:TRGBCol);
  function ba_set(y:integer):bool;

  function col_get(x:integer):TColor;
  function rgb_col_get(x:integer):TRGBCol;
  function col_set(x:integer;col:TColor):bool;
  function rgb_col_set(x:integer;rgb_col:TRGBCol):bool;
  function rec_no_rgb_col_count(
    rgb_col:TRGBCol;var rec:TRect
  ):int64;
end;

"TBMP" ist vom Delphi-Typ "TBitmap" abgeleitet und verfügt über ein paar Extra-Funktionen und -Variablen. Erzeugt wird eine "TBMP"-Bitmap wie eine gewöhnliche "TBitmap"-Bitmap, nur dass sie explizit auf 24-bit Farbtiefe gesetzt wird.

00001
00002
00003
00004
00005
00006
00007

constructor TBMP.create;
begin
  inherited;
  pixelformat:=pf24bit;
  ba_y:=-1;
  ba:=nil;
end;

Die folgenden Funktionen dienen zum Setzen der Grösse der Bitmap, zum Leeren derselben und zum Füllen mit einer bestimmten "TColor"- bzw. "TRGBCol"-Farbe:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028

procedure TBMP.size_set(w,h:integer);
begin
  if w<>width then Width:=w;
  if h<>height then height:=h;
end;

//free memory except some dummy pixels
procedure TBMP.clr;
begin
  size_set(10,10);
end;

//fill BMP with TColor-value
procedure TBMP.fill_col(col:TColor);
begin
  canvas.pen.width:=1;
  canvas.pen.color:=col;
  canvas.pen.style:=pssolid;
  canvas.Brush.color:=col;
  canvas.brush.style:=bssolid;
  rectangle(canvas.handle,0,0,width,height);
end;

//fill bmp with TRGBCol-value
procedure TBMP.fill_rgb_col(col:TRGBCol);
begin
  fill_col(rgb(col.r,col.g,col.b));
end;

2.2.1. Bitmap-Interna

Die nächste Funktion setzt den internen Byte-array-Zeiger "ba" auf eine bestimmte Zeile der Bitmap durch Verwendung der Bitmap-Funktion "ScanLine". Es wird dadurch auf einen Speicherbereich verwiesen, der eine komplette Zeile der 24-Bit-Bitmap enthält. Dieser Speicherbereich ist folgendermassen gefüllt:

00001
00002
00003
00004

Byte:   0 1 2 3 4 5 6 7 8 ... (BMP.width-1)*3 (BMP.width-1)*3+1 (BMP.width-1)*3+2
Farbe:  b g r b g r b g r ...        b               g                 r
        ----- ----- ----- ... ---------------------------------------------------
Pixel:    0     1     2                          BMP.width-1

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010

<p class='txt'>
function TBMP.ba_set(y:integer):bool;
begin
  result:=true;
  //if y is null get ScanLine every time
  if(y<>0)and(y=ba_y) then exit;
  ba:=ScanLine[y];
  //set ScanLine-row-parameter
  ba_y:=y;
end;

Um also einen "TRGBCol"- bzw. "TColor"-Farbwert an der Position "x" zu erhalten, muss man nur etwas rechnen. Und wissen, dass der blaue Farbwert "physikalisch" *vor* dem roten Farb-Wert liegt (verwirrend, nicht wahr? Nicht wundern! Ist bei PCs halt so. Einfach akzeptieren):

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014

//get pixel-color in trgb-format
function TBMP.rgb_col_get(x:integer):TRGBCol;
begin
  x:=x*3;
  result.r:=ba[x+2];
  result.g:=ba[x+1];
  result.b:=ba[x+0];
end;

//get pixel-color in TColor-format
function TBMP.col_get(x:integer):TColor;
begin
  result:=service_u.rgb_col2col(rgb_col_get(x));
end;

Um umgekehrt einen "TRGBCol"- bzw. "TColor"-Farbwert an der Position "x" zu setzen, kommen folgende Funktionen zum Einsatz:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013

function TBMP.rgb_col_set(x:integer;rgb_col:TRGBCol):bool;
begin
  x:=x*3;
  ba[x+2]:=rgb_col.r;
  ba[x+1]:=rgb_col.g;
  ba[x+0]:=rgb_col.b;
  result:=true;
end;

function TBMP.col_set(x:integer;col:TColor):bool;
begin
  result:=rgb_col_set(x,service_u.col2rgb_col(col));
end;

2.2.2. Ausschluss-Rectangle

Die letzte Funktion trägt einen zugegebenermassen blödsinnigen Namen. Mir ist nix besseres eingefallen. Sie liefert uns ein Rectangle innerhalb der Bitmap zurück, welches eine bestimmte Farbe *nicht* enthält.

//find a rect in the bitmap with
//no appearance of the color rgb_col
function TBMP.rec_no_rgb_col_count(
  rgb_col:TRGBCol;var rec:TRect
):int64;
var
  ba:PByteArray;
  x,y:integer;
begin
  result:=0;

  //fill rec width dummy-params
  rec:=rect(-1,-1,-1,-1);

  //check all rows of bitmap
  for y:=0 to height-1 do begin
    ba:=ScanLine[y];

    //check all pixels of ba
    for x:=0 to width-1 do begin

      //pixel-color is rgb_col? then ignore it
      if(
        ba[x*3+2]=rgb_col.r)and
        (ba[x*3+1]=rgb_col.g)and
        (ba[x*3]=rgb_col.b
      )then continue;

      //no, it's another color
      inc(result);

      //calculate new rectangle-values
      if (x<rec.left)or(rec.left=-1)then
        rec.left:=x;
      if (y<rec.top)or(rec.top=-1)then
        rec.top:=y;

      if (x>rec.right)or(rec.right=-1)then
        rec.right:=x;
      if (y>rec.bottom)or(rec.bottom=-1)then
        rec.bottom:=y;
    end;
  end;

  //color rgb_col not found?
  if result=0 then exit;

  //adjust right and bottom of rec
  rec.right:=rec.right+1;
  rec.bottom:=rec.bottom+1;
end;

Wie wir später sehen werden, benötigen wir diese merkwürdige Funktion, um überflüssige transparente Bereiche aus einer Bitmap, sprich, einem Sprite, herauslösen zu können.

2.3. Unit "selection_u.pas": Klasse zur Selektion-Steuerung

Mit Selektionen sind im Sprite-Painter ausgewählte Bildbereiche gemeint, die sich als Pinsel verwenden lassen. Als Ergebnis einer Mal-Aktion mit einer solchen "TSelection" erhält man dann jeweils einen neuen "TSprite" zurück, der auf das Original-Bild abgelegt wird.

Insofern ist der Name "Sprite-Painter" eigentlich irreführend. Wir malen nämlich nicht mit den Sprites, sondern eigentlich mit Selektionen *auf* Sprites.

2.3.1. Selektionsablauf

(1) Selektion der Region: Mit der Maus wird ein Bildbereich umrandet. Nach Abschluss dieser Arbeiten wird die boolesche Variable "range_ok" auf "true" gesetzt und der Bildausschnitt in "bmp" und "org_bmp" gesichert.

(2) Positionierung der Selektion: Die Selektion kann nun mit Maus verschoben oder in ihrer Grösse geändert werden. Wird bei einer Verschiebe-Aktion gleichzeitig die STRG-Taste gedrückt, wird die Selektion permanent auf eine spezielle "sprite_bmp" "durchgepaust".

(3) Malen auf Sprite: Nach der Mal-Aktion wird die "sprite_bmp" verwendet, um daraus einen "TSprite" zu generieren, der ähnlich wie eine "TSelection" verschoben und in der Grösse verändert werden kann. Malen kann man damit allerdings nicht mehr.

2.3.2. Deklaration

Die Klasse "TSelection" fällt recht umfangreich aus. Sie wird in der unit "selection_u.pas" folgendermassen deklariert:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032

TSelection=class(tobject)
  range_ok:bool;
  rec:TRect;
  style:TSelection_style;
  bmp:TBMP;
  org_bmp:TBMP;

  border_outer_col:TColor;
  border_inner_col:TColor;

  mouse_click_pt:tpoint;
  mouse_hit_left_ok:bool;
  mouse_hit_top_ok:bool;

  merge_style:tmerge_style;
  transparency:byte;

  to_sprite_ok:bool;

  constructor create;
  destructor destroy;override;

  procedure MouseDown(
    Button:TMouseButton;Shift:TShiftState;X,Y:Integer
  );
  procedure MouseMove(Shift:TShiftState;X,Y:Integer);
  procedure MouseUp(
    Button:TMouseButton;Shift:TShiftState;X,Y:Integer
  );

  [...]
end;

2.3.3. Implementierung

"TSelection" ist abgeleitet vom Delphi-Typ "TObject". Dadurch verfügt die Klasse über eine Reihe Standard-Methoden wie "Create" und "Destroy". Wir überschreiben diese, um dadurch ein paar Zusatzfunktionen auszuführen.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018

constructor TSelection.create;
begin
  inherited;
  org_bmp:=TBMP.create;
  bmp:=TBMP.create;
  merge_style:=ms_always;
  style:=ss_rectangle;
  to_sprite_ok:=false;
  border_outer_col:=clblack;
  border_inner_col:=clwhite;
end;

destructor TSelection.destroy;
begin
  org_bmp.Free;
  bmp.Free;
  inherited;
end;

2.3.4. Zwei Bitmaps für Resizing-Aktionen

In der "TBMP"-Bitmap "org_bmp" wird der ursprünglich ausgewählte Bildbereich gesichert. Tatsächlich auf dem Bildschirm angezeigt wird jedoch die zweite "TBMP"-Bitmap "bmp". So lange die Ausmasse der Selektion nicht verändert wurden, entspricht "bmp" exakt "org_bmp". Warum wir überhaupt mit zwei Bitmaps arbeiten, sehen wir bei der "rec_set"-Prozedur:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031

//---------------------------------------------------------
function TSelection.rec_norm(arec:TRect):TRect;
var
  rec:TRect;
begin
  rec.left:=min(arec.left,arec.Right);
  rec.top:=min(arec.top,arec.bottom);
  rec.right:=max(arec.left,arec.Right);
  rec.bottom:=max(arec.top,arec.bottom);
  if (rec.Right-rec.left)=0 then rec.Right:=rec.Right+1;
  if (rec.bottom-rec.Top)=0 then rec.bottom:=rec.bottom+1;
  result:=rec;
end;

//---------------------------------------------------------
procedure TSelection.rec_set(new_rec:TRect);
begin
  rec:=rec_norm(new_rec);

  if not range_ok then exit;

  if(rec_width=bmp.width)and(rec_height=bmp.height)then exit;

  bmp.size_set(rec_width,rec_height);
  SetStretchBltMode(bmp.canvas.handle,coloroncolor);
  stretchblt(
    bmp.Canvas.Handle,0,0,bmp.width,bmp.height,
    org_bmp.canvas.Handle,0,0,org_bmp.width,org_bmp.height,
    srccopy
  );
end;

Die Grösse einer "TSelection" kann vom Benutzer verändert werden. Damit gehen jedoch eventuell Pixelverluste in "bmp" einher, etwa wenn das Bild verkleinert wird. Würde man eine solche "bmp" wieder direkt auf Originalgrösse hochziehen, wäre sie nicht mehr identisch zum Originalbild "org_bmp". Durch Verwendung der Original-Bitmap als Basis aller Resize-Aktionen kann dieses unerwünschte Verhalten unterbunden werden.

Resize mit nur einer Bitmap: Ein Sprite wurde unter Verwendung von nur einer internen Bitmap mehrfach in der Grösse verändert. Das Result weicht deutlich vom Originalausschnitt ab. Und Michelles Attraktivität hat dabei doch arg gelitten.

Die Funktion "rec_norm" sorgt zudem dafür, dass der Koordinatenpunkt "left/top" im Rahmen-Rectangle "rec" stets kleiner ist als "right/bottom". Das verhindert negative Werte bei der Höhen- und Breitenberechnung der Selektion, die ebenfalls für allerlei Ärger sorgen könnten.

2.3.5. Maus-Ereignisse

Selektionen reagieren auf Maus-Ereignisse. Dadurch kann man sie mit der Maus aus dem Untergrundbild quasi "herausschneiden". Dies wiederum bewirkt, dass die boolesche Variable "range_ok" auf "true" gesetzt wird. Jetzt wechselt das Verhalten der Selektion: Ab sofort kann sie mit der Maus verschoben und in ihrer Grösse verändert werden.

Alle Maus-Ereignisse werden von der PaintBox der Hauptform, die das sichtbare Bild enthält, an "TSelection" durchgereicht, sofern wir uns im Selektionsmodus befinden (dazu später mehr).

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025

//------------------------------------------------
function TSelection.hit(x,y:integer):bool;
begin
  result:=
    (x>=rec.left)and(x<rec.right)and
    (y>=rec.top)and(y<rec.bottom);
end;

//------------------------------------------------
procedure TSelection.MouseDown(
  Button:TMouseButton;Shift:TShiftState;X,Y:Integer
);
begin
  if not range_ok then begin
    //neue range beginnen
    new_start(x,y);
    exit;
  end;

  //range nicht getroffen: mit false raus
  if not hit(x,y) then exit;

  main_f.Cursor_set(cursor_get(x,y));
  mouse_click_pt:=point(x-rec.left,y-rec.top);
end;

Auf die PaintBox der Hauptform wurde geklickt. Das Ereignis landet bei "TSelection.MouseDown". Hier wird zuerst geprüft, ob bereits eine Region definiert wurde ("range_ok"). Ist dem nicht so, wird über die Prozedur "new_start" eine neue Regions-Selektion gestartet.

Liegt die Region dagegen bereits vor, wird geprüft, ob der Maus-Cursor innerhalb derselben gelandet ist. Das lässt sich in der Funktion "hit" über die "TRect"-Variable "rec" ermitteln, welche stets die maximalen Ausmasse der Selektion angibt.

Wurde daneben geklickt, dann ignorieren wir das Ereignis einfach. Ansonsten merken wir uns die exakte Klick-Position in der "TPoint"-Variable "mouse_click_pt".

2.3.5.1. Cursor-Setting

Die Funktion "cursor_get" liefert uns im Übrigen den passenden Mauszeiger zurück, der sich am Rahmen der "TSelection" orientiert:

function TSelection.cursor_get(x,y:integer):tcursor;
var
  q,dw,dh:integer;
  l,t,r,b:integer;
  d:double;
begin
  result:=crdefault;
  if not hit(x,y)then exit;

  q:=10;
  l:=rec.left;
  t:=rec.top;
  r:=rec.right;
  b:=rec.bottom;

  //calculate half
  d:=l+((r-l)-q)/2;dw:=round(d);
  d:=t+((b-t)-q)/2;dh:=round(d);

  //got left or right border?
  mouse_hit_left_ok:=(x<l+q);

  //got top or bottom border?
  mouse_hit_top_ok:=(y<t+q);

  //got a 'size-corner'?
  if (x<l+q)and(y<t+q) then
    result:=crSizeNWSE //oben links
  else if (x>dw-q)and(x<dw+q)and(y<t+q) then
    result:=crSizeNS   //oben Mitte
  else if (x>=r-q)and(y<t+q) then
    result:=crSizeNESW //oben rechts

  else if(x>=r-q)and(y>dh-q)and(y<dh+q)then
    result:=crSizeWE   //Mitte rechts
  else if(x>=r-q)and(y>=b-q) then
    result:=crSizeNWSE //unten rechts

  else if(x>dw-q)and(x<dw+q)and(y>=b-q)then
    result:=crSizeNS   //unten Mitte

  else if(x<l+q)and(y>=b-q) then
    result:=crSizeNESW //unten links
  else if(x<l+q)and(y>dh-q)and(y<dh+q) then
    result:=crSizeWE   //Mitte links

  else result:=crSizeAll; //nein
end;

Eine fertige Selektion erhält einen Rahmen mit den in "rec" abgelegten Koordinaten. Befindet sich die Maus ausserhalb von diesem Bereich, wird sie ignoriert ("result:=crdefault;"). Befindet sie sich über bestimmten Randpunkten, ändert sich der Cursor in passender Weise, um den Benutzer zu verdeutlichen, dass er nun die Grösse der Selektion ändern kann. Ansonsten nimmt der Cursor den Wert "crSizeAll" an; die Selektion kann vom Benutzer verschoben werden.

2.3.5.2. Maus über "TSelection"

//-------------------------------------------------
function TSelection.is_sprite:bool;
begin
  result:=(border_outer_col=clteal);
end;

//-------------------------------------------------
procedure TSelection.MouseMove(
  Shift:TShiftState;X,Y:Integer
);
begin
  if not main_f.mouse_down_ok then begin
    main_f.cursor_set(cursor_get(x,y));
    exit;
  end;

  if not range_ok then begin
    //neue range erweitern
    new_change(x,y);
    exit;
  end;

  //range existiert bereits

  //range nicht getroffen: mit false raus
  if(main_f.cursor=crdefault)and not hit(x,y) then begin
    exit;
  end;

  if      main_f.cursor=crsizeall  then moving(x,y)
  else if main_f.cursor<>crdefault then sizing(x,y);

  //dont paint with sprites
  if is_sprite then exit;

  //direkt durchpausen?
  if not main_f.selection_to_sprite_chb.checked then begin
    if not(ssctrl in shift) then exit;
  end;

  //neustart vom durchmalen?
  if not to_sprite_ok then to_sprite_start;

  to_sprite_paint;
end;

Bewegt sich die Maus über der PaintBox, wird in "TSelection.MouseMove" zuerst geprüft, ob die linke Maustaste gedrückt ist. Ist dem nicht so, wird die Prozedur "cursor_set" der Hauptform aufgerufen. Dies bewirkt, dass der Mauszeiger sich ändert, wenn er über einer Selektion oder einer ihrer "Änderungspunkte" steht. Der Benutzer erkennt dadurch, dass sich z.B. die Selektion an dieser Stelle in ihrer Grösse ändern lässt.

Wurde die Maustaste gedrückt und es liegt keine vollständige Region vor, dann wird die Prozedur "new_change" aufgerufen. Danach die Prozedur verlassen.

Ansonsten prüfen wir, ob die Maus sich aktuell über der Selektion befindet. Wenn nicht, geht es raus. Zu beachten ist hier, dass wir dabei zusätzlich den "Screen.Cursor" überprüfen müssen. Ist der nämlich *nicht* der Standard--Mauszeiger, dann gilt es womögliche eine Resize-Aktion auszuführen - denn dabei muss sich der Mauszeiger ja zwangsläufig ausserhalb der aktuellen "rec"-Dimension bewegen (zumindest beim Vergrössern)!

Der "screen.cursor" verrät uns dann im nächsten Schritt auch, wie weiter mit der Selektion verfahren werden soll: Entweder sie wird nun auf der PaintBox verschoben ("moving") oder eben vergrössert/verkleinert ("sizing"). Dazu später mehr.

Die kleine Funktion "is_sprite" prüft lediglich, ob die Selektion auch ein "Sprite" ist. Wir wir später sehen werden, ist "TSprite" von "TSelection" abgeleitet. Sie weisen ein sehr ähnliches Verhalten auf. Im Falle einer Sprites muss ab dieser Stelle jedoch nichts mehr erledigt werden und wir verlassen die Prozedur.

2.3.5.3. Durchpausen oder nicht?

Bei einer "TSelection" checken wir jetzt noch, ob "to_sprite_ok" aktiv ist. Wenn ja, bedeutet das, dass die Änderung an der Selektion direkt auf eine spezielle Bitmap "durchgepaust" werden ("to_sprite_start" und "to_sprite_paint"). Darum kümmern wir uns später.

Durchpausen auf Sprite-Bitmap: Änderungen an der Selektion, etwa Verschiebe-Aktionen, können unmittelbar auf die Bitmap "sprite_bmp" durchgepaust werden. Dadurch wird die Selektion praktisch als Pinsel eingesetzt.

2.3.5.4. End of Mouse-Action

Okay, was passiert, wenn man eine Maustaste gedrückt hat? Man lässt sie irgendwann auch wieder los. Das bewirkt den Aufruf der "MouseUp"-Prozedur von "TSelection".

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028

//--------------------------------------------------
procedure TSelection.clear;
begin
  rec:=rect(0,0,0,0);
  range_ok:=false;
end;

//--------------------------------------------------
procedure TSelection.MouseUp(
  Button:TMouseButton;Shift:TShiftState;X,Y:Integer
);
begin
  if is_sprite then exit;

  if button=mbright then begin
    //loesche range
    clear;
    exit;
  end;

  if not range_ok then begin
    //neue range abschliessen
    new_end;
    exit;
  end;

  if to_sprite_ok then to_sprite_end;
end;

Bei einem Rechts-Klick wird die aktuelle Selektion gelöscht ("clear").

Bei einem Links-Klick wird entweder die Region-Selektion abgeschlossen (wenn "range_ok" noch nicht gesetzt ist). Oder aber eventuell durchgeführte Sprite-Mal-Operationen abgeschlossen ("to_sprite_end").

2.3.6. Region-Selektion-Handling

Wir haben den wichtigen Parameter "range_ok" bereits kennengelernt. Er gibt an, ob eine bestimmte Region aus dem Untergrund bereits für die "TSelection" definiert wurde oder nicht. Abgearbeitet wird diese Region-Selektion über die drei Prozeduren "new_start", "new_change" und "new_end". Schauen wir uns die jetzt der Reihe nach an.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021

procedure TSelection.new_start(x,y:integer);
begin
  clear;
  if main_f.selection_style_rectangle_rb.checked then
    style:=ss_rectangle
  else if main_f.selection_style_ellipse_rb.checked then
    style:=ss_ellipse
  else
    style:=ss_freestyle;

  //start rectangle
  rec:=rect(x,y,x+1,y+1);

  //not freestyle? nothing more to do
  if style<>ss_freestyle then exit;

  main_f.freestyle_c:=0;
  main_f.freestyle_a[main_f.freestyle_c].x:=x;
  main_f.freestyle_a[main_f.freestyle_c].y:=y;
  rec_set(rec);
end;

Die Prozedur "new_start" wird beim Maus-Ereignis "MouseDown" aufgerufen, wenn eine neue Region-Selektion begonnen wird. Die Selektion wird zuerst initialisiert ("clear"). Anschliessend wird der vom Benutzer gewünschte Selection-Style ermittelt. Im Falle einer "Freestyle"-Selektion merken wir uns zusätzlich die aktuelle Klick-Position als ersten Array-Wert in "freestyle_a".

2.3.6.1. Laufende Änderungen

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027

procedure TSelection.new_change(x,y:integer);
var
  new_rec:TRect;
begin
  if style=ss_freestyle then begin
    //index for new point
    inc(main_f.freestyle_c);

    //put point in array
    main_f.freestyle_a[main_f.freestyle_c].x:=x;
    main_f.freestyle_a[main_f.freestyle_c].y:=y;

    //calculate new selection-rectangle
    new_rec.left:=min(rec.left,x);
    new_rec.top:=min(rec.top,y);
    new_rec.right:=max(rec.right,x);
    new_rec.bottom:=max(rec.bottom,y);
  end
  else begin
    new_rec:=rec;
    new_rec.right:=x;
    new_rec.bottom:=y;
  end;

  rec_set(new_rec);
  main_f.pb_update(true);
end;

Die Prozedur "new_change" wird beim Maus-Ereignis "MouseMove" aufgerufen, wenn die linke Maus-Taste gedrückt und "range_ok" ungesetzt ist. Wir merken uns hier in der "rec"-Variable stets die äusseren Dimensionen der aufgezogenen Region-Selektion. Im Falle einer Freestyle-Selektion notieren wir zudem alle neuen Eckpunkte im array "freestyle_a".

2.3.6.2. Region-Selektion abschliessen

Der Abschluss einer Region-Selektion ist etwas umfangreicher. Er wird beim "MausUp"-Ereignis ausgelöst. Der vom Benutzer ausgewählte Region-Bildbereich wird hier in die Bitmap "org_bmp" kopiert. Das ist insofern nicht ganz trivial, da es transparente Bereiche geben kann, die in der Bitmap auch als solche kenntlich gemacht werden müssen, indem die Pixel an der entsprechenden Stelle die Farbe "transp_rgb_col" erhalten.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096

//-------------------------------------------------------
function TSelection.rec_width:integer;
begin
  result:=rec.right-rec.left;
end;

//-------------------------------------------------------
function TSelection.rec_height:integer;
begin
  result:=rec.bottom-rec.top;
end;

//-------------------------------------------------------
procedure TSelection.new_end;
var
  src:TBMP;
  mask_bmp:TBMP;
  x,y:integer;
  rgb_col:TRGBCol;
  r:integer;
begin
  try

    //Groesse der Ziel-Bitmap
    bmp.size_set(rec_width,rec_height);

    if main_f.selection_src_org_rb.checked then
      src:=main_f.pic_bmp
    else begin
      main_f.pb_update(false);
      src:=main_f.preview_bmp;
    end;

    //Rectangle einfach kopieren
    if style=ss_rectangle then begin
      bitblt(
        bmp.canvas.Handle,0,0,bmp.width,bmp.Height,
        src.Canvas.Handle,rec.left,rec.top,
        srccopy
      );
      exit;
    end;

    mask_bmp:=TBMP.create;
    try
      mask_bmp.size_set(rec_width,rec_height);
      mask_bmp.fill_rgb_col(main_f.transp_rgb_col);
      mask_bmp.canvas.pen.color:=clblack;
      mask_bmp.canvas.brush.color:=clblack;
      mask_bmp.canvas.brush.style:=bssolid;

      if style=ss_ellipse then begin
        mask_bmp.canvas.ellipse(rect(0,0,rec_width,rec_height));
      end
      else begin
        //calculate relative position
        for r:=0 to main_f.freestyle_c do begin
          main_f.freestyle_a[r].x:=main_f.freestyle_a[r].x-rec.left;
          main_f.freestyle_a[r].y:=main_f.freestyle_a[r].y-rec.top;
        end;
        mask_bmp.canvas.Polygon(
          slice(main_f.freestyle_a,main_f.freestyle_c)
        );
      end;

      //set src- and transparent-pixel
      for y:=0 to mask_bmp.height-1 do begin
        src.ba_set(y+rec.top);
        mask_bmp.ba_set(y);
        bmp.ba_set(y);
        for x:=0 to mask_bmp.width-1 do begin
          if mask_bmp.col_get(x)=clblack then
            rgb_col:=src.rgb_col_get(x+rec.left)
          else
            rgb_col:=main_f.transp_rgb_col;
          bmp.rgb_col_set(x,rgb_col);
        end;
      end;

    finally
      mask_bmp.Free;
    end;

  finally
    main_f.freestyle_c:=0;
    merge_style:=tmerge_style(
      main_f.selection_merge_style_cb.ItemIndex
    );
    transparency:=
      main_f.selection_transparency_sb.Position;
    range_ok:=true;
    org_bmp.assign(bmp);
    rec_set(rec);
    main_f.pb_update(true);
  end;
end;

Okay, die nötige Grösse der Bitmap "org_bmp" erhalten wir relativ einfach durch das Rectangle "rec", welches wir ja in eben in der Prozedur "new_change" permanent an die aktuelle Benutzer-Region-Auswahl angepasst haben.

2.3.6.3. Basis der Selektion

Anschliessend stellen wir fest, was als Bild-Basis ("src") für den Ausschnitt dienen soll: Das originale Hintergrundbild ("main_f.pic_bmp") oder aber das aktuell angezeigte Bild samt aller bis dato eingefügten Änderungen ("main_f.preview_bmp")?

Das folgende Bild verdeutlicht den Unterschied:

Basis der Region-Selektion: Links wurde die Selektion vom Original-Bild genommen, wodurch der gemalte Sprite auf dem Untergrund ignoriert wird (dadurch kann man bis auf die unterste Bildebene "hinunterschauen"). Rechts dagegen, bei der Selektion vom aktuellen Bild, wurde er mitkopiert.

2.3.6.4. Maskierte Transparenz

Im Falle einer Rectangle-Selektion gibt es keine transparenten Bereiche. Das macht es uns einfach: Wir kopieren mit der "BitBlt"-API-Funktion den gewählten Ausschnitt direkt in "bmp" hinein (und im "finally"-Part auch noch in "org_bmp").

Ansonsten müssen - wie erwähnt - die transparenten Bereiche kenntlich gemacht werden.

Bei der Ellipse-Selektion malen wir dazu eine schwarz ausgefüllten Ellipse auf die Hilfsbitmap "mask_bitmap". Bei der Freestyle-Selektion nutzen wir die Canvas-Funktion "polygon" und das array "freestyle_a", um ähnliches zu erreichen, wobei wir die Canvas-Prozedur "polygon" verwenden. Die dabei ebenfalls eingesetzte Funktion "slice" sorgt übrigens dafür, dass nur die ersten "freestyle_c" Punkte des Arrays Beachtung finden; der Rest wird ignoriert.

Als Ergebnis dieser Operation erhalten wir in "mask_bmp" einen Art Schattenriss der Benutzer-Selektion.

Im letzten Schritt wird diese "Schattenriss"-Bitmap Pixel für Pixel durchlaufen. Überall dort, wo schwarze Pixel zu finden sind, werden die korrespondierenden Bildpunkte aus "src" geholt und in passend "bmp" eingefügt. Ansonsten wird ein transparenter Punkt vergeben.

Die folgenden Bilder verdeutlichen den Ablauf noch einmal:

Abschluss einer Region-Selektion: Eine Freestyle-Selektion wurde vorgenommen. (1) entspricht "pic_bmp". (2) entspricht "mask_bmp". (3) entspricht "bmp". (4) zeigt die resultierende Selektion über dem Originalbild.

2.3.6.5. Positionierung

Okay, die Region-Selektion ist durchgeführt, "rec" enthält die Koordinaten, "bmp" und "org_bmp" den gewählten Bildausschnitt.

Wie wir bei den Maus-Ereignissen gesehen haben, kann eine fertige "TSelection" verschoben und in ihrer Grösse geändert werden. Schauen wir uns zuerst das Verschieben an, welches über die Prozedur "moving" realisiert wird:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017

procedure TSelection.moving(x,y:integer);
var
  w,h:integer;
  tmp_rec:TRect;
begin
  w:=rec_width;
  h:=rec_height;

  tmp_rec.left:=x-mouse_click_pt.x;
  tmp_rec.top:=y-mouse_click_pt.y;

  tmp_rec.right:=tmp_rec.left+w;
  tmp_rec.bottom:=tmp_rec.top+h;

  rec_set(tmp_rec);
  main_f.pb_update(true);
end;

In der "MouseDown"-Prozedur haben wir uns die Klick-Position in "mouse_click_pt" gemerkt. Hier berechnen wir nun, wie weit der Benutzer seitdem den Maus-Zeiger bewegt hat. In Abhängigkeit davon ändern wir die Koordinatenpunkte eines temporären Rectangles. Dieses wird schliesslich an die Prozedur "set_rec" übergeben, wo die berechneten Koordinaten im Koordinaten-Rectangle "rec" übernommen werden. Zuletzt sorgt der Aufruf von "pb_update" dafür, dass die "TSelection" auf der PaintBox der Hauptform an neuer Stelle ausgeben wird.

2.3.6.6. Grössenänderung

Ändert der Benutzer dagegen die Grösse einer Selektion, wird in "MouseMove" die Prozedur "sizing" angesteuert:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026

procedure TSelection.sizing(x,y:integer);
var
  tmp_rec:TRect;
begin
  tmp_rec:=rec;
  if main_f.cursor=crSizeWE then begin
    //got left or right border?
    if mouse_hit_left_ok then tmp_rec.left:=x
                         else tmp_rec.right:=x;
  end
  else if main_f.cursor=crSizeNS then begin
    //got top or bottom border?
    if mouse_hit_top_ok then tmp_rec.top:=y
                        else tmp_rec.bottom:=y;
  end
  else begin
    if mouse_hit_left_ok then tmp_rec.left:=x
                         else tmp_rec.right:=x;

    if mouse_hit_top_ok then tmp_rec.top:=y
                        else tmp_rec.bottom:=y;
  end;

  rec_set(tmp_rec);
  main_f.pb_update(true);
end;

Je nachdem, wo sich der Maus-Zeiger gerade über der "TSelection" befindet, wurde in "MouseMove" bereits ein passender Maus-Zeiger gesetzt. Die booleschen Variablen "mouse_hit_left_ok" und "mouse_hit_top_ok" geben darüber hinaus Auskunft, ob der linke Rand (statt dem rechten) und/oder der obere Rand (statt dem unteren) mit dem Maus-Zeiger "berührt" wurde.

Ähnlich wie beim "moving" wird mit diesen Daten nun ein temporäres Rectangle neu berechnet, an "rec_set" übergeben und zuletzt per "pb_update" auf dem Bildschirm ausgegeben.

Grössenänderung einer Selektion: Der Benutzer hat mit der Maus den gewählten Ausschnitt vergrössert und dabei verzerrt. Rose ist dabei offenbar ganz schön breit geworden ...

2.3.7. Malen auf die Sprite-Bitmap

Eine "TSelection" ist vorhanden und kann mit der Maus manipuliert werden.

Drückt man dabei gleichzeitig die "STRG"-Taste, werden alle Modifikationen in Echtzeit auf die Bitmap "sprite_bmp" durchgereicht. Die dafür nötigen Prozeduren "to_sprite_start", "to_sprite_paint" und "to_sprite_end" werden dazu bei den Maus-Ereignissen passend aufgerufen.

Bei einem Doppel-Klick auf die "TSelection" etwa werden alle drei "to_sprite"-Prozeduren direkt hintereinander aufgerufen:

00001
00002
00003
00004
00005
00006
00007

procedure TSelection.dblclick;
begin
  if is_sprite then exit;
  to_sprite_start;
  to_sprite_paint;
  to_sprite_end;
end;

Doppel-Klick-Sprites: Eine Selektion lässt sich durch einen Doppel-Klick in einen Sprite transformieren. Und zwar beliebig oft. Im obigen Beispiel entspricht Ashleys Gesicht jedes Mal einem eigenständigem Sprite - bis auf das der Originalversion des Hintergrundbildes.

2.3.7.1. Initialisierung

Schauen wir und zunächst an, was bei "to_sprite_start" passiert.

00001
00002
00003
00004
00005
00006
00007
00008

procedure TSelection.to_sprite_start;
begin
  main_f.sprite_bmp.size_set(
    main_f.preview_bmp.width,main_f.preview_bmp.height
  );
  main_f.sprite_bmp.fill_rgb_col(main_f.transp_rgb_col);
  to_sprite_ok:=true;
end;

Als erste Massnahme wird die Bitmap "sprite_bmp" in ihrer Grösse gleichgesetzt mit der "preview_bmp", die das aktuell angezeigte Bild enthält.

Die "sprite_bmp" wird quasi geleert, indem sie komplett mit der Farbe "transp_rgb_col" gefüllt wird. Wie wir später noch sehen werden, werden Pixel mit dieser Farbe bei der Anzeige komplett ignoriert.

Zuletzt wird der boolesche Parameter "to_sprite_ok" auf "true" gesetzt.

2.3.7.2. Durchpausen aller Modifikationen

Wie eben gesehen, wird in "to_sprite_start" die Variable "to_sprite_ok" aktiviert. In "MouseMove" wird damit auch bei jedem Aufruf erneut die Prozedur "to_sprite_paint" angesteuert.

procedure TSelection.to_sprite_paint;
var
  x,y:integer;
  sprite_y,sprite_x:integer;
  rgb_col:TRGBCol;
begin
  if style=ss_rectangle then begin
    bitblt(
      main_f.sprite_bmp.Canvas.Handle,
      rec.left,rec.top,rec_width,rec_height,
      bmp.canvas.Handle,0,0,
      srccopy
    );
    exit;
  end;

  for y:=0 to bmp.height-1 do begin
    sprite_y:=y+rec.top;
    if sprite_y<0 then continue;
    if sprite_y>main_f.sprite_bmp.height-1 then break;

    main_f.sprite_bmp.ba_set(sprite_y);
    bmp.ba_set(y);

    for x:=0 to bmp.width-1 do begin
      sprite_x:=x+rec.left;
      if sprite_x<0 then continue;
      if sprite_x>main_f.sprite_bmp.width-1 then continue;

      rgb_col:=bmp.rgb_col_get(x);

      if main_f.is_transp_rgb_col(rgb_col)then continue;

      main_f.sprite_bmp.rgb_col_set(sprite_x,rgb_col);
    end;
  end;
end;

Hier stellen wir zuerst fest, ob eine Selektion vom Typ "ss_rectangle" vorliegt. Ist dem so, kopieren wir unsere Selektion, die in Bitmap "bmp" gespeichert ist, direkt auf die Bitmap "sprite_bmp". Und zwar an genau der Positionen, an der wir uns gerade befinden.

Bei einer Ellipse- oder Freestyle-Selektion muss die Bitmap "bmp" pixelweise durchlaufen werden, weil es hier ja transparente Punkte geben kann, die nicht auf die "sprite_bmp" kopiert werden dürfen. Diese transparenten Punkte erkennen wir anhand des Rückgabewertes der Funktion "is_transparent", die in der unit "main_u.pas" definiert ist (siehe weiter unten).

Durchgepauste Grössenänderung: Noch während die Selektion in in ihrer Grösse geändert wird, füllt sich die "sprite_bmp" in Echtzeit mit diesen Modifikation.

2.3.8. Und zum Schluss die eigentliche Sprite-Generierung

Befinden wir uns im "to_sprite_ok"-Modus und die Maustaste wird wieder losgelassen, landen wir in der "to_sprite_end":

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010

procedure TSelection.to_sprite_end;
var
  sprite:TSprite;
begin
  to_sprite_ok:=false;
  sprite:=TSprite.create;
  sprite.assign(self);
  main_f.sprite_lb.ItemIndex:=sprite_list_u.add(sprite);
  main_f.pb_update(true);
end;

Hier wird eine neue Instanz vom Typ "TSprite" erzeugt ("TSprite.create"). Über die Methode "assign" wird die eben gefüllte "sprite_bmp" in diese Sprite-Instanz integriert. Das sehen wir uns in der folgenden Unit "sprite_u.pas" gleich näher an. Ausserdem erfährt die ListBox "lb" von dem neuen Objekt ("sprite_list_u.add"). Und ganz zuletzt wird noch das angezeigte Bild mittels "pb_update" auf aktuellen Stand gebracht.

2.3.8.1. Koordinaten-Rahmen

Wird eine Selektion neu gebildet bzw. besteht bereits, wird sie mit einem Rahmen versehen. Nur so kann der Benutzer überhaupt erkennen, wo genau sich die Selektion befindet. Gemalt wird dieser Rahmen mithilfe der Prozedur "border":

procedure TSelection.border;
var
  cv:tcanvas;
  l,t,w,h:integer;
  hit_quad:byte;
  pt,prev_pt:tpoint;
  r:integer;
begin
  if
    not range_ok and(style=ss_freestyle)and
    (main_f.freestyle_c>0)
  then begin
    cv:=main_f.preview_bmp.canvas;
    cv.brush.style:=bsclear;
    cv.pen.width:=1;
    pt:=main_f.freestyle_a[0];
    cv.MoveTo(pt.x,pt.y);
    prev_pt:=pt;
    for r:=1 to main_f.freestyle_c do begin
      pt:=main_f.freestyle_a[r];
      cv.pen.Color:=border_outer_col;
      cv.lineTo(pt.x,pt.y);
      cv.MoveTo(prev_pt.x+1,prev_pt.y+1);
      cv.pen.Color:=border_inner_col;
      cv.lineTo(pt.x+1,pt.y+1);
      cv.MoveTo(pt.x,pt.y);
      prev_pt:=pt;
    end;
    pt:=main_f.freestyle_a[0];
    cv.lineTo(pt.x,pt.y);
    exit;
  end;

  l:=rec.left;t:=rec.top;
  w:=rec.right-rec.left;h:=rec.Bottom-rec.top;
  if(w=0)or(h=0)then exit;

  cv:=main_f.preview_bmp.canvas;

  //Aussenrahmen
  cv.brush.style:=bsclear;
  cv.Pen.color:=border_outer_col;
  rectangle(cv.Handle,l,t,l+w,t+h);

  //Innenrahmen
  cv.Pen.color:=border_inner_col;
  rectangle(cv.Handle,l+1,t+1,l+w-1,t+h-1);

  //hit-points
  cv.Pen.color:=border_outer_col;
  cv.Brush.color:=border_inner_col;
  cv.Brush.Style:=bssolid;

  hit_quad:=10;

  //hits oben
  cv.Rectangle(l,t,l+hit_quad,t+hit_quad);
  cv.Rectangle(
    l+(w-hit_quad)div 2,t,l+(w+hit_quad)div 2,t+hit_quad
  );
  cv.Rectangle(l+w-hit_quad,t,l+w,t+hit_quad);

  //hits links und rechts
  cv.Rectangle(
    l,t+(h-hit_quad)div 2,l+hit_quad,t+(h+hit_quad)div 2
  );
  cv.Rectangle(
    l+w-hit_quad,t+(h-hit_quad)div 2,l+w,t+(h+hit_quad)div 2
  );

  //hits unten
  cv.Rectangle(l,t+h-hit_quad,l+hit_quad,t+h);
  cv.Rectangle(
    l+(w-hit_quad)div 2,t+h-hit_quad,l+(w+hit_quad)div 2,t+h
  );
  cv.Rectangle(l+w-hit_quad,t+h-hit_quad,l+w,t+h);

  if style<>ss_ellipse then exit;

  //Ellipse Aussenrahmen
  cv.brush.style:=bsclear;
  cv.Pen.color:=border_outer_col;
  ellipse(cv.Handle,l,t,l+w,t+h);

  //Ellipse Innenrahmen
  cv.Pen.color:=border_inner_col;
  ellipse(cv.Handle,l+1,t+1,l+w-1,t+h-1);
end;

Hier wird zunächst festgestellt, ob wir uns im Freestyle-Modus befinden - und ob die Selektion gerade erst gebildet wird ("range_ok" ist dann noch "false"). Ist dem so, müssen wir die einzelnen Eckpunkte des array "freestyle_a" auf der angezeigten "preview_bmp" malen. Das realisieren wir durch eine Schleife, wobei alle Verbindungslinien gleich zweimal gemalt werden, einmal in schwarz und einmal - leicht versetzt - in weiss. Dadurch sind die Linien unabhängig vom Untergrund immer zu erkennen.

"Rahmen" einer Freestyle-Selektion: Die Eckpunkte des Freestyle-Arrays werden durch Linien verbunden. Dies geschieht gleich zweimal. Einmal in schwarz und einmal in weiss. Dadurch ist die Umrandung immer gut zu erkennen.

Ist die Selektion fertig bzw. liegt keine Freistil-Selektion vor, wird der gesamte Selektionsbereich mit einem Rectangle umrandet. Auch dies geschieht in zweifarbiger Weise.

Des Weiteren werden an den Rahmen an passenden Stellen noch kleine Rectangles angefügt. Das sind die sogenannten "Hit-Points". An diesen Stellen kann der Rahmen vom Benutzer mit der Maus verändert werden.

Zum Schluss prüfen wir noch, ob eine Ellipse-Selektion vorliegt. Ist dem so, wird diese ebenfalls auf den Canvas der Bitmap "preview_bmp" gezeichnet.

2.3.8.2. Individuelles Pixel-Handling

Die letzte Funktion "merge_rgb_col" der unit "selection_u.pas" berechnet für jeden Pixel der auf dem Monitor angezeigten Bitmap "preview_bmp" eine "Mischfarbe". Diese ergibt sich, wenn an der gleicher Stelle auch ein Pixel der darüber liegenden Bitmap "bmp" der "TSelection" liegt. Oder ein Pixel der Bitmap "sprite_bmp" während des "Durchpausen"-Modus.

Um welchen Pixel es sich hierbei handelt, wird mit den Parametern "x" und "y" vorgegeben. Die bisherige Mischfarbe an dieser Stelle steht im Parameter "merged_rgb_col". Als Ergebnis erhalten wir die neu berechnete Mischfarbe zurück. Um eine Mischfarbe im eigentlichen Sinne handelt es sich übrigens nur dann, wenn die Selektion halb-transparent ist (vorgegeben durch die Variable "transparency", die von 0 bis 100 reichen kann); sonst überdeckt die Pixelfarbe von "sprite_bmp" bzw. "bmp" nämlich einfach den bisherigen Pixel von "preview_bmp". Zudem wird der var-Parameter "hit_ok" auf "true" gesetzt, sofern sich das Ergebnis von "merged_rgb_col" unterscheidet.

function TSelection.merge_rgb_col(
  merged_rgb_col:TRGBCol;x,y:integer;var hit_ok:bool
):TRGBCol;

  function rgb_col_transform(
    merged_rgb_col,rgb_col:TRGBCol
  ):TRGBCol;
  var
    i,ii:byte;
  begin
    result:=merged_rgb_col;

    //ignore transparent pixel
    if main_f.is_transp_rgb_col(rgb_col)then exit;

    //pixel to paint?
    if
      (merge_style<>ms_always)and
      (not main_f.is_transp_rgb_col(merged_rgb_col))
    then begin
      if merge_style=ms_darker then begin
        if not service_u.rgb_col_is_darker(
          rgb_col,merged_rgb_col
        ) then exit;
      end
      else if merge_style=ms_lighter then begin
        if not service_u.rgb_col_is_lighter(
          rgb_col,merged_rgb_col
        ) then exit;
      end;
    end;

    if transparency<>0 then begin
      i:=transparency;ii:=100-i;
      rgb_col.r:=trunc(
        (merged_rgb_col.r*i)/100)+round((rgb_col.r*ii)/100
      );
      rgb_col.g:=trunc(
        (merged_rgb_col.g*i)/100)+round((rgb_col.g*ii)/100
      );
      rgb_col.b:=trunc(
        (merged_rgb_col.b*i)/100)+round((rgb_col.b*ii)/100
      );
    end;

    hit_ok:=true;
    result:=rgb_col;
  end;

var
  rgb_col:TRGBCol;
begin
  hit_ok:=false;
  result:=merged_rgb_col;

  //exists a selection?
  if not range_ok then exit;

  if to_sprite_ok then begin

    //get to-sprite-painted pixel
    main_f.sprite_bmp.ba_set(y);
    rgb_col:=main_f.sprite_bmp.rgb_col_get(x);

    result:=rgb_col_transform(merged_rgb_col,rgb_col);
    if
      (result.r<>merged_rgb_col.r)or
      (result.g<>merged_rgb_col.g)or
      (result.b<>merged_rgb_col.b)
    then merged_rgb_col:=result;
  end;

  if not hit(x,y) then exit;

  //get pixel
  bmp.ba_set(y-rec.top);
  rgb_col:=bmp.rgb_col_get(x-rec.left);

  result:=rgb_col_transform(merged_rgb_col,rgb_col);
end;

Zuerst wird geprüft, ob eine fertige Selektion vorliegt ("range_ok"). Falls nicht, gibt es noch keine "bmp" oder "sprite_bmp"; die Selektion wird alleine über ihren Rahmen auf dem Monitor angezeigt (siehe oben). Wir verlassen die Prozedur also wieder.

Ansonsten wird festgestellt, ob der "Durchpausen"-Modus aktiv ist ("to_sprite_ok"). Falls ja, bilden wir die Mischfarbe aus "merged_rgb_col" und der korrespondieren Pixelfarbe "rgb_col" aus der "sprite_bmp". Dazu werden die beiden Farbwerte an die interne Funktion "rgb_col_transform" übergeben. Zu der kommen wir gleich noch.

Im Anschluss daran wird mittels der "hit"-Funktion ermittelt, ob sich die x/y-Position innerhalb des Rahmens der Selektion befindet. Falls nein, ist der Job getan, und es geht es raus.

Ansonsten fischen wir die Pixelfarbe "rgb_col" aus der Bitmap "bmp" und übergeben diese zusammen mit "merged_rgb_col" an die innere Funktion "rgb_col_transform".

Hier wird zuerst gecheckt, ob die übergebene Farbe "rgb_col" transparent ist. Ist dem nämlich so, kann "merged_rgb_col" unverändert zurückgeliefert werden

Anderenfalls wird in Abhängigkeit vom gewählten "merge_style" geprüft, ob "rgb_col" den Kriterien genügt, um über die "merged_rgb_col" zu dominieren. Falls nicht, bleibt die "merged_rgb_col" erneut unverändert, es geht also gleich wieder raus.

Alternativ bleibt nur noch festzustellen, ob die gefundene "rgb_col" mit der "merged_rgb_col" gemixt werden muss, um einen Transparenz-Effekt zu erreichen. Hierzu müssen die drei Farben-Anteilswerte (rot, grün und blau) der beiden Farben gemäss des Wertes in der Variablen "transparency" passend zueinander gewichtet werden.

Transparenz der Selektion: Die Pixel der Selektion werden mit den Farbwerten des Untergrund-Bild gemischt. Dadurch wirkt es, als sei das Gesicht von Grace bei einem Transparenz-Wert von "50" halb durchsichtig.

2.4. Unit "sprite_u.pas"

In der unit "sprite_u.pas" wird die Klasse "TSprite" implementiert. Sprites sind von "TSelection" abgeleitet, verfügen also über deren Fähigkeiten, können aber noch ein paar Sachen mehr. Weitere Unterschied: Von "TSelection" gibt es immer nur genau eine Instanz im Sprite-Painter, von "TSprite" kann es dagegen durchaus mehre Instanzen geben. Ihre Verwaltung obliegt der Unit "sprite_list_u.pas", die wir uns im nächsten Kapitel vornehmen.

Die Deklaration von "TSprite" fällt recht knapp aus:

00001
00002
00003
00004
00005
00006
00007
00008
00009

TSprite=class(TSelection)
  name:string;

  constructor create;
  procedure assign(selection:TSelection);

  procedure stream_load(stream:TStream);
  procedure stream_save(stream:TStream);
end;

Der Konstruktor ist leicht erweitert worden:

00001
00002
00003
00004
00005
00006
00007

constructor TSprite.create;
begin
  inherited;
  range_ok:=true;
  border_outer_col:=clteal;
  border_inner_col:=cllime;
end;

Die "range_ok"-Variable wird direkt auf "true" gesetzt, denn ein Sprite ohne fertige Region-Selektion macht keinen Sinn. Ausserdem wird die Rahmenfarbe geändert, um Sprites optisch leichter von der "TSelection"-Instanz unterscheiden zu können.

2.4.1. Selektion zu Sprite

Wie wir im vorherigen Kapitel gesehen haben, kann mit einer "TSelection" die Bitmap "sprite_bmp" bemalt werden. Die folgende Prozedur "assign" transformiert nun deren Inhalt in die Bitmaps "bmp" und "org_bmp" von "TSprite".

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015

procedure TSprite.assign(selection:TSelection);
begin
  main_f.sprite_bmp.rec_no_rgb_col_count(
    main_f.transp_rgb_col,rec
  );
  bmp.size_set(rec.right-rec.Left,rec.bottom-rec.top);
  bitblt(
    bmp.Canvas.Handle,0,0,bmp.width,bmp.Height,
    main_f.sprite_bmp.canvas.Handle,rec.left,rec.Top,
    srccopy
  );
  org_bmp.assign(bmp);
  transparency:=selection.transparency;
  merge_style:=selection.merge_style;
end;

Die Bitmap "sprite_bmp" ist genauso gross wie "preview_bmp". I.d.R. wird sie aber nicht an allen Stellen bemalt sein; es gibt möglicherweise links und rechts sowie oben und unten Bereiche, die transparent geblieben sind. Diese Bereiche sind für den Sprite überflüssig; sie würden nur seinen Speicherbedarf unnötig aufblähen. Daher setzen wir mit der "TBMP"-Funktion "rec_no_rgb_col_count" zunächst das Rectangle "rec" derart, dass es nur exakt alle nicht-transparenten Bereiche umschliesst.

Anschliessend kopieren wir diesen Bereich aus der "sprite_bmp" in die Bitmaps "bmp" und "org_bmp" von "TSprite".

Zuletzt werden noch die aktuellen Transparenz- und Merge-Style-Werte von der Hauptform übernommen.

2.4.2. Streaming im Sprite-Painter-Pic-Format

Sprites können auf spezielle Art und Weise in Streams abgelegt werden, dem "Sprite-Painter-Pic"-Format. Das wird verwendet, um Sprites auf Festplatte oder im Memory abzuspeichern.

Das Einladen eines "SPP"-Sprite-Streams wird über "stream_load" realisiert:

procedure TSprite.stream_load(stream:TStream);
var
  s:string;
begin
  s:=service_u.stream_tag_section_read(stream,'header');

  name:=service_u.string_tag(s,'name',name);

  transparency:=service_u.string_tag_int(
    s,'transparency',transparency
  );
  merge_style:=tmerge_style(
    service_u.string_tag_int(
      s,'merge_style',integer(merge_style)
    )
  );

  rec.left:=service_u.string_tag_int(
    s,'rec_left',rec.left
  );
  rec.top:=service_u.string_tag_int(
    s,'rec_top',rec.top
  );
  rec.right:=service_u.string_tag_int(
    s,'rec_right',rec.right
  );
  rec.bottom:=service_u.string_tag_int(
    s,'rec_bottom',rec.bottom
  );

  //org_bmp
  s:=service_u.stream_tag_section_read(stream,'size');
  org_bmp.LoadFromStream(stream);

  rec_set(rec);
end;

Zuerst wird die komplette Header-Section mit der Service-Prozedur "stream_tag_section_read" als string in "s" abgelegt.

Anschliessend werden aus "s" die Werte des Namens, der Transparenz, des Merge-Styles und des Koordinaten-Rectangles des Sprites gelesen.

Es folgt das Einlesen der "org_bmp" aus dem übergeben Stream "stream". Durch Aufruf von "rec_set" wird dann noch zuletzt "bmp" an die "org_bmp" angepasst.

Das Speichern eines "SPP"-Sprite-Streams geschieht mithilfe der Prozedur "stream_save":

procedure TSprite.stream_save(stream:TStream);
var
  mstream:TMemoryStream;
begin
  mstream:=TMemoryStream.create;
  try
    service_u.stream_write(stream,'<sprite>');

    service_u.stream_write(stream,'<header>');
    service_u.stream_write(
      stream,
      '<name>'+name+'</name>'
    );
    service_u.stream_write(
      stream,
      '<transparency>'+
      inttostr(transparency)+
      '</transparency>'
    );
    service_u.stream_write(
      stream,
      '<merge_style>'+
      inttostr(integer(merge_style))+
      '</merge_style>'
    );
    service_u.stream_write(
      stream,
      '<rec_top>'+inttostr(rec.top)+'</rec_top>'
    );
    service_u.stream_write(
      stream,
      '<rec_left>'+inttostr(rec.left)+'</rec_left>'
    );
    service_u.stream_write(
      stream,
      '<rec_right>'+inttostr(rec.right)+'</rec_right>'
    );
    service_u.stream_write(
      stream,
      '<rec_bottom>'+
      inttostr(rec.bottom)+
      '</rec_bottom>'
    );
    service_u.stream_write(stream,'</Header>');

    service_u.stream_write(stream,'<org_bmp>');
    org_bmp.SaveToStream(mstream);
    service_u.stream_write(
      stream,
      '<size>'+inttostr(mstream.size)+'</size>'
    );
    mstream.SaveToStream(stream);
  finally
    mstream.Free;
  end;
end;

Die Eigenschaftswerte von Name, Transparenz, Merge-Style und Koordinaten-Rectangle werden in den übergeben Stream hineingeschrieben. Wobei diese Values stets in Tags eingeschlossen werden ("<tag>value</tag>").

Um auch die Bitmap "org_bmp" im Sprite abzulegen, erzeugen wir zunächst einen temporären TMemoryStream "mstream". Über die Bitmap-Prozedur "SaveToStream" legen wir dann "org_bmp" darin ab. Und über die Stream-Prozedur "SaveToStream" landet "mstream" letztlich in "stream".

Die zweite Bitmap des Sprites, die "bmp", muss übrigens nicht in "stream" gesichert werden, da wir ja aus "org_bmp" die "bmp" jederzeit rekonstruieren können.

2.4.3. Tag-Notation mit eingebauter Zukunft

Die oben aufgezeigte Tag-Notation wurde - unter anderem - gewählt, weil sie es erlaubt, in späteren Versionen des Sprite-Painters leicht zusätzliche Tags hinzunehmen zu können, ohne dass dazu etwas an der Einlese-Prozedur geändert werden müsste; die neuen Tags würden von alten Sprite-Painter-Versionen einfach übersprungen werden.

Wichtiger ist jedoch der umgekehrte Fall, dass nämlich auch bestimmte Tags *fehlen* können. Angenommen, in einer älteren Sprite-Painter-Version hätte es noch nicht die Eigenschaft "tranparency" gegeben. Dann wäre das zugehörige Tag natürlich nicht im gespeichertem Stream dieser Version vorhanden. Unsere "stream_load"-Prozedur würde das allerdings nicht weiter stören, sondern einfach den vorgegeben Default-Wert für die Transparenz vergeben.

SPP-Format im Hex-Viewer: Ein weiterer Vorteil des "SPP"-Format ist, das Bildinformationen mit einem Hex-Viewer in Klartext zu erkennen sind. Mit etwas Geschick kann man die Einzelteile des Bildes dadurch sogar manuell aus der Datei isolieren.

2.5. Unit "sprite_list_u.pas": Verwaltung von Sprites

Wie bereits erwähnt, können im Sprite-Painter mehrere Instanzen von "TSprite" erzeugt werden. Jede dieser Instanzen wird in die ListBox "lb" der Hauptform abgelegt und über diese auch aktiviert bzw. gelöscht oder verschoben.

Die Funktionalität dieser ListBox ist in eine eigene unit ausgelagert worden, und zwar in der "sprite_list_u.pas". Die schauen wir uns jetzt näher an.

2.5.1. Neuer Sprite

Um einen neuen Sprite in die ListBox aufzunehmen, wird die Funktion "add" verwendet:

00001
00002
00003
00004
00005
00006
00007
00008

function add(sprite:TSprite):integer;
begin
  inc(main_f.sprite_c);
  sprite.name:='Sprite '+inttostr(main_f.sprite_c);
  main_f.sprite_lb.AddItem(sprite.name,sprite);
  main_f.pic_bmp.Modified:=true;
  result:=count-1;
end;

Der Integer-Zähler "sprite_c" wird erhöht. Der wird benötigt, um den Sprites einen eindeutigen Namen geben zu können. Er wird einfach nur fortlaufend erhöht, auch wenn zwischendurch Sprites gelöscht worden sein sollten.

Die "addItem"-Prozedur der ListBox speichert den übergeben Sprite mit dessen Objekt-Zeiger am Ende der aktuellen Liste.

2.5.2. Zugriff auf Sprite

Die Funktion "sprite_get" liefert einen Zeiger auf die gespeicherte "TSprite"-Instanz an der Position "inx" zurück.

Die Funktion "get_active" liefert den gerade aktiven Sprite zurück. Dazu nutzen wir die "sprite_get"-function und die ListBox-Eigenschaft "itemindex".

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024

//---------------------------------------------------
function count:integer;
begin
  result:=main_f.sprite_lb.Items.count;
end;

//---------------------------------------------------
function inx_check(inx:integer):bool;
begin
  result:=(inx>=0)and(inx<count);
end;

//---------------------------------------------------
function sprite_get(inx:integer):TSprite;
begin
  result:=nil;if not inx_check(inx) then exit;
  result:=TSprite(main_f.sprite_lb.Items.Objects[inx]);
end;

//---------------------------------------------------
function sprite_active:TSprite;
begin
  result:=TSprite(sprite_get(main_f.sprite_lb.ItemIndex));
end;

2.5.3. Löschen

Einmal Erzeugte Sprites können natürlich auch wieder gelöscht und aus der ListBox "lb" entfernt werden. Dies wird von den folgenden Funktionen erledigt:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033

//----------------------------------------------
procedure delete(inx:integer);
var
  sprite:TSprite;
begin
  if not inx_check(inx) then exit;
  sprite:=sprite_get(inx);
  sprite.Free;
  main_f.sprite_lb.Items.Delete(inx);
  main_f.pic_bmp.Modified:=true;
end;

//----------------------------------------------
procedure delete_active;
var
  sprite:TSprite;
begin
  sprite:=sprite_active;if sprite=nil then exit;
  if application.MessageBox(
    'Are you sure?','Kill the sprite',mb_yesno
  )=id_no then exit;

  delete(main_f.sprite_lb.itemindex);
  main_f.pb_update(true);
end;

//----------------------------------------------
procedure clear;
var
  r:integer;
begin
  for r:=count-1 downto 0 do delete(r);
end;

2.5.4. Bildtiefe wechseln

Die Position eines Sprites innerhalb der ListBox "lb" bestimmt, ob und wann ein Sprite andere Sprites überdeckt. Es gilt: Je kleiner der index, desto "tiefer" liegt ein Sprite. Der Sprite, der zuletzt in der ListBox auftaucht, überdeckt alle anderen.

Durch simples Ändern der Position eines Sprites in der ListBox lassen sich erstaunliche Effekte erzielen. Diese Art der Verschiebung in der Bildtiefe wird von den Prozeduren "down" und "up" vorgenommen:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023

//-----------------------------------
procedure down;
var
  i:integer;
begin
  i:=main_f.sprite_lb.ItemIndex;
  if(i<0)or(i>count-2) then exit;
  main_f.sprite_lb.Items.Exchange(i,i+1);
  main_f.pic_bmp.Modified:=true;
  main_f.pb_update(true);
end;

//-----------------------------------
procedure up;
var
  i:integer;
begin
  i:=main_f.sprite_lb.ItemIndex;
  if(i<1)or(i>count-1) then exit;
  main_f.sprite_lb.Items.Exchange(i,i-1);
  main_f.pic_bmp.Modified:=true;
  main_f.pb_update(true);
end;

Bildtiefe wechseln: Die Reihenfolge der Sprites in der ListBox gibt vor, wie weit "hinten" bzw. "vorne" ein Sprite eingezeichnet wird. Im obigen Bild versteckt sich Winona im Sprite Nr. 6 ganz hinten. Durch ein paar Klicks auf den Button "Down" ist dieser Sprite im unteren Bild ganz nach vorne geholt worden.

2.5.5. Streaming again

Das Streaming einzelner Sprites haben wir im vorherigen Kapitel bereits kennengelernt. Innerhalb eines Sprite-Painter-Bildes tauchen solche Sprite-Streams jedoch nie völlig isoliert auf, sondern ihnen geht stets ein Sprite-Listen-Header voran.

//---------------------------------------------------
procedure stream_load(stream:TStream);
var
  sprite_list:string;
  max:integer;
  r:integer;
  sprite:TSprite;
begin
  sprite_list:=service_u.stream_tag_section_read(
    stream,'sprite_list'
  );
  max:=service_u.string_tag_int(sprite_list,'count',0);

  for r:=0 to max-1 do begin
    sprite:=TSprite.create;
    sprite.stream_load(stream);
    add(sprite);
  end;
end;

//---------------------------------------------------
procedure stream_save(stream:TStream);
var
  r:integer;
  sprite:TSprite;
begin
  service_u.stream_write(stream,'<sprite_list>');
  service_u.stream_write(
    stream,'<count>'+inttostr(count)+'</count>'
  );
  service_u.stream_write(stream,'</sprite_list>');

  for r:=0 to count-1 do begin
    sprite:=sprite_get(r);
    sprite.stream_save(stream);
  end;
end;

Beim Einladen mit Prozedur "stream_load" wird zunächst der Stream-Listen-Header über die Service-Funktion "stream_tag_section_read" eingelesen. Darin ist das Tag "count" enthalten, dessen Wert angibt, wie viele Sprites im Stream insgesamt gespeichert sind.

Es folgt eine Schleife, die "count"-mal durchlaufen wird. Dabei wird jedes Mal ein neuer Sprite erzeugt ("TSprite.create"). Über die Funktion "sprite.stream_load" wird diesem Sprite Leben eingehaucht. Und zuletzt dann per "add"-function in die ListBox "lb" gedrückt.

Beim Speichern mit der Prozedur "stream_save" wird entsprechend in umgekehrter Reihenfolge vorgegangen: Der Sprite-Listen-Header mit dem Tag "count" wird in den Stream-Listen-Header geschrieben, danach alle in der ListBox "lb" enthaltenen Sprites durchlaufen und einzeln per "sprite.stream_save" im (File-)Stream abgelegt.

2.5.5.1. Sprites und die Windows-Ablage

Um den aktiven Sprite über Menü oder CTRL+C bzw. CTRL+V in der Windows-Ablage zu speichern bzw. von dort auszulesen, verwenden wir die Prozeduren "clipboard_copy" und "clipboard_paste". Sie reichen im Wesentlichen nur den erzeugten "TMemoryStream" an die bereits weiter oben vorgestellten Service-Funktionen "stream_clipboard_copy" und "stream_clipboard_paste" durch (siehe unit "service_u.pas").

//--------------------------------------------------------
procedure clipboard_copy;
var
  sprite:TSprite;
  mstream:TMemoryStream;
begin
  if main_f.pctrl.activepage=main_f.selection_ts then exit;
  sprite:=sprite_active;if sprite=nil then exit;

  screen.cursor:=crHourglass;
  mstream:=TMemoryStream.Create;
  try
    sprite.stream_save(mstream);
    service_u.stream_clipboard_copy(
      main_f.spp_clipboard_format,mstream
    );
  finally
    mstream.free;
    screen.cursor:=crdefault;
  end;
end;

//--------------------------------------------------------
procedure clipboard_paste;
var
  sprite:TSprite;
  mstream:TMemoryStream;
begin
  if main_f.pctrl.activepage=main_f.selection_ts then exit;

  screen.cursor:=crhourglass;
  sprite:=TSprite.create;
  mstream:=TMemoryStream.Create;
  try
    if not service_u.stream_clipboard_paste(
      main_f.spp_clipboard_format,mstream
    ) then begin
      sprite.Free;
      exit;
    end;
    sprite.stream_load(mstream);
    main_f.sprite_lb.ItemIndex:=add(sprite);
    main_f.pb_update(true);
  finally
    mstream.free;
    screen.cursor:=crdefault;
  end;
end;

2.6. Unit "main_u.pas": Die Hauptform des Sprite-Painter

Schauen wir uns nun noch die letzte unit "main_u.pas" an. Über diese wird die Hauptform "main_f" verwaltet. Wichtige Komponenten sind hier die PaintBox "PaintBox" für das Bild, die ListBox "lb" mit der Sprite-Liste, und die Page-Control "pctrl" mit zwei TabSheets, einmal "selection_ts" für die Selektionsparameter, und einmal "control_ts" für die Sprite-Steuerung.

Hauptform "main_f": Links die PageControl, über die zwischen den beiden Modi "Sprite-Selection" und "Sprite-Control" gewechselt werden kann. In der Mitte liegt die PaintBox, auf der das jeweils aktuelle Bild angezeigt wird.

2.6.1. Deklaration der Klasse mit semi-globalen Variablen

Tmain_f = class(TForm)
  MainMenu1: TMainMenu;
  File1: TMenuItem;

  [...]

private
  { private-Deklarationen }
public
  { public-Deklarationen }
  homedir:string;
  afn:string;

  //defined transparent color
  transp_rgb_col:TRGBCol;

  //clear original pic
  pic_bmp:TBMP;

  //preview pic (with border-rectangles)
  preview_bmp:TBMP;

  //bitmap of PaintBox
  pb_bmp:TBMP;

  //sprite-paint bitmap
  sprite_bmp:TBMP;

  //sprite id counter
  sprite_c:integer;

  //current mouse coordinates
  mouse_down_ok:bool;

  //coordinates left-top pixel of preview on PaintBox
  preview_left,preview_top:integer;

  selection:TSelection;

  //sprite-painter-pic-format for clipboard
  spp_clipboard_format:cardinal;

  //freestyle selection parameters
  freestyle_c:integer;
  freestyle_a:array[0.._freestyle_max]of tpoint;

  procedure pic_load(fn:string);
  procedure pic_save(fn:string);

  procedure stream_load(stream:TStream);
  procedure stream_save(stream:TStream);

  procedure pb_update(border_ok:bool);

  procedure cursor_set(cr:tcursor);

  function is_transp_rgb_col(rgb_col:TRGBCol):bool;
end;

Die meisten Variablen sind uns bereit bekannt, weil in den anderen Units darauf zugegriffen wurde ("transp_rgb_col", "sprite_bmp", "pic_bmp", "preview_bmp" usw.) Wichtig ist hier v.a. die Deklaration "selection" vom Typ "TSelection". Das ist nämlich die weiter oben erwähnte einzige Instanz von "TSelection", die in "FormCreate" erzeugt wird:

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

  //needed bitmaps
  pic_bmp:=TBMP.create;pic_bmp.Modified:=false;
  preview_bmp:=TBMP.create;
  pb_bmp:=TBMP.create;
  sprite_bmp:=TBMP.create;

  //one instance of selection class
  selection:=TSelection.create;

  //define transparent color
  transp_rgb_col:=service_u.col2rgb_col(
    rgb(_transp_col_r,_transp_col_g,_transp_col_b)
  );
  sprite_c:=0;

  //define sprite-painter-picture-format for clipboard
  spp_clipboard_format:=RegisterClipboardFormat(
    PChar('SPRITE-PAINTER-PIC')
  );

  //design
  color:=_background_color;
  sprite_top_p.ParentBackground:=false;
  sprite_lb.align:=alclient;
  back_p.align:=alclient;
  paint_border_p.align:=alclient;
  paint_border_p.ParentBackground:=false;
  paint_border_p.color:=_background_color;
  PaintBox.Align:=alclient;
  pctrl.ActivePage:=selection_ts;
end;

//-------------------------------------------------
procedure Tmain_f.FormDestroy(Sender: TObject);
begin
  sprite_bmp.Free;
  pb_bmp.Free;
  preview_bmp.Free;
  pic_bmp.Free;
end;

//-------------------------------------------------
procedure Tmain_f.FormCloseQuery(
  Sender: TObject; var CanClose: Boolean
);
begin
  if pic_bmp.Modified then begin
    if application.MessageBox(
      'Picture modified. Close without saving?',
      'Question',
      mb_yesno
    )=id_no then canclose:=false;
  end;
end;

//-------------------------------------------------
procedure Tmain_f.file_exit1Click(Sender: TObject);
begin
  close;
end;

Interessant in "FormCreate" ist ansonsten eigentlich nur noch der Aufruf der API-Funktion "RegisterClipboardFormat". Hierüber bekommt unser "Sprite-Painter-Pic"-Format vom System eine eindeutige ID zugewiesen, wodurch dieses Format in der Windows-Ablage überhaupt erst erkannt werden kann.

Die "Aufräum"-Funktionen "FormCloseQuery" und "FormDestroy" folgen den üblichen Mustern: Prüfen, ob das aktuelles Bild geändert wurde. Wenn ja, dann Warnung anzeigen, ansonsten "close" aufrufen und alle dynamisch erzeugten Objekte wieder freigeben.

2.6.2. Maus-Ereignisse

Auch nicht weiter aufregend ist das Handling der Maus-Ereignisse, die in Verbindung mit der "TPaintBox"-Komponente stehen. Hier wird jeweils festgestellt, ob die Selektion-Page oder die Sprite-Control-Page aktiv ist, und die Ereignisse entsprechend an "selection" oder den aktiven Sprite weitergeleitet.

//-----------------------------------------------
procedure Tmain_f.PaintBoxMouseDown(
  Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer
);
var
  sprite:TSprite;
begin
  if afn='' then exit;

  mouse_down_ok:=true;
  if pctrl.activepage=selection_ts then begin
    //selection-mode
    selection.MouseDown(
      button,shift,x-preview_left,y-preview_top
    );
  end
  else begin
    //sprite-mode
    //any sprite selected?
    sprite:=sprite_list_u.sprite_active;
    if sprite=nil then exit;
    //yep
    sprite.MouseDown(
      button,shift,x-preview_left,y-preview_top
    );
  end;
end;

//-----------------------------------------------
procedure Tmain_f.PaintBoxMouseMove(
  Sender: TObject; Shift: TShiftState;X,Y:Integer
);
var
  sprite:TSprite;
begin
  //no file, no action
  if afn='' then exit;

  if pctrl.activepage=selection_ts then begin
    selection.Mousemove(
      shift,x-preview_left,y-preview_top
    );
  end
  else begin
    sprite:=sprite_list_u.sprite_active;
    if sprite=nil then exit;
    sprite.Mousemove(
      shift,x-preview_left,y-preview_top
    );
  end;
end;

//-----------------------------------------------
procedure Tmain_f.PaintBoxMouseUp(
  Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer
);
var
  sprite:TSprite;
begin
  if afn='' then exit;
  if not mouse_down_ok then exit;

  mouse_down_ok:=false;
  if pctrl.activepage=selection_ts then begin
    selection.MouseUp(
      button,shift,x-preview_left,y-preview_top
    );
  end
  else begin
    sprite:=sprite_list_u.sprite_active;
    if sprite=nil then exit;
    sprite.MouseUp(
      button,shift,x-preview_left,y-preview_top
    );
  end;
end;

2.6.3. Bild einladen

Etwas umfangreicher fallen die Prozeduren aus, um ein Bild in den Sprite-Painter einzuladen. Unterstützt werden JPGs, BMPs und unser eigenes Format SPP. Nur letzteres vermag es, Sprites separiert im File zu speichern, d.h., sie nicht wie bei BMPs und JPGs nachträglich unveränderbar in die Bild-Bitmap zu integrieren.

//--------------------------------------------------
procedure tmain_f.stream_load(stream:TStream);
var
  header:string;
begin
  //header
  header:=service_u.stream_tag_section_read(stream,'header');
  sprite_c:=service_u.string_tag_int(
    header,'sprite_c',sprite_c
  );

  //background
  service_u.stream_tag_section_read(stream,'size');
  pic_bmp.LoadFromStream(stream);

  //and list of sprites
  sprite_list_u.stream_load(stream);
end;

//--------------------------------------------------
procedure tmain_f.pic_load(fn:string);
var
  jpg:TJPEGImage;
  fstream:TFileStream;
  pb_w,pb_h:integer;
  w,h:integer;
  ext:string;
begin
  screen.Cursor:=crhourglass;
  try
    //clear selection and list of sprites
    selection.clear;
    sprite_list_u.clear;

    //get picture-format
    ext:=ansilowercase(extractfileext(fn));
    if
      (ext='.jpg')or
      (ext='.jpeg')or
      (ext='.jpe')
    then begin
      jpg:=tjpegimage.Create;
      try
        jpg.LoadFromFile(fn);
        pic_bmp.assign(jpg);
      finally
        jpg.Free;
      end;
    end
    else if ext='.bmp' then begin
      pic_bmp.LoadFromFile(fn);
    end
    else if ext='.spp' then begin
      fStrm:=TfileStream.Create(fn,fmopenread);
      try
        stream_load(fstream);
      finally
        fstream.Free;
      end;
    end
    else begin
      application.MessageBox(
        'Unknown Extension','DIRTY ERROR',mb_ok
      );
      exit;
    end;

    //adapt size to PaintBox
    pb_w:=PaintBox.Width;
    pb_h:=PaintBox.height;
    if(pic_bmp.width/pb_w)>(pic_bmp.Height/pb_h) then begin
      w:=pb_w;
      h:=trunc(w*pic_bmp.Height/pic_bmp.width);
    end
    else begin
      h:=pb_h;
      w:=trunc(h*pic_bmp.width/pic_bmp.height);
    end;
    preview_bmp.size_set(w,h);

    //paint original picture to preview_bmp
    SetStretchBltMode(
      preview_bmp.Canvas.handle,coloroncolor
    );
    stretchblt(
      preview_bmp.Canvas.Handle,0,0,w,h,
      pic_bmp.Canvas.Handle,
      0,0,pic_bmp.width,pic_bmp.Height,
      srccopy
    );

    //save this 'clear' preview_bmp back in pic_bmp
    pic_bmp.assign(preview_bmp);

    //set size og sprite-paint-bitmap
    sprite_bmp.size_set(w,h);

    afn:=fn;caption:=_caption+' - '+afn;
    pic_bmp.Modified:=false;

    //show the picture
    pb_update(true);
  finally
    screen.cursor:=crdefault;
  end;
end;

//--------------------------------------------------
procedure Tmain_f.file_open1Click(Sender: TObject);
begin
  if pic_bmp.modified then begin
    if application.MessageBox(
      'Picture modified. Continue?',
      'Question',
      mb_yesno
    )=id_no then exit;;
  end;
  if not open_pic_dlg.execute then exit;
  pic_load(open_pic_dlg.FileName);
end;

Interessant ist hier eigentlich nur die Prozedur "pic_load".

Hier wird zunächst über die Extension des übergebenen Dateinamens der Typ des Bildes festgestellt. BMPs können wir direkt in die Bitmap "pic_bmp" einladen, JPGs gehen dazu den Umweg über eine "TJPegImage"-Instanz, und SPP-Bilder verwenden für den gleichen Zweck die Prozedur "stream_load".

Das nun in "pic_bmp" eingeladene Bild kann kleiner oder grösser sein als die von der PaintBox zur Verfügung gestellte Fläche. Im nächsten Schritt gilt es daher, die Bitmap "pic_bmp" zu modifizieren, sodass sie möglichst flächenfüllend in die PaintBox eingebettet werden kann.

Dazu wird ermittelt, wie das Verhältnis von Höhe zu Breite von Bild und PaintBox zueinander korrespondiert. Danach wird entschieden, ob die Breite oder die Höhe von "pic_bmp" auf den gleichen Wert wie Höhe oder Breite der PaintBox gesetzt wird. Der Wert der jeweils andere Dimension ergibt sich dann aus dieser fixierten Grösse.

Mithilfe der beiden API-Funktionen "SetStretchBltMode" und "StretchBlt" kopieren wir schliesslich die "pic_bmp" in berechneter Grösse auf die "preview_bmp", von wo aus wir sie im nächsten Schritt auch gleich wieder auf die "pic_bmp" zurück übertragen (das erledigt "pic_bmp.assign").

2.6.4. Bild speichern

Schauen wir uns nun die Speichern-Funktionen des Sprite-Painters an:

//-----------------------------------------------------
procedure tmain_f.stream_save(stream:TStream);
var
  mstream:TMemoryStream;
begin
  //header infos
  service_u.stream_write(stream,'<sprite_painter>');
  service_u.stream_write(stream,'<header>');
  service_u.stream_write(stream,
    '<Author>daniel schwamm</Author>'
  );
  service_u.stream_write(stream,
    '<url>http://www.daniel-schwamm.de</url>'
  );
  service_u.stream_write(
    stream,
    '<sprite_c>'+
    inttostr(sprite_c)+
    '</sprite_c>'
  );
  service_u.stream_write(stream,'</Header>');

  //background
  mstream:=TMemoryStream.create;
  try
    service_u.stream_write(stream,'<pic_bmp>');
    pic_bmp.SaveToStream(mstream);
    service_u.stream_write(
      stream,
      '<size>'+inttostr(mstream.size)+'</size>'
    );
    mstream.SaveToStream(stream);
  finally
    mstream.Free;
  end;

  //and list of sprites
  sprite_list_u.stream_save(stream);
end;

//-----------------------------------------------------
procedure tmain_f.pic_save(fn:string);
var
  jpg:TJPEGImage;
  fstream:TFileStream;
  ext:string;
begin
  if pic_bmp.Empty then exit;

  screen.cursor:=crhourglass;
  try
    //get picture-format
    ext:=ansilowercase(extractfileext(fn));
    if
      (ext='.jpg')or
      (ext='.jpeg')or
      (ext='.jpe')
    then begin
      //create clear preview without borders
      pb_update(false);

      //save preview as jpg
      jpg:=tjpegimage.Create;
      try
        jpg.assign(preview_bmp);
        jpg.SaveToFile(fn);
      finally
        jpg.free;
      end;
    end
    else if ext='.bmp' then begin
      //create clear preview without borders
      pb_update(false);
      preview_bmp.SaveToFile(fn);
    end
    else begin
      //load pic as file stream
      fStrm:=TfileStream.Create(fn,fmCreate);
      try
        stream_save(fstream);
      finally
        fstream.Free;
      end;
    end;

    afn:=fn;caption:=_caption+' - '+afn;
    pic_bmp.Modified:=false;

    //show then pic
    pb_update(true);
  finally
    screen.cursor:=crdefault;
  end;
end;

//-----------------------------------------------------
procedure Tmain_f.file_save_under1Click(Sender:TObject);
var
  fn,ext:string;
begin
  //put filename into svae_pic_dlg without extension
  ext:=ansilowercase(extractfileext(afn));
  fn:=copy(afn,1,length(afn)-length(ext));
  save_pic_dlg.filename:=fn;
  if not save_pic_dlg.Execute then exit;

  //get chosen picture-format, append extension
  fn:=save_pic_dlg.filename;
  ext:=ansilowercase(extractfileext(fn));
  if ext='' then begin
    if      save_pic_dlg.FilterIndex=2 then ext:='.jpg'
    else if save_pic_dlg.FilterIndex=3 then ext:='.bmp'
    else                                    ext:='.spp';
    fn:=fn+ext;
  end;

  pic_save(fn);
end;

//-----------------------------------------------------
procedure Tmain_f.file_save1Click(Sender: TObject);
begin
  pic_save(afn);
end;

Hier ist eigentlich nur ein Punkt der Prozedur "pic_save" interessant: Speichern wir ein Bild im BMP- oder JPG-Format, dann rufen wir unmittelbar davor die Anzeige-Prozedur "pb_update" auf. Allerdings anders als sonst mit dem Parameter "border_ok" auf "false". Dadurch erhalten wir in der Bitmap "preview_bmp" ein aus allen Sprites und dem Hintergrund gemischtes Bild ohne jede Rahmen-Markierungen (und ohne Selektion). Denn diese wollen wir natürlich nicht auf unserem Bild belassen.

Wird das Bild im "SPP"-Format gespeichert, ist diese Vorarbeit nicht nötig. Nach dem Einladen kann das Bild in diesem Falle vollständig rekonstruiert werden; alle Sprites lassen sich wie vor dem Speichern verschieben und in der Grösse verändern.

Ein Nachteil des "SPP"-Formats sei erwähnt: Da die Sprites unter Umständen transparente Bereiche enthalten und diese durch eine exakte Farbe definiert sind, müssen die Bilder im Stream als reine Bitmaps abgelegt sein - und das bedeutet, "SPP"-Bilder können rasch sehr gross werden. Das platzsparende JPG-Format kommt hier nämlich leider nicht infrage, weil dort Pixel mit transparenter Farbe unter Umständen aufgrund der Komprimierung leicht variiert werden - und damit sofort ihre Transparenz-Eigenschaft verlieren würden.

2.6.5. Die Anzeige

Schauen wir uns jetzt an, wie unser Bild samt Sprites und Selektionen auf dem Monitor gebracht wird. Es gilt dazu:

"pic_bmp" enthält das Originalbild in optimaler Grösse für die PaintBox.
Die "preview_bmp" und die "sprite_bmp" sind exakt gleichgross wie "pic_bmp".
Die "pb_bmp" entspricht in ihrer Grösse der PaintBox.

procedure Tmain_f.PaintBoxPaint(Sender: TObject);
begin
  if afn='' then exit;
  //copy prepared pb_bmp to PaintBox-canvas
  bitblt(
    PaintBox.Canvas.Handle,0,0,PaintBox.width,PaintBox.height,
    pb_bmp.canvas.Handle,0,0,
    srccopy
  );
end;

//------------------------------------------------------
//kernel procedure: making of preview_bmp
//
//pic_bmp + sprites + selection painted on preview_bmp
//
//preview_bmp centered on pb_bmp
//
//pb_bmp painted on PaintBox-canvas
//
//------------------------------------------------------
procedure tmain_f.pb_update(border_ok:bool);
var
  pb_h,pb_w,w,h:integer;
  x,y:integer;
  r:integer;
  rgb_col:TRGBCol;
  hit_ok:bool;
  selection_ok:bool;
  sprite_max:integer;
  sprite_a:array[0.._sprite_max]of TSprite;
  sprite:TSprite;
begin
  //selection mode (or sprite.mode)?
  selection_ok:=(pctrl.ActivePage=selection_ts);

  //must save sprite list parameters in 'fixed' vars
  //cause that speed up the procedure enormously
  sprite_max:=sprite_list_u.count;
  for r:=0 to sprite_max-1 do begin
    sprite_a[r]:=sprite_list_u.sprite_get(r);
  end;

  //filling all pixels of preview_bmp
  for y:=0 to preview_bmp.height-1 do begin
    //get line of pixels from ...
    preview_bmp.ba_set(y);
    pic_bmp.ba_set(y);

    for x:=0 to preview_bmp.width-1 do begin
      //get current pixel from original
      rgb_col:=pic_bmp.rgb_col_get(x);

      //merge color with sprite-pixel at same position
      //the last sprite dominates
      //pixel can be transparent, so we must check all sprites!
      for r:=0 to sprite_max-1 do begin
        rgb_col:=sprite_a[r].merge_rgb_col(rgb_col,x,y,hit_ok);
      end;

      //selection pixel at same position?
      //the selection is always 'higher' as sprites
      if selection_ok then
        rgb_col:=selection.merge_rgb_col(rgb_col,x,y,hit_ok);

      //set calculated preview pixel
      preview_bmp.rgb_col_set(x,rgb_col);
    end;
  end;

  //any border-recs allowed on preview_bmp?
  if border_ok then begin
    //yep
    if selection_ok then begin
      selection.border;
    end
    else begin
      //any active sprite?
      sprite:=sprite_list_u.sprite_active;
      if sprite<>nil then sprite.border;
    end;
  end;

  //now paint preview_bmp centered on pb_bmp
  pb_w:=PaintBox.Width;
  pb_h:=PaintBox.height;

  w:=preview_bmp.Width;
  h:=preview_bmp.height;

  preview_left:=(pb_w-w)div 2;
  preview_top:=(pb_h-h)div 2;

  pb_bmp.size_set(pb_w,pb_h);
  pb_bmp.fill_col(_background_color);

  bitblt(
    pb_bmp.Canvas.Handle,preview_left,preview_top,w,h,
    preview_bmp.canvas.Handle,0,0,
    srccopy
  );

  //draw pb_bmp on PaintBox-canvas
  PaintBoxPaint(nil);
end;

In der Prozedur "pb_update" werden die Sprite-Anzahl in einer Variable und die Sprite-Instanzen in ein temporäres array abgelegt. Das erhöht das Tempo des Zugriffs darauf enorm. Das liegt vermutlich daran, weil sich bei einer ListBox jederzeit die Anzahl der Einträge ändern könnte und in den folgenden Schleifen daher unzählige Male geprüft werden müsste, ob dieser Fall nicht gerade eingetreten ist.

Wir durchlaufen in einer äusseren Schleife zuerst die Bitmap "preview_bmp" zeilenweise. Dabei werden jedes Mal die "PByteArray"-Zeiger von "preview_bmp" und "pic_bmp" inkrementiert (über die "ba_set"-Methode von "TBMP").

In der inneren Schleife ermitteln wir dann über die "rgb_col_get"-Methode jeweils die Pixelfarbe des Originalbildes "pic_bmp" an x-Position und sichern diese in "rgb_col".

Nun werden alle Sprites durchlaufen und geprüft, ob diese an gleicher Stelle entweder einen nicht-transparenten "sprite_bmp"-Pixel besitzen oder aber einen nicht-transparenten Pixel ihrer eigenen internen Bitmap "bmp". Die "TSelection"-Methode "merge_rgb_col" liefert uns dafür die korrekte Mischfarbe in "rgb_col" zurück.

Ist die Selektion-Page aktiv, wird darüber hinaus mit der gleichen Methode eine eventuell vorliegende Mischfarbe ermittelt, die von der "TSelection"-Instanz "selection" herrührt.

Die so berechnete Mischfarbe wird schliesslich über die "rgb_col_set"-Methode innerhalb der "preview_bmp" gesetzt.

Sind auf diese Weise alle Pixel von "preview_bmp" bestimmt worden, folgt nun noch der Aufruf der "border"-Methode sämtlicher Sprites bzw. der TSelection-Instanz.

Anschliessend werden ein paar Koordinaten-Punkte berechnet, die nötig sind, um die "preview_bmp" in zentrierter Weise auf die "pb_bmp" zu kopieren.

Durch Aufruf der Prozedur "PaintBoxPaint" wird die "pb_bmp" schliesslich auf den Canvas der PaintBox kopiert und somit auf dem Monitor ausgegeben.

2.6.6. Sonstiges

Die restlichen Funktionen und Prozeduren von "main_u.pas" bergen wenig Überraschungen und seien hier nur noch der Vollständigkeit halber aufgeführt:

//this function set cursor an update immediately
procedure tmain_f.cursor_set(cr:tcursor);
begin
  cursor:=cr;
  Perform(WM_SETCURSOR,Handle,HTCLIENT);
end;

//check if color is our defined transparent color
function tmain_f.is_transp_rgb_col(rgb_col:TRGBCol):bool;
begin
  result:=
    (rgb_col.r=transp_rgb_col.r)and
    (rgb_col.g=transp_rgb_col.g)and
    (rgb_col.b=transp_rgb_col.b);
end;

//one or more properties of selection has changed
procedure Tmain_f.selection_merge_style_cbChange(Sender:TObject);
begin
  selection.merge_style:=tmerge_style(
    selection_merge_style_cb.ItemIndex
  );
  selection.transparency:=
    selection_transparency_sb.Position;
  pb_update(true);
end;

//------------------------------------------------------
procedure Tmain_f.PaintBoxDblClick(Sender: TObject);
begin
  if afn='' then exit;
  //double-click handled only by selection (not sprites)
  if pctrl.activepage=selection_ts then selection.dblclick;
end;

//------------------------------------------------------
procedure Tmain_f.pctrlChange(Sender: TObject);
begin
  //edit-menu enabled only in sprite-mode
  edit1.Enabled:=(pctrl.activepage=control_ts);
  pb_update(true);
end;

//------------------------------------------------------
procedure Tmain_f.sprite_lbClick(Sender: TObject);
var
  sprite:TSprite;
begin
  //is there any active sprite?
  sprite:=sprite_list_u.sprite_active;
  if sprite=nil then exit;

  //get properties of sprite
  sprite_merge_style_cb.ItemIndex:=
    integer(sprite.merge_style);
  sprite_transparency_sb.position:=
    sprite.transparency;
  pb_update(true);
end;

//one or more properties of active sprite has changed
procedure Tmain_f.sprite_merge_style_cbChange(Sender:TObject);
var
  sprite:TSprite;
begin
  sprite:=sprite_list_u.sprite_active;
  if sprite=nil then exit;
  sprite.merge_style:=tmerge_style(
    sprite_merge_style_cb.ItemIndex
  );
  sprite.transparency:=
    sprite_transparency_sb.position;
  pb_update(true);
end;

//------------------------------------------------------
procedure Tmain_f.lb_del_bClick(Sender: TObject);
begin
  sprite_list_u.delete_active;
end;

//------------------------------------------------------
procedure Tmain_f.lb_down_bClick(Sender: TObject);
begin
  sprite_list_u.down;
end;

//------------------------------------------------------
procedure Tmain_f.lb_up_bClick(Sender: TObject);
begin
  sprite_list_u.up;
end;

//------------------------------------------------------
procedure Tmain_f.edit_copy1Click(Sender: TObject);
begin
  sprite_list_u.clipboard_copy;
end;

//------------------------------------------------------
procedure Tmain_f.edit_paste1Click(Sender: TObject);
begin
  sprite_list_u.clipboard_paste;
end;

//------------------------------------------------------
procedure Tmain_f.about1Click(Sender: TObject);
begin
  application.MessageBox(
    pchar(
     ansiuppercase(_caption)+_cr+_cr+
     'November 2009'+_cr+
     'Daniel Schwamm'+_cr+_cr+
     'http://www.daniel-schwamm.de'
    ),
    'About',
    mb_ok
  );
end;

3. Schlussbemerkungen

Zu Beginn des Tutorial habe ich damit geprahlt, den Sprite-Painter in nur zwei Tagen programmiert zu haben. Und das stimmt auch.

Das hat allerdings nur deshalb so schnell geklappt, weil ich zur Zeit ohnehin knietief im Thema Bildverarbeitung stecke. Habe mir nämlich das bescheidene Ziel gesetzt, in meiner Freizeit den Photoshop nachzuprogrammieren. Tja, und nächsten Monat oder so, da reproduziere ich dann XP ...

Nun ja, die Schluderei beim Programmieren merkt man dem Sprite-Painter schon an. Die Grafik-Anzeige etwa geht zwar relativ hurtig vonstatten, doch liegt hier zweifellos noch jede Menge Optimierungspotenzial brach. So müssten z.B. die Pixel der ersten 30 Sprites erst gar nicht ermittelt werden, wenn vorher schon geklärt wäre, das Sprite Nr. 32 alle anderen Sprites überdeckt.

Einfach gemacht habe ich es mir auch dadurch, dass ich die Bildgrösse auf die Screen- bzw. PaintBox-Grösse beschränkt habe. Hätte ich jedoch mit der echten Grösse eines Bildes operiert, wären Zoom-Funktionen, Scrolling, zusätzliche Preview-Zoom-Bitmaps und Wer-weiss-noch-alles nötig geworden. Da hätte ich dann erst einmal zusätzlichen Web-Space anmieten müssen, um das noch als Tutorial veröffentlichen zu können.

Unschön ist auch der ... nub ja, krude Mix aus englischer und deutscher Benennung der Variablen. Noch übler verhält es sich bei den Kommentaren. Tja, das ist dann wohl die chaotische Seite in mir. Und ich fürchte, die werde ich nie so richtig in den Griff bekomme.

So etwas verdirbt mir jedenfalls nicht den Spass an meinem Proggy. Ist halt nichts Hundertprozentiges. But who cares?

4. Download

"Sprite-Painter" wurde in Delphi 7 programmiert. Im ZIP-File enthalten ist der vollständige Source-Code, sowie die EXE-Datei. Das Paket, etwa 330 kB, gibt es hier:

Sprite-Painter.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 600 kB recht anspruchslos. Ausserdem nimmt es keinerlei Änderungen an der Registry vor.

Have fun!