1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

var
  DirectDC : hdc;

  srcbmpHandle: HBITMAP;
  dstbmpHandle: HBITMAP;

  src: Bitmap;
  dst: Bitmap;

  dstbmpInfo: BITMAPINFO;
  i, x,y :integer;
  p1,p2   : pRGB;
begin
  GetObject(Image1.Picture.Bitmap.Handle, sizeof(BITMAP), @src);

  ZeroMemory(@dstbmpInfo,sizeof(BITMAPINFO));
  dstbmpInfo.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
  dstbmpInfo.bmiHeader.biWidth := src.bmWidth;
  dstbmpInfo.bmiHeader.biHeight := src.bmHeight;
  dstbmpInfo.bmiHeader.biPlanes := 1;
  dstbmpInfo.bmiHeader.biBitCount := src.bmBitsPixel;

  DirectDC := CreateCompatibleDC(0);
  dstbmpHandle := CreateDIBSection(DirectDC, dstbmpInfo, DIB_RGB_COLORS, dst.bmBits, 0, 0);
  GetObject(dstbmpHandle, sizeof(BITMAP), @dst);


  FillChar(dst.bmBits^, dst.bmWidth*dst.bmHeight*sizeof(dstbmpInfo.bmiColors), $30);  // dunkelgrau für debug



  p1 := src.bmBits;
  p2 := dst.bmBits;

  for i:=0 to dst.bmWidth*dst.bmHeight-1 do
  begin
       p2^.rBlue  := p2^.rBlue*2 ;
       p2^.rGreen := p1^.rGreen +50;
       p2^.rRed   := p1^.rRed - (p2^.rRed div 2);
       inc(p1);
       inc(p2);
  end;

  SelectObject(DirectDC, dstbmpHandle);
  BitBlt(Image2.Canvas.Handle, 0, 0, dst.bmWidth, dst.bmHeight, directdc, 0,0, SRCCOPY);

  DeleteObject(dstbmpHandle);
  DeleteObject(srcbmpHandle);
  DeleteDC(DirectDC);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

procedure TForm1.Button4Click(Sender: TObject);
var
  x, y, w, h, d, yn: integer;
  p: PRGBQuad;
  qa, qb, qf: Int64;
begin
  // Image1 nach Image2 kopieren und dabei in 32 bit Bitmap umwandeln
  with Image2.Picture.Bitmap do
  begin
    PixelFormat := pf32bit;
    w := Image1.Picture.Width;
    h := Image1.Picture.Height;
    Width := w;
    Height := h;
    Canvas.Draw(0, 0, Image1.Picture.Graphic);
  end;

  QueryPerformanceCounter(qa);

  for y := 0 to h - 1 do
  begin
    p := Image2.Picture.Bitmap.ScanLine[y];
    yn := h - 1 - y;
    d := 255 - 0 - yn;
    for x := 0 to w - 1 do
    begin
      // d := 255 - x - yn;
      if d < 0 then d := 0;
      p^.rgbBlue := (d + p^.rgbBlue) shr 1;
      p^.rgbGreen := (yn + p^.rgbGreen) shr 1;
      p^.rgbRed := (x + p^.rgbRed) shr 1;
      Inc(p);
      Dec(d);
    end;
  end;

  QueryPerformanceCounter(qb);
  QueryPerformanceFrequency(qf);
  Label2.Caption := Format('%.5f ms', [(qb - qa) / qf * 1000]);
end;