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:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:

procedure TForm1.Button1Click(Sender: TObject); 
var x,y,w,h:integer; 
    bild,neu:tBitmap; 
    tmp:tcolor; 
    r,g,b: array of integer; 
    rneu,gneu,bneu:array of integer; 
begin 
    bild:=TBitmap.Create; 
    bild.loadfromfile('C:\dollesBild.BMP'); 
    w:=bild.Width; 
    h:=bild.height; 
    setlength(r,w*h*2); 
    setlength(g,w*h*2); 
    setlength(b,w*h*2); 
    for y:=0 to h-1 do 
        for x:=0 to w-1 do 
        begin 
            tmp:=bild.Canvas.Pixels[x,y]; 
            // Stück für Stück die RGB Werte auslesen 
            // Guck dir die Definition von Tcolor an, dann sollte klar sein, was ich hier mache 
            r[x + y*w]:=tmp MOD 256; 
            tmp:=tmp DIV 256; 
            g[x + y*w]:=tmp MOD 256; 
            tmp:=tmp DIV 256; 
            b[x + y*w]:=tmp MOD 256; 
        end; 

    // Neues Bild erzeugen 
    neu:=tbitmap.Create; 
    neu.Height:=2*h-1; 
    neu.Width:=2*w-1; 

    // Jetzt wirds ein bissel kompliziert mit den Indizes. 
    for y:=0 to h-2 do 
    begin 
        for x:=0 to w-2 do 
        begin 
            neu.Canvas.Pixels[2*x,2*y]:=$00000000 
                + 256*256*b[x + y*w] 
                +     256*g[x + y*w] 
                +         r[x + y*w]; 
            neu.Canvas.Pixels[2*x+1,2*y]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x+1 + y*w])DIV 2) 
                    +256* ((g[x + y*w] +  g[x+1 + y*w])DIV 2) 
                    +     ((r[x + y*w] +  r[x+1 + y*w])DIV 2); 
            neu.Canvas.Pixels[2*x,2*y+1]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x + (y+1)*w])DIV 2) 
                    +256* ((g[x + y*w] +  g[x + (y+1)*w])DIV 2) 
                    +     ((r[x + y*w] +  r[x + (y+1)*w])DIV 2); 
            neu.Canvas.Pixels[2*x+1,2*y+1]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x + (y+1)*w]+b[x+1 + y*w] +  b[x+1 + (y+1)*w])DIV 4) 
                    +256* ((g[x + y*w] +  g[x + (y+1)*w]+g[x+1 + y*w] +  g[x+1 + (y+1)*w])DIV 4) 
                    +     ((r[x + y*w] +  r[x + (y+1)*w]+r[x+1 + y*w] +  r[x+1 + (y+1)*w])DIV 4); 
        end; 
        // lezten Pixel der beiden neuen Zeilen schreiben 
        neu.Canvas.Pixels[2*w-2,2*y]:=$00000000 
                + 256*256*b[w-1 + y*w] 
                +     256*g[w-1 + y*w] 
                +         r[w-1 + y*w]; 
        neu.Canvas.Pixels[2*w-2,2*y+1]:=$00000000 
                + 256*256* ((b[w-1 + y*w] +  b[w-1 + (y+1)*w])DIV 2) 
                +     256* ((g[w-1 + y*w] +  g[w-1 + (y+1)*w])DIV 2) 
                +          ((r[w-1 + y*w] +  r[w-1 + (y+1)*w])DIV 2); 
    end; 
    //Jetzt noch die Letzte Zeile 
    y:=h-1; 
    for x:=0 to w-2 do 
    begin 
        neu.Canvas.Pixels[2*x,2*y]:=$00000000 
                + 256*256*b[x + y*w] 
                +     256*g[x + y*w] 
                +         r[x + y*w]; 
            neu.Canvas.Pixels[2*x+1,2*y]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x+1 + y*w])DIV 2) 
                    +256* ((g[x + y*w] +  g[x+1 + y*w])DIV 2) 
                    +     ((r[x + y*w] +  r[x+1 + y*w])DIV 2); 
    end; 
    // Und den Allerletzten Pixel 
    neu.Canvas.Pixels[2*w-2,2*y]:=$00000000 
            + 256*256*b[w-1 + y*w] 
            +     256*g[w-1 + y*w] 
            +         r[w-1 + y*w]; 

    neu.SaveToFile('C:\dollesgrossesBild.bmp'); 
    neu.Free; 
    bild.Free; 
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

Procedure BmpResize(Bmp: TBitmap; w, h: Integer);
Var TmpBmp: TBitmap;
Begin
  TmpBmp := TBitmap.Create;
  Try
    TmpBmp.PixelFormat:=pf24bit;
    TmpBmp.Width:=w;
    TmpBmp.Height:=h;
    SetStretchBltMode(TmpBmp.Canvas.Handle, HALFTONE);
    StretchBlt(TmpBmp.Canvas.Handle,0,0,w,h,Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,SRCCOPY);
    Bmp.Assign(TmpBmp);
  Finally
    TmpBmp.Free;
  End;
End;