type
  TProcTexStage = record
                    Image : TImage;
                    ScrollBox : TScrollBox;
                    Stage : Byte;
                    StageLabel : TLabel;
                  end;
  ...
    HeightMap : TBitMap;

    ProceduralTex : TBitMap;
    ProcTexs : Array of TProcTexStage;
  ...

...
var
  X,Y, HeightMapHeight : LongInt;
  ...
begin
  //Texturen sind bereits sortiert...
  if Length(ProcTexs) < 2 then
    Exit;
  //Größe anpassen
  ProceduralTex.Width := HeightMap.Width;
  ProceduralTex.Height := HeightMap.Height;

  for X := 0 to HeightMap.Width - 1 do
    for Y := 0 to HeightMap.Height - 1 do
    begin
      HeightMapHeight :=
         Trunc((HeightMap.Canvas.Pixels[X,Y]/clWhite)*255);
      //Farbwert zuweisen
      ...
    end
end;

var
  ...
  I : Integer;
  Upper, Lower : LongInt;
  LevelDifference : LongInt; //Levelunterschied zw. Upper u. Lower
  LowerDifference : LongInt; //Abstand HeightmapHeight - Lower
  LowerRGB, UpperRGB : TRGB; //RGB werte von Upper Lower
  Prozent : Single;          //Prozent der eingesetzten Farbwerte
  FinalRGB : TRGB;           //End RGB Wert

      ...
      HeightMapHeight := Trunc(
             (HeightMap.Canvas.Pixels[X,Y]/clWhite)*255);
      Upper := 0;
      Lower := 0;
      //Intervall suchen, das für diese Höhenstufe interessant ist
      // Schonmal was von binärer Suche gehört? 
      for I := 1 to Length(ProcTexs)-1 do
        if HeightMapHeight <= ProcTexs[I].Stage then
        begin
          Upper := I;
          Lower := I -1;
          Break
        end;
      Assert(Upper <> 0);
      LevelDifference := ProcTexs[Upper].Stage - ProcTexs[Lower].Stage;
      LowerDifference := HeightMapHeight - ProcTexs[Lower].Stage;
      Assert(LevelDifference <> 0);
      Prozent := LowerDifference / LevelDifference;
      ...

  procedure MakeRGB(Color : TColor; var RGB : TRGB);
  begin
    Move(Color, RGB[0], 3)
  end;

      ...
      Prozent := LowerDifference / LevelDifference;

      MakeRGB(ProcTexs[Lower].Image.Canvas.
           Pixels[X mod ProcTexs[Lower].Image.Width,
           Y mod ProcTexs[Lower].Image.Height],LowerRGB);
      MakeRGB(ProcTexs[Upper].Image.Canvas.
           Pixels[X mod ProcTexs[Upper].Image.Width,
           Y mod ProcTexs[Upper].Image.Height],UpperRGB);

      for I := 0 to 2 do
        FinalRGB[I] := Trunc(
                    (UpperRGB[I] - LowerRGB[I])*Prozent +
                                 LowerRGB[I]);
        //    y      =       (            m            )*   x    +      t
      ProceduralTex.Canvas.Pixels[X,Y] := RGB(FinalRGB[0],
                                       FinalRGB[1],
                                       FinalRGB[2])

...
type
  TNormalMap = Array of Array[0..2] of ShortInt;
...

  procedure CreateNormalMap(HM : TBitMap; HeightScale : Single;
                               var NormalMap : TNormalMap);
  begin
    ...
  end;
...
var
  NormalMap : TNormalMap;
  HeightMapScale : Single;
  NormalMap : TNormalMap;

begin
  Sun[0] := Cos(LightRotation.Position*Pi/180);
  Sun[1] := (LightHeight.Max - LightHeight.Position)/100;
  Sun[2] := Sin(LightRotation.Position*Pi/180);
  HeightMapScale := HeightScaleEdit.Value;

  LightMapTex.Width := HeightMap.Width;
  LightMapTex.Height := HeightMap.Height;

  CreateNormalMap(HeightMap, HeightMapScale, NormalMap);

  CreateLightMap(HeightMap, HeightMapScale, NormalMap, Sun, LightMapTex,
    AmbientLight.Position / 100, DiffuseLight.Position/100,
    RaytracingCheckBox.Checked)
end;

  procedure CreateNormalMap(HM : TBitMap; HeightScale : Single;
                               var NormalMap : TNormalMap);
  const
    VertexPoss : Array[0..8] of Array[0..1] of ShortInt =
      ((0,0),(1,-1),(1,0),(1,1),(0,1),(-1,1),(-1,0),(-1,-1),(0,-1));
    Faces : Array[0..7] of Array[0..2] of Byte =
      ((0,1,8),(0,2,1),(0,4,2),(4,3,2),(0,5,4),(0,6,5),(0,8,6),(8,7,6));
  var
    X,Z : LongInt;
    I : LongInt;

    Vertieces : Array[0..8] of TVertex;
    Normals   : Array[0..7] of TVertex;
  begin
    SetLength(NormalMap, HM.Width*HM.Height);
    FillChar(Vertieces[0,0], SizeOf(Vertieces), 0);
    for Z := 0 to HM.Height - 1 do
      for X := 0 to HM.Width - 1 do
      begin
        //Vertieces holen
        for I := 0 to 8 do
        begin
          Vertieces[I][0] := X + VertexPoss[I][0]*VertexPosMultiply;
          Vertieces[I][2] := Z + VertexPoss[I][1]*VertexPosMultiply;
          Vertieces[I][1] := HM.Canvas.Pixels[X + VertexPoss[I][0], Z +
                          VertexPoss[I][1]]
            /clWhite*255*HeightScale
        end;
        //Normalen holen
        for I := 0 to 7 do
        begin
          Normals[I] := VectorCrossProduct(
            VectorNormalize(VectorSubtract(Vertieces[Faces[I][0]],
               Vertieces[Faces[I][1]])),
            VectorNormalize(VectorSubtract(Vertieces[Faces[I][1]],
               Vertieces[Faces[I][2]])));
          Normals[I] := VectorNormalize(Normals[I])
        end;
        //Den "Durchschnittsvektor"...
        for I := 1 to 7 do
          Normals[0] := VectorAdd(Normals[0], Normals[I]);
        Normals[0] := VectorScale(VectorNormalize(Normals[0]),127.0);
        NormalMap[Z*(HM.Height) + X][0] := Trunc(Normals[0][0]);
        NormalMap[Z*(HM.Height) + X][1] := Trunc(Normals[0][1]);
        NormalMap[Z*(HM.Height) + X][2] := Trunc(Normals[0][2])
      end
  end;

  procedure CreateLightMap(HM : TBitMap; HeightMapScale : Single;
    NormalMap : TNormalMap; Sun : TVertex; LightMap : TBitMap;
    LightAmbient, LightDiffuse : Single; Raytracing : Boolean);

  type
    TRay = record
             Origin, Direction : TVertex
           end;

  var
    HeightMapData : Array of Array of byte;

    procedure PrecacheHeightmap;
    var
      X,Z : LongInt;
    begin
      //Läd die Heightmap in ein Delphi Array
      SetLength(HeightMapData, HM.Width);
      for X := 0 to Length(HeightMapData) -1 do
        SetLength(HeightMapData[X], HM.Height);

      for Z := 0 to HM.Height - 1 do
        for X := 0 to HM.Width - 1 do
          HeightMapData[X,Z] := Trunc(HM.Canvas.Pixels[X,Z]/clWhite * 255)
    end;

    function RayIntersected(Ray : TRay; HM : TBitMap;
                                HeightMapScale : Single):Boolean;
    begin
      Result := False;
    end;

  var
    X,Z : LongInt;
    Ray : TRay;
    n : TVertex;
    f : Single;
  begin
    if Raytracing then PrecacheHeightmap;

    //Wir haben paraleles Licht, also bleibt der Richtungsvektor des
    //Rays immer gleich
    Ray.Direction := VectorNormalize(Sun);


    for Z := 0 to HM.Height - 1 do
      for X := 0 to HM.Width - 1 do
      begin
        Ray.Origin[0] := X;
        Ray.Origin[1] := HM.Canvas.Pixels[X,Z]/clWhite*255*HeightMapScale;
        Ray.Origin[2] := Z;
        if RayTracing and RayIntersected(Ray, HM, HeightMapScale) then
          f := LightAmbient
        else begin
          //Komprimierte Normale zurückverwandeln
          n[0] := NormalMap[Z*(HM.Height) + X][0];
          n[1] := NormalMap[Z*(HM.Height) + X][1];
          n[2] := NormalMap[Z*(HM.Height) + X][2];

          f := LightAmbient+LightDiffuse*(VectorDotProduct(
          VectorNormalize(n),VectorNormalize(Ray.Direction)));
          //Zuviel licht?
          if f > 1.0 then f := 1.0;
          if f < 0.0 then f := 0.0
        end;
        LightMap.Canvas.Pixels[X,Z] := RGB(Trunc(f*255),
                                       Trunc(f*255),
                                       Trunc(f*255))
      end
  end;

    function RayIntersected(Ray : TRay; HM : TBitMap;
                                HeightMapScale : Single):Boolean;
    var
       Position : TVertex;
       Vor : TVertex;
    begin
      Result := False;
      Position := Ray.Origin;
      Vor := VectorNormalize(Ray.Direction);
      Position := VectorAdd(Position, Vor);
      while (Position[0] > 0) and (Position[0] < HM.Width - 1) and
        (Position[2] > 0) and (Position[2] < HM.Height - 1) do
      begin
        if HeightMapData[Trunc(Position[0]), Trunc(Position[2])]*
          HeightMapScale >= Position[1] then
        begin
          Result := True;
          Break
        end;
        Position := VectorAdd(Position, Vor)
      end
    end;
    (*Achtung: In diesem Codestück ist eine kleine Performancebremse eingebaut. 
      Wer sie findet kommt deutlich schneller an die ersehnte Textur. 
      Es handelt sich übrigens um eine fehlende Bedingung im while. *)