procedure SWColor(Src, Dst: TBitmap); 
var 
  Hlp: TBitmap; 
  P1, P2: PByteArray; 
  X, Y, B3: Integer; 
  B: Byte; 
  procedure vorbereitung(bm: TBitmap); 
  begin 
    with bm do 
    begin 
      Width := Src.Width; 
      Height := Src.Height; 
      PixelFormat := pf24Bit; 
    end; 
  end; 
  procedure Verlauf(cv: TCanvas; Rect: TRect; C: Array of TColor); 
  type 
    RgbArray = Array [0 .. 2] of Byte; 
  var 
    X, Y, Z, Stelle, Mx, Bis, Fach, Mass: Integer; 
    Faktor: double; 
    A: RgbArray; 
    B: Array of RgbArray; 
  begin 
    Mx := high(C); 
    Mass := Rect.bottom - Rect.top; 
    setlength(B, Mx + 1); 
    for X := 0 to Mx do 
    begin 
      C[X] := colortorgb(C[X]); 
      B[X][0] := getrvalue(C[X]); 
      B[X][1] := getgvalue(C[X]); 
      B[X][2] := getbvalue(C[X]); 
    end; 
    cv.Pen.Width := 1; 
    cv.Pen.Style := psSolid; 
    Fach := round(Mass / Mx); 
    for Y := 0 to Mx - 1 do 
    begin 
      if Y = Mx - 1 then 
        Bis := Mass - Y * Fach - 1 
      else 
        Bis := Fach; 
      for X := 0 to Bis do 
      begin 
        Stelle := X + Y * Fach; 
        if Bis = 0 then 
          Faktor := 1 
        else 
          Faktor := X / Bis; 
        for Z := 0 to 2 do 
          A[Z] := Trunc(B[Y][Z] + ((B[Y + 1][Z] - B[Y][Z]) * Faktor)); 
        cv.Pen.Color := RGB(A[0], A[1], A[2]); 
        cv.MoveTo(Rect.left, Rect.top + Stelle); 
        cv.LineTo(Rect.right, Rect.top + Stelle); 
      end; 
    end; 
    B := nil; 
  end; 
 
begin 
  B3 := Src.Width * 3; 
  Hlp := TBitmap.Create; 
  vorbereitung(Dst); 
  vorbereitung(Hlp); 
  Dst.Canvas.Draw(0, 0, Src); 
  Verlauf(Hlp.Canvas, Hlp.Canvas.ClipRect, [clBlue, $33FF00, clMaroon]); 
  for Y := 0 to Dst.Height - 1 do 
  begin 
    X := 0; 
    P1 := Dst.ScanLine[Y]; 
    P2 := Hlp.ScanLine[Y]; 
    while X < B3 do 
    begin 
      B := Trunc(P1[X] * 0.11 + P1[X + 1] * 0.59 + P1[X + 2] * 0.3); 
      P1[X] := (B * 2 + P2[X]) div 3; 
      P1[X + 1] := (B * 2 + P2[X + 1]) div 3; 
      P1[X + 2] := (B * 2 + P2[X + 2]) div 3; 
      inc(X, 3); 
    end; 
  end; 
  Hlp.Free; 
end; 
 
 
 
// Beispiel für zwei Images, in denen JPegs sind 
 
procedure TForm2.Button1Click(Sender: TObject); 
var 
  bmp1: TBitmap; 
  bmp2: TBitmap; 
begin 
  bmp1 := TBitmap.Create; 
  bmp2 := TBitmap.Create; 
  bmp1.Assign(Image1.Picture.Graphic); 
  SWColor(bmp1, bmp2); 
  Canvas.Draw(Image1.BoundsRect.right + 2, Image1.top, bmp2); 
  bmp1.Assign(Image2.Picture.Graphic); 
  SWColor(bmp1, bmp2); 
  Canvas.Draw(Image2.BoundsRect.right + 2, Image2.top, bmp2); 
  bmp2.Free; 
  bmp1.Free; 
end;