SetPixel - schnellere Variante

[CReber]

Delphi-Quellcode:

procedure TSmoothlabel.Paint;
  var LTmpPic            : TBitmap;
      LCountX, LCountY   : Integer;
      LColor, LFontColor : TColor;
begin
  LTmpPic := TBitmap.Create;
  LTmpPic.PixelFormat := pf8bit;
  LTmpPic.Width  := Width  * fSmoothFactor;
  LTmpPic.Height := Height * fSmoothFactor;
  LTmpPic.Canvas.Font.Assign(Font);
  //LTmpPic.Canvas.Font.Color := clBlack;
  LTmpPic.Canvas.Font.Height := LTmpPic.Canvas.Font.Height * fSmoothFactor;
  LTmpPic.Canvas.TextOut(0, 0, Caption);
//  Antialiasing(LTmpPic.Canvas, Rect(0, 0, LTmpPic.Width, LTmpPic.Height));
  BmpGBlur(LTmpPic, fSmoothFactor);

  // Hier ist die Geschwindigkeitsbremse denke ich ! Das Bild ist ja bereits Smooth aber es wird Pixel für
  // Pixel für Pixel gezeichnet 
  LTmpPic.Canvas.StretchDraw(Rect(0, 0, Width, Height), LTmpPic);
  LFontColor := Font.Color;
  for LCountY := 0 to Height - 1 do begin
    for LCountX := 0 to Width - 1 do begin
      LColor := GetBlendColor(LFontColor, GetPixel(Canvas.Handle, LCountX, LCountY), GetRValue(GetPixel(LTmpPic.Canvas.Handle, LCountX, LCountY)));
      SetPixel(Canvas.Handle, LCountX, LCountY, LColor);
    end;
  end;


  LTmpPic.Free;
end;

Ich hab leider nicht wirklich einen Durchblick bei den ganzen BitBlt, MaskBlt, SetPixel Routinen und habe nun versucht, die Routine schneller zu gestalten. Leider hat das bisher kaum was gebracht und ich denke man kann das ganze durch die Verwendung von ScanLines verbessern:

Delphi-Quellcode:

  for LCountY := 0 to Height - 1 do begin
    for LCountX := 0 to Width - 1 do begin
      LColor := GetBlendColor(LFontColor, GetPixel(Canvas.Handle, LCountX, LCountY), GetRValue(GetPixel(LTmpPic.Canvas.Handle, LCountX, LCountY)));
      SetPixel(Canvas.Handle, LCountX, LCountY, LColor);
    end;
  end;

//nach

  for LCountY := 0 Height -1 do begin
    pScanLine := LTmpPic.ScanLine[LCountY];
  // und jetzt irgendwie zeichnen - aber davon hab ich keine Ahnung :/

Würde mich freuen, wenn mir jemand helfen könnte...

[CReber]

Also ich suche jetzt schon seid Stunden nach einer Lösung und dachte eigentlich das es hiermit funktionieren müsste, aber nix da ;) Brauche Hilfe!

Delphi-Quellcode:

  LFontColor := Font.Color;
  BitBlt(LTmpPic.Canvas.Handle,  // Vom Bitmap
         0,
         0,
         LTmpPic.Width,
         LTmpPic.Height,
         Canvas.Handle,          // Auf das Control (TSmootLabel)
         0,
         0,
         SRCCOPY);

  {for LCountY := 0 to Height - 1 do begin
    for LCountX := 0 to Width - 1 do begin
      LColor := GetBlendColor(LFontColor, GetPixel(Canvas.Handle, LCountX, LCountY), GetRValue(GetPixel(LTmpPic.Canvas.Handle, LCountX, LCountY)));
      SetPixel(Canvas.Handle, LCountX, LCountY, LColor);
    end;
  end;}
  LTmpPic.Free;

[Elite-Koennen]

Moin'!

Scanline verwende ich folgendermaßen:

[
procedure TForm1.FormClick(Sender: TObject);

type
TPixel = record
B,G,R:Byte;
end;

var
P:^TPixel;
x,y:Integer;

begin
Image1.Picture.Bitmap.LoadFromFile('Dateiname');
for y:=0 to Image1.Height-1 do
begin
P:=Image1.Picture.Bitmap.ScanLine[y];
for x:=0 to Image1.Width-1 do
begin
P.R:=Wert;
P.G:=Wert;
P.B:=Wert;
Inc(P);
end;
end;
end;
]

Hilft das ?

[shmia]

Mit Scanline hat man Zugriff auf eine Zeile eines Bitmaps.
Ein Pixel benötigt im Speicher entweder

• 1 Byte (bei 256 Farben)
• 2 Byte (bei 65536 Farben)
• 3 Byte (bei 24 bit Farben)
• 4 Byte (bei 32 bit Farben)

Je nach Auflösung des Bitmaps muss man nun beim Schreiben & Lesen darauf Rücksicht nehmen.
Bei 256 Farben, kann man die Farbe nicht direkt angeben, sondern nur einen Farbindex in eine Palette.
Bei 65536 Farben ist der Zugriff auf die einzelnen Farbanteile (R,G,B) relativ kompliziert.
24 & 32 bit Farben lassen sich programmtechnisch leicht ansprechen.
Und jetzt lies mal weiter auf: http://www.dsdt.info/tutorials/bitmap/?page=2