Delphi-PRAXiS
Seite 3 von 4     123 4      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Ein Bild mit einer Farbe multiplizieren? (https://www.delphipraxis.net/107175-ein-bild-mit-einer-farbe-multiplizieren.html)

Corpsman 24. Jan 2008 20:40

Re: Ein Bild mit einer Farbe multiplizieren?
 
Die Formel kannte ich noch nicht , sieht aber vielversprechend aus.

Cyberstorm 25. Jan 2008 12:42

Re: Ein Bild mit einer Farbe multiplizieren?
 
Danke! :-).

macht genau das, was photoshop macht - was ich will :-)

Cyberstorm 25. Jan 2008 12:53

Re: Ein Bild mit einer Farbe multiplizieren?
 
fall noch jemand eine copy & paste lösung braucht:

Delphi-Quellcode:
type
  TRGB = record
    Blue: Byte;
    Green: Byte;
    Red: Byte;
  end;

  PRGB = ^TRGB;

procedure Multi(src: TBitmap; r, g, b: Integer; Intensiv: Byte);
var
  P: PRGB;
  y, x: integer;
begin
  for y:=0 to src.Height-1 do
    begin
      P:=src.scanline[y];
      for x:=0 to src.Width-1 do
        begin
          P.Blue:=Round( ((P.Blue * (255 - Intensiv) + P.Blue * b * Intensiv / 255) / 255) );
          P.Green:=Round( ((P.Green * (255 - Intensiv) + P.Green * g * Intensiv / 255) / 255) );
          P.Red:=Round( ((P.Red * (255 - Intensiv) + P.Red * r * Intensiv / 255) / 255) );
          Inc(P);
        end;
    end;
end;
anmerkung: muss man nicht als funktion machen oder das bitmap als var parameter übergeben, da scanline ja speicheradressen zurückliefert und diese dann auch direkt im speicher geändert werden.

Phantom1 26. Jan 2008 10:07

Re: Ein Bild mit einer Farbe multiplizieren?
 
@Cyberstorm: du kannst deinen code noch etwas vereinfachen und auf geschwindigkeit optimieren, ich hab das mal für dich gemacht :wink:

Delphi-Quellcode:
procedure Multi(src: TBitmap; r, g, b, Intensiv: Byte);
var
  P: PRGBTriple;
  xy: integer;
begin
  if src.PixelFormat<>pf24bit then
    src.PixelFormat:=pf24bit;

  P:=src.scanline[src.Height-1];
  for xy:=0 to src.Height*src.Width-1 do begin
    P.rgbtBlue := (P.rgbtBlue shl 8 * not Intensiv + P.rgbtBlue * Succ(b) * Intensiv) shr 16;
    P.rgbtGreen := (P.rgbtGreen shl 8 * not Intensiv + P.rgbtGreen * Succ(g) * Intensiv) shr 16;
    P.rgbtRed  := (P.rgbtRed  shl 8 * not Intensiv + P.rgbtRed  * Succ(r) * Intensiv) shr 16;
    Inc(P);
  end;
end;
mfg

Muetze1 26. Jan 2008 17:12

Re: Ein Bild mit einer Farbe multiplizieren?
 
Zitat:

Zitat von Phantom1
@Cyberstorm: du kannst deinen code noch etwas vereinfachen und auf geschwindigkeit optimieren, ich hab das mal für dich gemacht :wink:

Du beachtest nicht das padding zwischen den einzelnen ScanLines! Jede ScanLine ist 32 Bit aligned und da du mit 24 bpp arbeitest ist nur jeder 4. Pixel 32 bit aligned und somit hast du eine große Chance auf falsche Pixeldaten zu zu greifen.
Hierbei wird dies aber nicht auffallen, da mit jedem Byte das gleich gemacht wird. Aus diesem Grund könntest du auch gleich mit einem PByte arbeiten.

Phantom1 26. Jan 2008 18:42

Re: Ein Bild mit einer Farbe multiplizieren?
 
Zitat:

Zitat von Muetze1
Du beachtest nicht das padding zwischen den einzelnen ScanLines! Jede ScanLine ist 32 Bit aligned und da du mit 24 bpp arbeitest ist nur jeder 4. Pixel 32 bit aligned und somit hast du eine große Chance auf falsche Pixeldaten zu zu greifen.
Hierbei wird dies aber nicht auffallen, da mit jedem Byte das gleich gemacht wird. Aus diesem Grund könntest du auch gleich mit einem PByte arbeiten.

Oh stimmt, da ich sonst immer mit 32bit arbeite hab ich jetzt im moment garnicht daran gedacht...

Hier die korrigierte Version:
Delphi-Quellcode:
procedure Multi(src: TBitmap; r, g, b, Intensiv: Byte);
var
  P: PRGBTriple;
  x, y: integer;
begin
  if src.PixelFormat<>pf24bit then
    src.PixelFormat:=pf24bit;

  for y:=0 to src.Height-1 do begin
    P:=src.scanline[y];
    for x:=0 to src.Width-1 do begin
      P.rgbtBlue := (P.rgbtBlue shl 8 * not Intensiv + P.rgbtBlue * Succ(b) * Intensiv) shr 16;
      P.rgbtGreen := (P.rgbtGreen shl 8 * not Intensiv + P.rgbtGreen * Succ(g) * Intensiv) shr 16;
      P.rgbtRed  := (P.rgbtRed  shl 8 * not Intensiv + P.rgbtRed  * Succ(r) * Intensiv) shr 16;
      Inc(P);
    end;
  end;
end;

Muetze1 26. Jan 2008 18:47

Re: Ein Bild mit einer Farbe multiplizieren?
 
Wie gesagt: der Code funktioniert auch in der vorherigen Version, da du mit jedem Byte die selbe Berechnung machst und weil die Padding Bytes auch einfach mit umgerechnet werden - aber da die nicht genutzt werden, ist das somit ohne Bedeutung.

Phantom1 26. Jan 2008 21:53

Re: Ein Bild mit einer Farbe multiplizieren?
 
Zitat:

Zitat von Muetze1
Wie gesagt: der Code funktioniert auch in der vorherigen Version, da du mit jedem Byte die selbe Berechnung machst und weil die Padding Bytes auch einfach mit umgerechnet werden - aber da die nicht genutzt werden, ist das somit ohne Bedeutung.

Doch es können Bild-Fehler im obigen code entstehen. Es werden zwar diese "nutzlosen" Bytes auch umgerechnet (was eigentlich nichts macht), jedoch fehlen dann zum schluß genau diese anzahl an bytes bzw pixel zur umrechnung. Je nach größe des Bildes bleiben dann viele Pixel unbearbeitet.

Muetze1 26. Jan 2008 23:18

Re: Ein Bild mit einer Farbe multiplizieren?
 
Zitat:

Zitat von Phantom1
Doch es können Bild-Fehler im obigen code entstehen. Es werden zwar diese "nutzlosen" Bytes auch umgerechnet (was eigentlich nichts macht), jedoch fehlen dann zum schluß genau diese anzahl an bytes bzw pixel zur umrechnung. Je nach größe des Bildes bleiben dann viele Pixel unbearbeitet.

Aso, stümmt, das hatte ich nicht bedacht.

Cyberstorm 27. Jan 2008 21:28

Re: Ein Bild mit einer Farbe multiplizieren?
 
vielen dank! aber der spass mit dem einfärben ist leider nicht wirklich zeitfressend.

optimiert lieber die hauptschleife hier :-) (die braucht über ne stunde für alle 160.000 bilder trotz 4x3Ghz) :P.
also allgemein geht es darum, dass ich ein mosaikbild errechne. dafür habe ich testpunkte, die ich mit teilen des originalbildes vergleiche. das ganze passiert in 4 threads --> 4 kataloge, weil quad core

bin offen für jede form von kritik!:

Delphi-Quellcode:
const
  TestPointsX = 56;
  TestPointsY = 42;
  MaxInt64 = Int64($7FFFFFFFFFFFFFFF);
  BELOW_NORMAL_PRIORITY_CLASS = $00004000;

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;
    Used: Boolean;
    RefPoints: TRefPoints;
  end;

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

  TImageTableEntry = record
    FileName: string;
    Match: Int64;
    CatThreadAddID: Byte;
    PicID: Integer;
    Avg: TRGB;
  end;

  TRndFillGrid = record
     ImgDone: array of Boolean;
     PicsLeft: Integer;
  end;

  TImageCompareThread = class(TThread)
    private
      procedure DrawStatus;
    protected
      procedure Execute; override;
    public
      CatID: Byte;
      SourcePic: array of TRefPoints;
      RndFillGrid: TRndFillGrid;
      B: TBitmap;
      P: PRGB;
      Terminating: Bool;
      constructor Create(CatalogID: Byte); virtual;
  end;


var
  ImageTable: array of TImageTableEntry;
  cs: TRTLCriticalSection;
  ImageCompareThread: array[1..4] of TImageCompareThread;
  Catalogs: array[1..4] of TCatalogue;
  ThreadReady: array[1..4] of Boolean;

procedure TImageCompareThread.Execute;
var
  i, j, k, m: Integer;
  Match: Int64;
begin
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_BELOW_NORMAL);
  {$IFDEF NO_RANDOM_FILL}
   for m:=0 to Length(SourcePic)-1 do
     begin
  {$ELSE}
   while RndFillGrid.PicsLeft>0 do
     begin
       m:=-1;
       while m=-1 do
         begin
           m:=Random(2350);
           if RndFillGrid.ImgDone[m] then m:=-1
            else
             begin
               Dec(RndFillGrid.PicsLeft);
               RndFillGrid.ImgDone[m]:=True;
               Synchronize(DrawStatus);
             end;
         end;
      {$ENDIF}
      if Terminating then
        begin
          self.Terminate;
          exit;
        end;
      EnterCriticalSection(cs);
      if ImageTable[m].FileName='' then ImageTable[m].Match:=MaxInt64;
      LeaveCriticalSection(cs);
      for i:=0 to Catalogs[CatID].Count-1 do
        begin
          Match:=0;
          for j:=0 to TestPointsX-1 do
           for k:=0 to TestPointsY-1 do
            begin //die nächsten drei zeilen werden verdammt oft durchgegangen...
              Inc(Match, Abs(Catalogs[CatID].PicInfoList[i].RefPoints[j, k].Blue - SourcePic[m, j, k].Blue));
              Inc(Match, Abs(Catalogs[CatID].PicInfoList[i].RefPoints[j, k].Green - SourcePic[m, j, k].Green));
              Inc(Match, Abs(Catalogs[CatID].PicInfoList[i].RefPoints[j, k].Red - SourcePic[m, j, k].Red));
            end;
          EnterCriticalSection(cs);
          if (Match < ImageTable[m].Match) and (Catalogs[CatID].PicInfoList[i].Used <> True) then
            begin
              if ImageTable[m].FileName<>''
               then Catalogs[ImageTable[m].CatThreadAddID].PicInfoList[ImageTable[m].PicID].Used:=False;
              ImageTable[m].CatThreadAddID:=CatID;
              ImageTable[m].PicID:=i;
              ImageTable[m].Match:=Match;
              ImageTable[m].FileName:=Catalogs[CatID].PicInfoList[i].FileLocation;
              Catalogs[CatID].PicInfoList[i].Used:=True;
            end;
          LeaveCriticalSection(cs);
        end;
    end;
  EnterCriticalSection(cs);
  ThreadReady[CatID]:=True;
  LeaveCriticalSection(cs);
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:03 Uhr.
Seite 3 von 4     123 4      

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