Einzelnen Beitrag anzeigen

Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#13

Re: Bestimmte Grafik aus einer einzigen Resource laden?

  Alt 10. Jul 2008, 13:57
Delphi-Quellcode:
type
  TRectArray = array of TRect;
  TBitmapArray = array of TBitmap;

// Zwei Funktionen die Rechtecke aufbereiten:
function FixRect(SrcRect: TRect): TRect;
  procedure Switch(var a,b: integer);
  var c: integer;
  begin
    c := a; a := b; b := c;
  end;
begin
  if SrcRect.Left > SrcRect.Right then
    Switch(SrcRect.Left,SrcRect.Right);
  if SrcRect.Top > SrcRect.Bottom then
    Switch(SrcRect.Top,SrcRect.Bottom);
  result := SrcRect;
end;
function TrimRect(SrcRect: TRect; minx,miny,maxx,maxy: integer): TRect;
begin
  result := fixrect(srcrect);
  if result.Left < minx then result.left := minx;
  if result.top < miny then result.top := miny;
  if result.right > maxx then result.right := maxx;
  if result.bottom > maxy then result.bottom := maxy;
end;

// Stanzt die in SrcRect übergebenen rechtecke aus SrcPNG aus und lädt sie ins
// DstBitmapArray
procedure GetBitmaps(const SrcPNG: TPNGObject; const SrcRects: TRectArray;
  var DstBitmapArray: TBitmapArray);
var
  i: integer;
  Rct: TRect;
  Bmp: TBitmap;
begin
  // Bitmap vom PNG Erzeugen
  Bmp := TBitmap.Create;
  Bmp.Assign(SrcPNG);
  // Länge der auszugebenden Bilderliste festlegen (=Anzahl der Rechtecke)
  setlength(DstBitmapArray,high(SrcRects)+1);
  for i := 0 to high(SrcRects) do
  begin
    // Bitmap erzeugen
    DstBitmapArray[i] := TBitmap.Create;
    // Rechteck vorbereiten mit obigen Funktionen (ggf Zurechtschneiden,
    // falls es über die Grenzen des PNGs hinausgeht)
    Rct := TrimRect(SrcRects[i],0,0,SrcPng.Width,SrcPNG.Height);
    // Größe des Bitmaps setzen
    DstBitmapArray[i].SetSize(rct.Right-rct.left,rct.bottom-rct.top);
    // rechteck ausstanzen und auf Bitmap kopieren
    BitBlt(DstBitmapArray[i].Canvas.Handle,0,0,DstBitmapArray[i].width,
      DstBitmapArray[i].Height,bmp.Canvas.handle,rct.left,rct.top,srccopy);
  end;
  Bmp.free;
end;

// Stanzt ebenfalls Bilder aus dem PNG aus, die rechtecke werden aber im
// Parameter Positions testbasiert übergeben. jede Zeile definiert ein rechteck
// Die Koordinaten des Rechtecks werden in der reihenfolge Left, Top, Right, Bottom
// angegeben und durch Kommata separiert. Beispiel:
// 0,0,100,50
// 100,0,100,100
// etc...
procedure LoadBitmaps(const SrcPNG: TPNGObject; const Positions: TStrings;
  var DstBitmapArray: TBitmapArray);
var
  i: integer;
  l: integer;
  rectarray: TRectArray;
  tmp: tstringlist;
begin
  setlength(rectarray,positions.Count);
  l := 0;
  tmp := tstringlist.Create;
  tmp.Delimiter := ',';
  for i := 0 to positions.count - 1 do
  begin
    tmp.DelimitedText := Positions[i];
    if TryStrToInt(trim(tmp[0]),rectarray[l].Left) and
       TryStrToInt(trim(tmp[1]),rectarray[l].Top) and
       TryStrToInt(trim(tmp[2]),rectarray[l].Right) and
       TryStrToInt(trim(tmp[3]),rectarray[l].Bottom) then
      inc(l);
  end;
  setlength(rectarray,l);
  GetBitmaps(srcpng,rectarray,dstbitmaparray);
  tmp.free;
end;
Ein einfach gehaltenes Beispiel. listen wären besser als Arrays, hätten den Code aber zu sehr aufgebläht. (Wie fast immer bei mir) ist das ganze ungetestet, aber zumindest das Prinzip sollte klar sein.

Wobei die Lösung per Memorystream sowohl im Aufwand als auch in der Dateigröße allerdings elegeanter ist... In einem meiner eigenen projekte habe ich es mit XML gelöst (was aber den nachteil hat, dass Binärdateien Base64 enkodiert werden, was wieder etwas speicher kostet.) Aber das Schöne an objektorientierter Programmierung ist ja, dass ich die Klasse bei bedarf einfach austauschen könnte
  Mit Zitat antworten Zitat