AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Durchschnittsfarbe eines TBitmap via Scanline?
Thema durchsuchen
Ansicht
Themen-Optionen

Durchschnittsfarbe eines TBitmap via Scanline?

Ein Thema von Cyberstorm · begonnen am 21. Jan 2008 · letzter Beitrag vom 22. Jan 2008
Antwort Antwort
Seite 2 von 2     12   
Benutzerbild von Lossy eX
Lossy eX

Registriert seit: 7. Aug 2007
113 Beiträge
 
#11

Re: Durchschnittsfarbe eines TBitmap via Scanline?

  Alt 22. Jan 2008, 11:36
@Muetze1: Nenn mich schwer von Begriff aber eine Sache ist mir nicht ganz klar. Denn für meinen Geschmack hängt deine Beschreibung etwas. Zu mindest auf Basis von normalen Fotos. Denn diese haben eigentlich immer 24 Bit und die Schritte sehen dann wie folgt aus. Ich setze 32 Bit Farbtiefe. Damit wird ein neues Bild erstellt und das aktuelle muss ein Mal komplett eingelesen und konvertiert werden. Schlussendlich muss dann das neue Bild noch ein Mal eingelesen werden um irgendwas damit anzustellen. Das bedeutet für mich, dass ich a) einen höheren Speicherverbrauch habe und ich b) so oder so das Bild 2 Mal einlesen muss. Direkt oder indirekt.

Wenn ich es jetzt aber auf 24 Bit lasse, dann ändert sich doch eigentlich gar nichts. Zu mindest wird doch eigentlich der Vorteil von einem 32 Bit Format doch wieder dadurch zerstört, dass ich erst einmal alle Bilder konvertieren muss. Korrigiere mich bitte wenn ich das falsch sehe.

@Cyberstorm: Übermäßig viele Schleifen solltest du eher vermeiden, denn so etwas kann schon recht auf die Performance schlagen. Genau so wie Dinge die du mehrfach brauchst. Die solltest du nicht doppelt berechnen (l*j-1). Und bitte nicht i, j, k, l als Variablen nehmen.

Delphi-Quellcode:
var
  X, Y, TempX, TempY, TempPointsY, TempPointsX: Integer;
  pTemp: PRGBQuad;
begin
  TempPointsY := TestPointsY -1; // da bei TestPoints = 3 die Pixel Positionen im Array von 0 .. 2 haben.
  TempPointsX := TestPointsX -1;

  for Y := 0 to 210 -1 do begin
    pTemp := P[Y]; // Oder auch direkt Scanline der ersten zu analsierenden Zeile
    TempY := Round(Y * TempPointsY / 210); // Position berechnen sollte so vermutlich gehen

    for X := 0 to 280 -1 do begin
      TempX := Round(X * TempPointsX / 280); // Position berechnen sollte so vermutlich gehen

      average[TempX, TempY, 1] := average[TempX, TempY, 1] + Temp^.rgbBlue;
      average[TempX, TempY, 2] := average[TempX, TempY, 2] + Temp^.rgbGreen;
      average[TempX, TempY, 3] := average[TempX, TempY, 3] + Temp^.rgbRed;

      average[TempX, TempY, 4] := average[TempX, TempY, 4] + 1; // gesetzte Pixel zählen

      Inc(pTemp);
    end;
  end;

  // durch average gehen und Werte durch gesetzte Pixel rechnen.
end;
Habe den Code mal eben so geschrieben als nicht getestet etc. Kann also gut sein, dass er fehlerhaft ist oder gar nicht geht. Das Leeren von average habe ich nicht mit übernommen. Sollte aber so richtig gewesen sein.

Das mit den Pixel zählen kann evtl nötig sein, da durch die Floating Berechnung evtl eine unterschiedliche Anzahl an Pixeln in die einzelnen Felder geschrieben wird.

Um die Berechnung von X nicht dauerhaft durchführen zu müssen kann es noch einiges bringen, wenn du diese vor den Schleifen ein Mal berechnest und in einem LookupArray ablegst. Denn daran wird sich ja wahrscheinlich nichts ändern. Bei Y ist das nicht nötig, da es sowieso nur 1 Mal berechnet wird.

PS: Wobei ich gestehen muss, dass ich gerade nicht weiß wie Resample Algorithmen das machen. Aber wenn ich mich nicht irre werden die mit geringer werdender Zielgröße auch schneller. Und ich glaube die Zielgröße wird bei dir keinen Einfluss auf die Geschwindigkeit haben. Evtl solltest du da mal nach solch einem Algorithmuss schauen.
Ich habe ja keine Vorurteile gegenüber Autofahrern ... aber Fahrer von BMW und Mercedes bestätigen diese regelmäßig.
Außerdem neue technologische Errungenschaften: Serienmäßig eingebaute Rechtsfahrsperre und der stromsparende Blinker.
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#12

Re: Durchschnittsfarbe eines TBitmap via Scanline?

  Alt 22. Jan 2008, 11:59
Zitat von Lossy eX:
@Muetze1: Nenn mich schwer von Begriff aber eine Sache ist mir nicht ganz klar. Denn für meinen Geschmack hängt deine Beschreibung etwas. Zu mindest auf Basis von normalen Fotos. Denn diese haben eigentlich immer 24 Bit und die Schritte sehen dann wie folgt aus. Ich setze 32 Bit Farbtiefe. Damit wird ein neues Bild erstellt und das aktuelle muss ein Mal komplett eingelesen und konvertiert werden. Schlussendlich muss dann das neue Bild noch ein Mal eingelesen werden um irgendwas damit anzustellen. Das bedeutet für mich, dass ich a) einen höheren Speicherverbrauch habe und ich b) so oder so das Bild 2 Mal einlesen muss. Direkt oder indirekt.

Wenn ich es jetzt aber auf 24 Bit lasse, dann ändert sich doch eigentlich gar nichts. Zu mindest wird doch eigentlich der Vorteil von einem 32 Bit Format doch wieder dadurch zerstört, dass ich erst einmal alle Bilder konvertieren muss. Korrigiere mich bitte wenn ich das falsch sehe.
Das Bild wird einmalig eingelesen und dann vom TBitmap Objekt im Speicher gehalten bzw. nur verwaltet. Die GDI behält die Daten mit den Pixelinformationen im Speicher (DIBits). Diese werden bei einer Farbtiefenänderung per WinAPI konvertiert und somit nicht nochmals neu dekodiert oder eingelesen, aber es wird ein neuer Speicherbereich für die neuen Pixeldaten angelegt und die alten dann freigegeben, das stimmt.

Wenn er gleich beim einladen auf 32 Bit dekodieren würde und die Daten immer so halten würde und nur für den Im- oder Export diese wandeln würde, dann wäre ein deutlicher Geschwindigkeitsvorteil zu merken. Afaik macht das die TBitmap32 aus der Graphics32 so und hat dadurch ihren merklichen Geschwindigkeitsvorteil.
  Mit Zitat antworten Zitat
Cyberstorm

Registriert seit: 23. Okt 2003
159 Beiträge
 
Delphi 2010 Architect
 
#13

Re: Durchschnittsfarbe eines TBitmap via Scanline?

  Alt 22. Jan 2008, 13:30
habe es jetzt ganz anders gemacht, damit ich mich nicht mit resample funktionen rumschlagen muss.
habe mit irfanview + batch mir "mini bmp's" gerechnet und lese diese pixel dann nur noch in den internen record.
ist von der sache her ja das gleiche, nur das ich die durchscnittspunkte auf eine etwas andere weise bekomme.

also ich habe es gerade mit beiden varianten getestet und es geht mit pf24bit und rgbtriple statt quad deutlich schneller.

ca. 160.000 bmp's laden mit einer jeweiligen "miniauflösung" von 30x40
jeden pixel in ein rgb - byte array laden (160.000*30*40 pixel) dauert mit pf32bit ca. 20 Sekunden und mit pf24bit ca. 13.5 Sekunden
(das sind die werte nach dem 2. durchlauf, wenn die festplatte den kram im cache hat und es nur noch um cpu geht.)

nachdem die db auf der platte liegt (knapp 600mb) dauert das einlesen des records übrigens nur ca. 1 sekunde.

nicht wundern, habe das ganze in 4 db files und records aufgeteilt, weil ich später noch was multi threading technisches machen will (quad core und so).
hier mal der komplette source (bilder/bzw. db laden, pixel in den record, auf platte speichern)

für weitere geschwindigkeitsverbesserungen gerade im dokumentiert zeitkritischem bereich währe ich sehr dankbar!
villeicht kann ja jemand die zwei zeilen in assembler umbasteln für einen geschwindigkeitsvorteil?:

Delphi-Quellcode:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Jpeg, ExtCtrls, Cyber;

const
  TestPointsX = 40;
  TestPointsY = 30;
  SmallPath = 'F:\kram\pics\small\';

type
  TRGB = record
    Blue: Byte;
    Green: Byte;
    Red: Byte;
  end;

  PRGB = ^TRGB;
  TRefPoints = array[0..TestPointsX-1, 0..TestPointsY-1] of TRGB;

  TPicInfoEntry = record
    FileLocation: string;
    RefPoints: TRefPoints;
  end;

  TCatalogue = record
    PicInfoList: array of TPicInfoEntry;
    Count: Integer;
  end;

  TfrmMain = class(TForm)
    btnOpenDb: TButton;
    procedure btnOpenDbClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure SaveDB(DbId: Byte);
    procedure ReadFromStream(const Stream: TStream; DbId: Byte);
    procedure WriteToStream(const Stream: TStream; DbId: Byte);
    procedure CreateCatalog;
    { Public-Deklarationen }
  end;

var
  frmMain: TfrmMain;
  Catalogs: array[1..4] of TCatalogue;

implementation

{$R *.dfm}

procedure TfrmMain.btnOpenDbClick(Sender: TObject);
var
  s: TFileStream;
  i: Byte;
begin
  if not FileExists(ExtractFilePath(Application.ExeName) + 'PicDb1.dat') then CreateCatalog
  else
   for i:=1 to 4 do
    begin
      s:=TFileStream.Create(ExtractFilePath(Application.ExeName) + 'PicDb' + IntToStr(i) + '.dat', fmOpenRead);
        try
          ReadFromStream(s, i);
        finally
          s.Free;
        end;
    end;
//go on
end;

procedure TfrmMain.ReadFromStream(const Stream: TStream; DbId: Byte);
var
  i: integer;
  BigBuf: Word;
begin
  with Catalogs[DbId] do
    begin
      Stream.Read(Count, SizeOf(Count));
      SetLength(PicInfoList, Count);
      for i:=0 to Count-1 do
       with PicInfoList[i] do
        begin
          Stream.Read(BigBuf, SizeOf(BigBuf));
          SetLength(FileLocation, BigBuf);
          Stream.Read(FileLocation[1], BigBuf);
          Stream.Read(RefPoints, SizeOf(RefPoints));
        end;
    end;
end;

procedure TfrmMain.SaveDB(DbId: Byte);
var
  s: TFileStream;
begin
  s:=TFileStream.Create(ExtractFilePath(Application.ExeName) + 'PicDb' + IntToStr(DbId) + '.dat', fmCreate);
    try
      WriteToStream(s, DbId);
    finally
      s.Free;
    end;
end;

procedure TfrmMain.WriteToStream(const Stream: TStream; DbId: Byte);
var
  i: integer;
  BigBuf: Word;
begin
  with Catalogs[DbId] do
    begin
      Stream.Write(Count, SizeOf(Count));
      for i:=0 to Count-1 do
       with PicInfoList[i] do
        begin
          BigBuf:=Length(FileLocation);
          Stream.Write(BigBuf, SizeOf(BigBuf));
          Stream.Write(FileLocation[1], BigBuf);
          Stream.Write(RefPoints, SizeOf(RefPoints));
        end;
    end;
end;

procedure TfrmMain.CreateCatalog;
var
  i, j, k, l, ActDbNum: Integer;
  P: PRGB;
  B: TBitmap;
  ImageList: TStringList;
begin
  B:=TBitmap.Create;
  ImageList:=TStringList.Create;
    try //dateiliste laden
      ImageList:=ListFilesRecursive(SmallPath, '*.bmp', true);
      for i:=1 to 4 do //4 db files
        begin
          if i<>4 then
            begin
              SetLength(Catalogs[i].PicInfoList, ImageList.Count Div 4);
              Catalogs[i].Count:=ImageList.Count Div 4;
            end
          else
            begin //letzte db file größe richtig setzen, falls nicht gerade durch 4 geteilt worden konnte
              SetLength(Catalogs[4].PicInfoList, (ImageList.Count Div 4) + (ImageList.Count mod 4));
              Catalogs[4].Count:=(ImageList.Count Div 4) + (ImageList.Count mod 4)
            end;
          ActDbNum:=0; //j= dateilistenzähler (muss von 0 bis count durchgehen aber hängt von i ab)
          for j:=( (ImageList.Count Div 4) * (i-1) ) to ( (ImageList.Count Div 4) * (i-1) + (Catalogs[i].Count)-1 ) do
            begin
              B.LoadFromFile(ImageList[j]);
              B.PixelFormat:=pf24bit;
              Catalogs[i].PicInfoList[ActDbNum].FileLocation:=ImageList[j];
              for k:=0 to 29 do
                begin
                  P:=B.ScanLine[k];
                  for l:=0 to 39 do
                    begin //zeitkritischste schleife da am öftesten durchlaufen
                      Catalogs[i].PicInfoList[ActDbNum].RefPoints[l, k]:=P^; //asm?
                      Inc(p); //asm ?
                    end;
                end;
              Inc(ActDbNum);
            end;
          SaveDb(i);
        end;
    finally
      FreeAndNil(B);
      FreeAndNil(ImageList);
    end;
end;

end.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:28 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz