CopyRect und TImageList

galagher · Verfasst: Mo 03.12.18 15:25

Hallo!

Ich möchte mit CopyRect 25 100x128 Pixel grosse Bereiche aus einem Bitmap auslesen und in eine ImageList einfüge. Ich mache das so, dass ich erstmal je 5 nebeneinander auslese+einfüge, dann Rect.Top um 100 erhöhe und wieder ganz links beginne, diesmal eben in der "2. Zeile".
Um von links nach rechts zu lesen, erhöhe ich jedesmal um 128.

Dabei kommt folgendes raus: In der ImageList ist der erste kopierte Bereich, also das "1. CopyRect" 2x vorhanden, alle weiteren Bitmaps sind nicht die fortlaufenden Kopien aus dem Quell-Bitmap, sondern entweder total verzerrt oder Wiederholungen bereits vorangegangener Kopien.

Meine Frage daher: Wie splitte ich ein Quell-Bitmap von links nach rechts, von oben nach unten, in jeweils gleich grosse, kleinere Bitmaps auf?

_________________
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!

Gausi · Verfasst: Mo 03.12.18 16:45

Von der Idee her sollte das so passen. Vorausgesetzt, du erzeugst jedes Mal ein neues Bitmap für die Imagelist.

Wie sieht denn deine Schleife aus? Sicher, dass du den Quellbereich passend veränderst, und du da keinen Fehler drin hast? Poste mal deinen Code, so ins Blaue raten bringt da vermutlich wenig. :wink:

_________________
We are, we were and will not be.

Ehemaliges Mitglied Erhaltene Danke: 1

- Nachträglich durch die Entwickler-Ecke gelöscht -

galagher · Verfasst: Mo 03.12.18 18:19

Frühlingsrolle hat folgendes geschrieben :

wenn ein Rect 100x128 (Breite x Höhe) hat, und du zum .Top 100 dazu rechnest, dann haut es so schon nicht hin.

Hallo!

Sorry, mein Fehler, es ist umgekehrt: 128x100 (Breite x Höhe)! Ich addiere also zu .Top jeweils nach 5x kopieren 100 dazu, das wäre dann also die nächste "Zeile", die es zu verarbeiten gilt. Waagrecht nach jedem Kopieren demnach also 128.

Hier mein Code, ein noch grober Entwurf, zB. könnte man hier statt mit dem Zähler i mit mod arbeiten, aber das Gerüst steht erstmal - nur leider schief!

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

procedure CopyBitmapsToImageList(const ImageList: TImageList);
var
  i, c, l, t: Integer;
  aDestRect: TRect;
begin
  i := 0;
  t := 0;
  l := 0;

  aDestRect.Top := t;
  aDestRect.Left := l;
  aDestRect.Width := 128;
  aDestRect.Height := 100;

  {25 Bitmaps sollen kopiert werden}
  for c := 1 to 25 do
  begin
    with Image1.Picture.Bitmap do
      Image2.Canvas.CopyRect(aDestRect, Canvas, Canvas.ClipRect);

    ImageList1.Add(Image1.Picture.Bitmap, nil);

    Inc(l, 128);

    Inc(i);

    if i = 5 then  {5 sind erledigt, weiter mit}
    begin  {den nächsten 5, 100 Pixel darunter}
      i := 0;
      l := 0;  {Wieder ganz links beginnen}
      Inc(t, 100);  {... 100 Pixel darunter}
    end;

    aDestRect.Left := l;
    aDestRect.Top := t;
  end;
end;

_________________
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!

Ehemaliges Mitglied Erhaltene Danke: 1

- Nachträglich durch die Entwickler-Ecke gelöscht -

galagher · Verfasst: Mo 03.12.18 21:02

Da hatte ich doch exakt dieses Problem schon mal:
www.entwickler-ecke....p;highlight=copyrect
Kein Wunder, ist ja auch das selbe Projekt! :mrgreen:

Aber auch mit dem alten Code (hatte den nicht mehr im Projekt) läuft es nicht... Da entstehen lauter Bitmap-Dateien mit 0 Bytes Länge.

_________________
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!

GuaAck · Verfasst: Mo 03.12.18 21:06

Hallo,

Image2.Cnavas.CopyRect kopiert doch einen Teil aus Image1 heraus. Müsste dann nicht die Bitmap von Image2 in die ImageLiast aufgenommen werden? Wo wird denn Canvas.ClipRect gesetzt?

Ich würde das "with" vermeiden, dann erkennt man leichter, was aus welcher Canvas gemeint ist.

Gruß
GuaAck

galagher · Verfasst: Mo 03.12.18 21:14

GuaAck hat folgendes geschrieben :

Image2.Cnavas.CopyRect kopiert doch einen Teil aus Image1 heraus. Müsste dann nicht die Bitmap von Image2 in die ImageLiast aufgenommen werden?

Funktioniert auch nicht.

GuaAck hat folgendes geschrieben :

Wo wird denn Canvas.ClipRect gesetzt?

Das ist doch eine Nur-Lesen-Eigenschaft, man kann da nichts zuweisen.

Ich verwende jetzt wieder den alten Code (der im Prinzip dasselbe ist) - ohne Erfolg. Das verstehe ich nicht!

_________________
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!

Gausi · Verfasst: Mo 03.12.18 21:19

Ich bin mir nicht sicher, was bei dir das "große Quellbild" ist, und welches Image das "kleine, temporäre" Bild ist.

Wenn ich bei mir "Image1" als das große Bild nehme, und Image2 als das kleine, was gewissermaßen die einzelnen Puzzlestücke des großen für die Imagelist zwischenspeichert, dann muss die Kopierzeile erstmal so aussehen:

markieren

Delphi-Quelltext

1:	Image2.Picture.Bitmap.Canvas.CopyRect(Image2.Picture.Bitmap.Canvas.ClipRect, Image1.Picture.Bitmap.Canvas, aDestRect);

Image2 muss dafür erstmal ein 100x128 großes Bitmap zugeordnet werden. Eigentlich wäre es auch besser, dafür mit einem reinen TBitmap zu arbeiten, also so.

Dabei ist "DestRect" jetzt blöd benannnt, denn das das ist jetzt ein SourceRect. ;-)

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:

procedure TForm1.CopyBitmapsToImageList;
var
  i, c, l, t: Integer;
  aDestRect: TRect;
  tmpBitmap: TBitmap;
begin
  i := 0;
  t := 0;
  l := 0;

  aDestRect.Top := t;
  aDestRect.Left := l;
  aDestRect.Width := 128;
  aDestRect.Height := 100;

  tmpBitmap := TBitmap.Create;
  try
    tmpBitmap.Width := 128;
    tmpBitmap.Height := 100;

    {25 Bitmaps sollen kopiert werden}
    for c := 1 to 25 do
    begin
      tmpBitmap.Canvas.CopyRect(tmpBitmap.Canvas.ClipRect, Image1.Picture.Bitmap.Canvas, aDestRect);

      ImageList1.Add(tmpBitmap, nil);

      Inc(l, 128);

      Inc(i);

      if i = 5 then  {5 sind erledigt, weiter mit}
      begin  {den nächsten 5, 100 Pixel darunter}
        i := 0;
        l := 0;  {Wieder ganz links beginnen}
        Inc(t, 100);  {... 100 Pixel darunter}
      end;

      aDestRect.Left := l;
      aDestRect.Top := t;
      aDestRect.Width := 128;
      aDestRect.Height := 100;
    end;
  finally
    tmpBitmap.free;
  end;
end;

Und die markierten Zeilen sollten das Problem beheben. Mit Left und Top setzt du zwar die linke und obere Ecke, aber nicht die rechte untere Ecke des Rechtecks. Die bleibt immer gleich, und deswegen bekommst du Verzerrungen und Spiegelungen in das Zielbild rein. Alternativ .Bottom und .Right setzen.

_________________
We are, we were and will not be.

galagher · Verfasst: Mo 03.12.18 21:36

Gausi hat folgendes geschrieben :

Ich bin mir nicht sicher, was bei dir das "große Quellbild" ist, und welches Image das "kleine, temporäre" Bild ist.

Image1 = gross, Image2 = klein!

Gausi hat folgendes geschrieben :

Wenn ich bei mir "Image1" als das große Bild nehme, und Image2 als das kleine, was gewissermaßen die einzelnen Puzzlestücke des großen für die Imagelist zwischenspeichert, dann muss die Kopierzeile erstmal so aussehen:

markieren

Delphi-Quelltext

1:	Image2.Picture.Bitmap.Canvas.CopyRect(Image2.Picture.Bitmap.Canvas.ClipRect, Image1.Picture.Bitmap.Canvas, aDestRect);

Ok, soweit, so gut!

Gausi hat folgendes geschrieben :

Image2 muss dafür erstmal ein 100x128 großes Bitmap zugeordnet werden. Eigentlich wäre es auch besser, dafür mit einem reinen TBitmap zu arbeiten, also so.

Bitmap zuordnen bewirkt nichts, und ja, wenn der Code fertig ist, werde ich dann auch reine TBitmaps verwenden und den Code auch allgemeiner gestalten.

Gausi hat folgendes geschrieben :

Dabei ist "DestRect" jetzt blöd benannnt, denn das das ist jetzt ein SourceRect. ;-)

Daran soll's nicht scheitern!

Gausi hat folgendes geschrieben :

Und die markierten Zeilen sollten das Problem beheben. Mit Left und Top setzt du zwar die linke und obere Ecke, aber nicht die rechte untere Ecke des Rechtecks. Die bleibt immer gleich, und deswegen bekommst du Verzerrungen und Spiegelungen in das Zielbild rein. Alternativ .Bottom und .Right setzen.

Ich habe deinen markierten Code eingefügt, aber es ändert sich nichts.
Ok, die Verzerrungen waren meine Schuld, weil die ImageList nicht leer war, wo auch immer da der Grund liegt. Nun ist sie leer und die Bitmaps sind auch alle klar, aber es werden 25x die Bitmaps der "1. Zeile" in die ImageList eingefügt. Immer nur die ersten fünf Bitmaps!

//Edit: Ich habe irrtümlich den falschen Code auskommentiert und meinen alten, nicht funktionierenden Code um .Bottom und .Right erweitert! Da kann es nicht funktionieren!

Jetzt klappt es!

_________________
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!

Ehemaliges Mitglied Erhaltene Danke: 1

- Nachträglich durch die Entwickler-Ecke gelöscht -

galagher · Verfasst: Fr 07.12.18 16:45

Hier nun die fertige Prozedur:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:

procedure SplitBitmapToImageList(const sFileName: String; Exit_At_BitmapsLimit: Boolean;
  const iXCount, iYCount: Integer; const ImageList: TImageList);
var
  i, c, l, t, xy: Integer;
  aDestRect: TRect;
  tmpBitmap, SourceBitmap: TBitmap;
begin
  i := 0;
  t := 0;
  l := 0;
  xy := iXCount * iYCount;

  aDestRect.Top := t;
  aDestRect.Left := l;
  aDestRect.Width := ImageList.Width;
  aDestRect.Height := ImageList.Height;

  tmpBitmap := TBitmap.Create;
  SourceBitmap := TBitmap.Create;

  SourceBitmap.LoadFromFile(sFileName);

  try
    {ImageList.Width * iXCount und/oder ImageList.Width * iYCount könnte eine Anzahl}
    {an Bitmaps ergeben, die höher als SourceBitmap.Width bzw. SourceBitmap.Height ist}
    if Exit_At_BitmapsLimit then
      if (ImageList.Width * iXCount > SourceBitmap.Width) or
         (ImageList.Height * iYCount > SourceBitmap.Height) then
      exit;

    tmpBitmap.Width := ImageList.Width;
    tmpBitmap.Height := ImageList.Height;

    for c := 1 to xy do
    begin
      tmpBitmap.Canvas.CopyRect(tmpBitmap.Canvas.ClipRect,
        SourceBitmap.Canvas, aDestRect);

      ImageList.Add(tmpBitmap, nil);

      Inc(l, ImageList.Width);  {Nach rechts, also nächstes Teil-Bitmap}

      Inc(i);  {Zähler erhöhen}

      if i = iXCount then    {iXCount erledigt, weiter mit}
      begin  {den nächsten iXCount, iYCount Pixel darunter}
        i := 0;
        l := 0;               {Wieder ganz links beginnen,}
        Inc(t, ImageList.Height);  {iYCount Pixel darunter}
      end;

      aDestRect.Left := l;
      aDestRect.Top := t;
      aDestRect.Width := ImageList.Width;
      aDestRect.Height := ImageList.Height;
    end;

  finally
    tmpBitmap.Free;
    SourceBitmap.Free;
  end;
end;

_________________
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme