this slowpoke moves

Highlight Color on Bitmap

procedure Highlight(aSource, ATarget: TBitmap; AColor: TColor);
var i, j: Integer;
  s, t: pRGBTriple;
  r, g, b: byte;
  cl: TColor;
begin
  cl := ColorToRGB(AColor);
  r := GetRValue(cl);
  g := GetGValue(cl);
  b := GetBValue(cl);
  aSource.PixelFormat := pf24bit;
  ATarget.PixelFormat := pf24bit;
  ATarget.Width := aSource.Width;
  ATarget.Height := aSource.Height;
  for i := 0 to aSource.Height - 1 do
  begin
    s := ASource.Scanline[i];
    t := ATarget.Scanline[i];
    for j := 0 to aSource.Width - 1 do
    begin
      t^.rgbtBlue := (b * s^.rgbtBlue) div 255;
      t^.rgbtGreen := (g * s^.rgbtGreen) div 255;
      t^.rgbtRed := (r * s^.rgbtRed) div 255;
      inc(s);
      inc(t);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Highlight(Image1.Picture.Bitmap, Image2.Picture.Bitmap, clLime);
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate