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:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:

procedure SkalierePf32(Faktor: integer;var OrgBitMap,NachBitMap:TBitmap);
//skaliert auf Faktor/256 mit Faktor aus 0..255
//die BitMap's muessen 32Bit Format und gleich gross sein.
var
  Zeile,Spalte : integer;
  Farbe,
  r,g,b : integer;
  pLinie,
  pTmpLinie : ^Integer;
begin
  If (OrgBitMap.PixelFormat <> pf32bit) OR (NachBitMap.PixelFormat <> pf32bit) then
    exit;
  If (OrgBitMap.width <> NachBitMap.width) then
    exit;
  If (OrgBitMap.height <> NachBitMap.Height) then
    exit;

  If Faktor < $100 then
    begin
    For Zeile := OrgBitMap.height downto 1 do
      begin
      pLinie := OrgBitMap.ScanLine[Zeile-1];
      pTmpLinie := NachBitMap.ScanLine[Zeile-1];
      For Spalte := 1 to OrgBitMap.width do
        begin
        Farbe := pLinie^;
        r := (((Farbe AND $00FF0000)*Faktor+$00001000) shr 8)AND $00FF0000;
        g := (((Farbe AND $0000FF00)*Faktor+$00000010) shr 8)AND $0000FF00;
        b := (((Farbe AND $000000FF)*Faktor+$00000010) shr 8)AND $000000FF;
        pTmpLinie^ := r + g +b;
        inc(pLinie);
        inc(pTmpLinie);
        end;
      end
    end
  else
    //Kopieren der Daten
    begin
    For Zeile := OrgBitMap.height downto 1 do
      begin
      pLinie := OrgBitMap.ScanLine[Zeile-1];
      pTmpLinie := NachBitMap.ScanLine[Zeile-1];
      move(plinie^,pTmpLinie^,4*NachBitMap.width);
      end;
    end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  OrgBild,
  TmpBild : TBitMap;

  Zeile,Spalte,Farbe,Faktor : integer;
  pLinie: ^integer;
  t1,t0: double;
begin
randomize;
Form1.Width := 1024+8;
Form1.Height :=  768+8;

OrgBild := TBitmap.Create;
OrgBild.assign(Form1.GetFormImage);
OrgBild.PixelFormat := pf32Bit;

TmpBild := TBitmap.Create;
TmpBild.assign(Form1.GetFormImage);
TmpBild.PixelFormat := pf32Bit;

Form1.AlphaBlend := true;
t0 := time;

For Faktor := 255 downto 0 do
  begin
  Form1.AlphaBlendValue := Faktor;
  Form1.Update;
  end;
FOr Faktor := 1 to 255 do
  begin
  Form1.AlphaBlendValue := Faktor;
  Form1.Update;
  end;

t1 := time;
Form1.AlphaBlend := false;

{Ein wenig Farbe }
For Zeile := 1 to OrgBild.height do
  begin
  pLinie := OrgBild.ScanLine[Zeile-1];
  For SPalte := 1 to OrgBild.width do
    begin
    pLinie^ := random($01000000);
    inc(pLinie)
    end;
  end;

orgBild.Canvas.TextOut(10,2,'AlphaBlend dauerte '+FormatDateTime('hh:mm:ss.zzz',t1-t0));

t0 := time;
For Faktor := 255 downto 0 do
  begin
  SkalierePf32(Faktor,OrgBild,TmpBild);
  Form1.Canvas.Draw(0,0,TmpBild);
  Form1.update;
  end;

For Faktor := 1 to 256 do
  begin
  SkalierePf32(Faktor,OrgBild,TmpBild);
  Form1.Canvas.Draw(0,0,TmpBild);
  Form1.update;
  end;

t1 := time;

Form1.Canvas.TextOut(400,10,'Farbberechnung dauerte '+FormatDateTime('hh:mm:ss.zzz',t1-t0)+Format(' Breite %d',[OrgBild.Width]));
Form1.Update;

OrgBild.Free;
TmpBild.Free;
end;