// // The multimedia graphics platform GLScene https://github.com/glscene // unit GLS.ShadowHDS; (* Implements an HDS that automatically generates a terrain lightmap texture. Issues: 1:Ambient and Diffuse light properties can not be set to 0, to avoid what seems to be a Delphi bug: If a property of type 'Single' is set to 0, Delphi seems to skip the property's set method at startup, and just uses the default value instead. (Does anyone know a better workaround?) 2:Subsampling is not currently supported. 3:If the light vector's y component is not 0 then the shadow edges may be a bit jagged, due to the crude Bresenham line algorythm that was used. 4:You can hide this by increasing SoftRange though. 5:At some light angles, rounding errors cause various artifacts: (Black tile edges / slight mis-alignments /etc.) 6:Applying materials ocasionally causes AV's PS. The RayCastShadowHeight function returns the height of the shadow at a point on the terrain. This, and the LightVector may come in handy for implementing shadow volumes? *) interface uses System.Classes, System.SysUtils, System.Math, GLS.OpenGLTokens, GLS.VectorLists, GLS.HeightData, GLS.Graphics, GLS.VectorGeometry, GLS.Texture, GLS.VectorTypes, GLS.Coordinates, GLS.Material; type TGLShadowHDS = class; TNewTilePreparedEvent = procedure(Sender: TGLShadowHDS; heightData: TGLHeightData; ShadowMapMaterial: TGLLibMaterial) of object; TThreadBmp32 = procedure(Sender: TGLShadowHDS; heightData: TGLHeightData; bmp32: TGLBitmap32) of object; (* An Height Data Source that generates terrain shadow maps automatically. The HDS must be connected to another HDS, which will provide the elevation data, and to a MaterialLibrary where shadowmaps will be placed. *) TGLShadowHDS = class(TGLHeightDataSourceFilter) private FTileSize: integer; FShadowmapLibrary: TGLMaterialLibrary; FLightVector: TGLCoordinates; FScale: TGLCoordinates; FScaleVec: TVector3f; FOnNewTilePrepared: TNewTilePreparedEvent; FOnThreadBmp32: TThreadBmp32; // FSubSampling : Integer; FMaxTextures: integer; Step: TVector3f; FScanDistance: integer; FSoftRange: cardinal; FDiffuse: single; FAmbient: single; OwnerHDS: TGLHeightDataSource; // The owner of the tile protected procedure SetShadowmapLibrary(const val: TGLMaterialLibrary); procedure SetScale(AValue: TGLCoordinates); procedure SetLightVector(AValue: TGLCoordinates); procedure SetSoftRange(AValue: cardinal); procedure SetDiffuse(AValue: single); procedure SetAmbient(AValue: single); // procedure SetSubSampling(const val : Integer); procedure Trim(MaxTextureCount: integer); // Useful for recycling unused textures, instead of freeing and creating a new one. function FindUnusedMaterial: TGLLibMaterial; function CalcStep: TAffineVector; function CalcScale: TAffineVector; (* Get the number of steps, before the current tile's edge is reached, in the direction of the step vector; *) function WrapDist(Lx, Ly: single): integer; // Converts local tile coordinates to world coordinages. Even if the coordinates are off the tile. procedure LocalToWorld(Lx, Ly: single; HD: TGLHeightData; var Wx: single; var Wy: single); // Takes World coordinates and returns the correct tile, and converted local coordinates procedure WorldToLocal(Wx, Wy: single; var HD: TGLHeightData; var Lx: single; var Ly: single); public // When true, only a blank ShadowMap is generated (FAST), but OnThreadBmp32 is still called in a subthread. SkipGenerate: boolean; constructor Create(AOwner: TComponent); override; destructor Destroy; override; /// procedure Release(aHeightData : TGLHeightData); override; (* This will repeatedly delete the oldest unused texture from the TGLMaterialLibrary, until the texture count drops to MaxTextureCount. DONT use this if you used TGLHeightData.MaterialName to link your terrain textures. Either use with TGLHeightData.LibMaterial, or manually delete unused LightMap textures.*) procedure TrimTextureCache(MaxTextureCount: integer = 0); procedure Notification(AComponent: TComponent; Operation: TOperation); override; // Prepare a blank texture for this tile's lightmap, from the main thread procedure BeforePreparingData(heightData: TGLHeightData); override; // Calculate the lightmap from the HD thread, using the attached blank texture procedure PreparingData(heightData: TGLHeightData); override; procedure AfterPreparingData(heightData: TGLHeightData); override; procedure GenerateShadowMap(heightData: TGLHeightData; ShadowMap: TGLBitmap32; scale: single); (* This traces a ray from a point on the terrain surface, back to the Lightsource, while testing for any intersections with the terrain. It returns the height of the shadow. There is no shadow if the shadow height is equal to terrain height. This is slow, but only needs to be done for pixels along the tile edge, facing the light.*) function RayCastShadowHeight(HD: TGLHeightData; localX, localY: single): single; overload; procedure RayCastLine(heightData: TGLHeightData; Lx, Ly: single; ShadowMap: TGLBitmap32); (* Calculate the pixel brightness, using Direct Diffuse light and Ambient light. DirectLight = 1 if in direct sunlight (no shadows) 0 if in shadow. (Use "SoftRange" for soft shadow edges i.e. 1>Directlight>0 ) AmbientLight = Relative to Angle between surface Normal and sky (Directly up) ie. Vertical walls are darker because they see less sky. DiffuseLight = Relative to Angle between surface Normal, and Sun vector.*) function Shade(heightData: TGLHeightData; x, y: integer; ShadowHeight, TerrainHeight: single): byte; published property ShadowmapLibrary: TGLMaterialLibrary read FShadowmapLibrary write SetShadowmapLibrary; property OnThreadBmp32: TThreadBmp32 read FOnThreadBmp32 write FOnThreadBmp32; // WARNING: This runs in a subthread property OnNewTilePrepared: TNewTilePreparedEvent read FOnNewTilePrepared write FOnNewTilePrepared; property LightVector: TGLCoordinates read FLightVector write SetLightVector; property scale: TGLCoordinates read FScale write FScale; property ScanDistance: integer read FScanDistance write FScanDistance; property SoftRange: cardinal read FSoftRange write SetSoftRange; // Shadow height above sufrace for max diffuse light property Diffuse: single read FDiffuse write SetDiffuse; property Ambient: single read FAmbient write SetAmbient; property MaxTextures: integer read FMaxTextures write FMaxTextures; property OnSourceDataFetched; end; // ------------------------------------------------------------------ implementation // ------------------------------------------------------------------ constructor TGLShadowHDS.Create(AOwner: TComponent); begin inherited Create(AOwner); FLightVector := TGLCoordinates.CreateInitialized(Self, VectorMake(1, 0, -1)); FLightVector.Style := csVector; // csPoint; FScale := TGLCoordinates.CreateInitialized(Self, VectorMake(1, 1, 1)); FScale.Style := csVector; // csPoint; FScanDistance := 64; FAmbient := 0.25; FDiffuse := 0.75; FSoftRange := 1; // FSubSampling:=1; OwnerHDS := Self; // Until told otherwise, assume that ShadowHDS IS the tile owner. SkipGenerate := false; // Set to true in "OnSourceDataFetched" to skip shadow generation. end; destructor TGLShadowHDS.Destroy; begin Self.Active := false; FreeAndNil(FLightVector); FreeAndNil(FScale); ShadowmapLibrary := nil; inherited Destroy; end; procedure TGLShadowHDS.Notification(AComponent: TComponent; Operation: TOperation); begin if Operation = opRemove then begin if AComponent = FShadowmapLibrary then ShadowmapLibrary := nil; end; inherited; end; (* procedure TGLShadowHDS.Release(aHeightData : TGLHeightData); var libMat : TGLLibMaterial; begin HeightDataSource.Data.LockList; libMat:=aHeightData.LibMaterial; aHeightData.MaterialName:=''; if (FMaxTextures>0)and(assigned(LibMat))and(libMat.IsUsed=false) then LibMat.free; inherited; HeightDataSource.Data.UnlockList; end; *) procedure TGLShadowHDS.TrimTextureCache(MaxTextureCount: integer); // Thread-safe Version begin If (not assigned(Self)) or (not assigned(OwnerHDS)) then exit; with OwnerHDS.Data.LockList do try Trim(MaxTextureCount); finally OwnerHDS.Data.UnlockList; end; end; procedure TGLShadowHDS.Trim(MaxTextureCount: integer); // internal use only var matLib: TGLMaterialLibrary; libMat: TGLLibMaterial; i: integer; cnt: integer; begin matLib := FShadowmapLibrary; if matLib <> nil then begin // --------------------------------- // --Trim unused textures, until MaxTextureCount is reached-- cnt := matLib.Materials.Count; i := 0; while (i < cnt) and (cnt >= MaxTextureCount) do begin libMat := matLib.Materials[i]; if libMat.IsUsed then inc(i) else begin libMat.Free; dec(cnt); // cnt:=matlib.Materials.Count; end; end; // ---------------------------------------------------------- end; end; function TGLShadowHDS.FindUnusedMaterial: TGLLibMaterial; var matLib: TGLMaterialLibrary; i: integer; cnt: integer; begin result := nil; matLib := FShadowmapLibrary; if matLib <> nil then begin cnt := matLib.Materials.Count; i := 0; while (i < cnt) and (matLib.Materials[i].IsUsed) do inc(i); if (i < cnt) then result := matLib.Materials[i]; end; end; procedure TGLShadowHDS.SetLightVector(AValue: TGLCoordinates); begin With OwnerHDS.Data.LockList do try FLightVector.Assign(AValue); CalcStep; // MarkDirty; finally OwnerHDS.Data.UnlockList; end; end; function TGLShadowHDS.CalcStep: TAffineVector; var L: single; v: TAffineVector; begin MakeVector(v, FLightVector.x / FScale.x, FLightVector.y / FScale.y, 256 * FLightVector.Z / FScale.Z); L := MaxFloat(abs(v.x), abs(v.y)); Step := VectorScale(v, 1 / L); Step.x := trunc(Step.x * 16384) / 16384; // round down the fraction now, to prevent rounding errors later Step.y := trunc(Step.y * 16384) / 16384; // round down the fraction now, to prevent rounding errors later if ((FLightVector.x = 0) and (FLightVector.y = 0)) then begin Step.x := 1; Step.y := 0; Step.Z := -maxint; end; result := Step; end; function TGLShadowHDS.CalcScale: TAffineVector; begin FScaleVec.x := FScale.x * 256; FScaleVec.y := FScale.y * 256; FScaleVec.Z := FScale.Z; result := FScaleVec; end; procedure TGLShadowHDS.BeforePreparingData(heightData: TGLHeightData); var HD: TGLHeightData; libMat: TGLLibMaterial; MatName: string; begin if not assigned(FShadowmapLibrary) then exit; HD := heightData; OwnerHDS := HD.Owner; with OwnerHDS.Data.LockList do try Trim(FMaxTextures); MatName := 'ShadowHDS_x' + IntToStr(HD.XLeft) + 'y' + IntToStr(HD.YTop) + '.'; // name contains xy coordinates of the current tile libMat := FShadowmapLibrary.Materials.Add; // ---------Recycle Textures--------- // libMat:=self.FindUnusedMaterial; //look for an unused texture, to recycle // if libMat=nil // then libMat:=FShadowmapLibrary.Materials.Add //if no free textures were found, get a new one // else libMat.Material.Texture.Enabled:=false; //recycle the unused texture // ---------------------------------- libMat.Name := MatName; // HD.MaterialName:=LibMat.Name; HD.LibMaterial := libMat; // attach texture to current tile finally OwnerHDS.Data.UnlockList; end; end; procedure TGLShadowHDS.PreparingData(heightData: TGLHeightData); var HD: TGLHeightData; libMat: TGLLibMaterial; bmp32: TGLBitmap32; begin HD := heightData; libMat := HD.LibMaterial; Assert(assigned(HD)); Assert(assigned(libMat)); Assert(libMat.Material.Texture.Disabled); // With heightData.Owner.Data.LockList do try //lock out other threads // Transfer tile texture coordinates to generated texture libMat.TextureScale.x := HD.TextureCoordinatesScale.S; libMat.TextureScale.y := HD.TextureCoordinatesScale.T; libMat.TextureOffset.x := HD.TextureCoordinatesOffset.S; libMat.TextureOffset.y := HD.TextureCoordinatesOffset.T; // ------------------------------------------------------ // --Set up new Lightmap texture for the current tile-- libMat.Material.MaterialOptions := [moNoLighting]; with libMat.Material.Texture do begin ImageClassName := TGLBlankImage.ClassName; MinFilter := miNearestMipmapNearest; // MinFilter:=miLinearMipmapLinear; // MagFilter:=maNearest; MagFilter := maLinear; TextureMode := tmReplace; TextureWrap := twNone; // TextureFormat:=tfLuminance; TextureFormat := tfRGB16; // TextureFormat:=tfRGBA; bmp32 := (Image as TGLBlankImage).GetBitmap32; if not SkipGenerate then GenerateShadowMap(HD, bmp32, 1); if assigned(FOnThreadBmp32) then FOnThreadBmp32(Self, heightData, bmp32); // Enabled:=True; with HD.Owner.Data.LockList do try Enabled := True; finally HD.Owner.Data.UnlockList; end; end; // finally HD.Owner.Data.UnlockList; end; // ---------------------------------------------------- end; procedure TGLShadowHDS.AfterPreparingData(heightData: TGLHeightData); begin if assigned(FOnNewTilePrepared) then FOnNewTilePrepared(Self, heightData, heightData.LibMaterial); end; (* procedure TGLShadowHDS.PreparingData(heightData : TGLHeightData); var HD : TGLHeightData; libMat: TGLLibMaterial; bmp32 : TGLBitmap32; MatName:string; Hold:TGLUpdateAbleObject; lst:TList; begin if not assigned (FShadowmapLibrary) then exit; //--Generate Shadow Map for tile-- lst:=HeightDataSource.Data.LockList; //lock out other threads //Uno.Acquire; HD:=HeightData; MatName:='ShadowHDS_x'+IntToStr(HD.XLeft)+'y'+IntToStr(HD.YTop)+'.'; //name contains xy coordinates of the current tile Hold:=TGLUpdateAbleObject.Create(self); LibMat:=FShadowmapLibrary.Materials.GetLibMaterialByName(MatName); //Check if Tile Texture already exists //if assigned(libmat) then LibMat.Name:='Dirty'; //LibMat:=nil; if LibMat=nil then begin if (FMaxTextures>0)and(HD.Thread=nil) //Dont trim the cache from a sub-thread; then TrimTextureCache(FMaxTextures); //Trim unused textures from the material library //Generate new ShadowMap texture for this tile libMat:=FShadowmapLibrary.Materials.Add; libMat.RegisterUser(Hold); //hold onto the texture, so another thread doesnt delete it //Transfer tile texture coordinates to generated texture libMat.TextureScale.X :=HD.TextureCoordinatesScale.S; libMat.TextureScale.Y :=HD.TextureCoordinatesScale.T; libMat.TextureOffset.X:=HD.TextureCoordinatesOffset.S; libMat.TextureOffset.Y:=HD.TextureCoordinatesOffset.T; //------------------------------------------------------ //--Set up new Lightmap texture for the current tile-- libMat.Material.MaterialOptions:=[moNoLighting]; with libMat.Material.Texture do begin ImageClassName:=TGLBlankImage.ClassName; Enabled:=True; MinFilter:=miNearestMipmapNearest; //MagFilter:=maNearest; MagFilter:=maLinear; TextureMode:=tmReplace; //TextureWrap:=twBoth; TextureWrap:=twNone; //TextureFormat:=tfRGB16; //TextureFormat:=tfRGBA16; TextureFormat:=tfLuminanceAlpha; bmp32:=(Image as TGLBlankImage).GetBitmap32(GL_TEXTURE_2D); GenerateShadowMap(HD , bmp32, 1); end; libMat.Name:=MatName; //---------------------------------------------------- end; //HD.MaterialName:=LibMat.Name; HD.LibMaterial:=LibMat; //attach texture to current tile libMat.UnregisterUser(Hold); Hold.Free; //Uno.Release; HeightDataSource.Data.UnlockList; if Assigned(FOnNewTilePrepared) then FOnNewTilePrepared(Self,HD,libMat); end; *) procedure TGLShadowHDS.GenerateShadowMap(heightData: TGLHeightData; ShadowMap: TGLBitmap32; scale: single); var HD: TGLHeightData; x, y: integer; // in local space sx, sy: single; begin HD := heightData; FTileSize := (HD.Size - 1); ShadowMap.Height := FTileSize; ShadowMap.Width := FTileSize; CalcStep; CalcScale; sx := Step.x; sy := Step.y; if abs(sx) > abs(sy) then begin y := 0; if sx < 0 then x := FTileSize - 1 // right to left else x := 0; // left to right while (y < FTileSize) do begin RayCastLine(HD, x, y, ShadowMap); // cast a shadow line across the tile inc(y); end; end else begin x := 0; if sy < 0 then y := FTileSize - 1 // top to bottom else y := 0; // bottom to top while (x < FTileSize) do begin RayCastLine(HD, x, y, ShadowMap); // cast a shadow line across the tile inc(x); end; end; end; function TGLShadowHDS.RayCastShadowHeight(HD: TGLHeightData; localX, localY: single): single; var tmpHD: TGLHeightData; Wx, Wy: single; Lx, Ly: single; h: single; ctr: integer; rh: single; dif: single; ShadowDif: single; startH: single; jump: integer; begin Lx := ClampValue(localX, 0, FTileSize); Ly := ClampValue(localY, 0, FTileSize); startH := HD.InterpolatedHeight(Lx, Ly); tmpHD := HD; ctr := 0; ShadowDif := 0; rh := startH; jump := 1; while (ctr < FScanDistance) and (tmpHD.DataState <> hdsNone) do begin Lx := Lx - Step.x * jump; Ly := Ly - Step.y * jump; rh := rh - Step.Z * jump; // --jump to new tile-- if (Lx < 0) or (Lx >= FTileSize) or (Ly < 0) or (Ly >= FTileSize) then begin LocalToWorld(Lx, Ly, tmpHD, Wx, Wy); // if our local coordinates are off the tile, WorldToLocal(Wx, Wy, tmpHD, Lx, Ly); // get the new tile, and local coordinates end else begin h := tmpHD.InterpolatedHeight(Lx, Ly); dif := h - rh; ShadowDif := MaxFloat(dif, ShadowDif); if ShadowDif > (-Step.Z) + FSoftRange // if ray is more than 1 steps above the surface then jump := 2 // then take 2 steps at a time else jump := 1; inc(ctr); end; end; result := startH + ShadowDif; // actual height of shadow end; procedure TGLShadowHDS.LocalToWorld(Lx, Ly: single; HD: TGLHeightData; var Wx: single; var Wy: single); var HDS: TGLHeightDataSource; begin HDS := Self.HeightDataSource; Wx := Lx + HD.XLeft; Wy := HDS.Height - HD.YTop - Ly; // wrap terrain //no longer needed? // if wx>=HDS.Width then wx:=wx-HDS.Width; // if wx<0 then wx:=wx+HDS.Width; // if wy>=HDS.Height then wy:=wy-HDS.Height; // if wy<0 then wy:=wy+HDS.Height; end; procedure TGLShadowHDS.WorldToLocal(Wx, Wy: single; var HD: TGLHeightData; var Lx: single; var Ly: single); var HDS: TGLHeightDataSource; XLeft, YTop: integer; Size: integer; begin // wrap terrain //no longer needed? // HDS:=self.HeightDataSource; // if wx>=HDS.Width then wx:=wx-HDS.Width; // if wx<0 then wx:=wx+HDS.Width; // if wy>=HDS.Height then wy:=wy-HDS.Height; // if wy<0 then wy:=wy+HDS.Height; HDS := Self.HeightDataSource; Size := FTileSize; XLeft := floor(Wx / Size) * Size; Lx := Wx - XLeft; YTop := floor((HDS.Height - Wy) / Size) * Size; Ly := (HDS.Height - YTop - Wy); HD := HDS.GetData(XLeft, YTop, Size + 1, hdtSmallInt); end; // ---------------------------------------------------------- procedure TGLShadowHDS.RayCastLine(heightData: TGLHeightData; Lx, Ly: single; ShadowMap: TGLBitmap32); var sh, h: single; HD: TGLHeightData; Size: integer; nmRow: PGLPixel32Array; ctr: integer; px, py: integer; lum: byte; wrapDst: integer; // pink:boolean; // PinkMax:integer; cx, cy: single; procedure LineStep; // draw the pixel, and increase counters begin cx := ClampValue(Lx, 0, Size - 1); cy := ClampValue(Ly, 0, Size - 1); px := trunc(cx); py := trunc(cy); h := HD.InterpolatedHeight(cx, cy); sh := MaxFloat(sh, h); lum := Shade(HD, px, py, sh, h); nmRow := ShadowMap.ScanLine[Size - 1 - py]; nmRow[px].r := lum; nmRow[px].g := lum; nmRow[px].b := lum; nmRow[px].a := 255; // pinkMax:=MinInteger(Integer(lum+8),255); // if pink=true then nmRow[px].r:=pinkMax; Lx := Lx + Step.x; Ly := Ly + Step.y; sh := sh + Step.Z; inc(ctr); end; begin HD := heightData; sh := RayCastShadowHeight(HD, Lx, Ly); Size := FTileSize; ctr := 0; wrapDst := WrapDist(Lx, Ly); // pink:=false; if wrapDst < Size then begin // check if this line will wrap before its end while ctr <= wrapDst do LineStep; // take one exta step, to prevent gaps due to rounding errors Lx := Lx - Step.x; // Ly := Ly - Step.y; // step back, to compensate for the extra step ctr := ctr - 1; // if abs(Step.x) > abs(Step.y) then begin // East or West if Step.y < 0 then Ly := Ly + Size; // ESE or WSW if Step.y > 0 then Ly := Ly - Size; // ENE or WNW end else begin // North or South if Step.x < 0 then Lx := Lx + Size; // NNW or SSW if Step.x > 0 then Lx := Lx - Size; // NNE or SSE end; cx := ClampValue(Lx, 0, Size - 1); cy := ClampValue(Ly, 0, Size - 1); sh := RayCastShadowHeight(HD, cx, cy); sh := sh + Step.Z * 0.4; // pink:=true; end; while ctr < Size do LineStep; // No wrapping end; // ---------------------------------------------------------- function TGLShadowHDS.WrapDist(Lx, Ly: single): integer; var x, y: single; Size: integer; sx, sy: single; begin sx := Step.x; sy := Step.y; Size := FTileSize; x := Size; y := Size; if abs(sx) > abs(sy) then begin if sy > 0 then y := (Size - Ly) / sy; if sy < 0 then y := -Ly / sy; end else begin if sx > 0 then x := (Size - Lx) / sx; if sx < 0 then x := -Lx / sx; end; result := Ceil(minFloat(x, y)); end; function TGLShadowHDS.Shade(heightData: TGLHeightData; x, y: integer; ShadowHeight, TerrainHeight: single): byte; var HD: TGLHeightData; nv: TAffineVector; dot: single; sunVec: TAffineVector; directLight: single; // Range:0-1 (0 if in shadow) (<1 and >0 if near shadow edge) diffuseLight: single; ambientLight: single; Light: single; begin HD := heightData; nv := HD.NormalAtNode(x, y, FScaleVec); // --Ambient Light from blue sky (directly up)-- ambientLight := nv.Z; // --Shadows/Direct light/Soft shadow edges-- directLight := ClampValue(1 - (ShadowHeight - TerrainHeight) / SoftRange, 0, 1); // --Diffuse light, when not in shadow-- if directLight = 0 then diffuseLight := 0 // no direct light (shadow) else begin // diffused light ~ cos of normalVec and lightVec MakeVector(sunVec, LightVector.x, LightVector.y, -LightVector.Z); NormalizeVector(sunVec); dot := VectorDotProduct(nv, sunVec); // cos of the angle between the normal and light diffuseLight := MaxFloat(dot, 0); end; // ------------------------------------- Light := (FDiffuse * diffuseLight * directLight) + (FAmbient * ambientLight); result := round(ClampValue(Light, 0, 1) * 255); end; procedure TGLShadowHDS.SetShadowmapLibrary(const val: TGLMaterialLibrary); begin if val <> FShadowmapLibrary then begin if assigned(FShadowmapLibrary) then FShadowmapLibrary.RemoveFreeNotification(Self); FShadowmapLibrary := val; if assigned(FShadowmapLibrary) then FShadowmapLibrary.FreeNotification(Self); MarkDirty; end; end; procedure TGLShadowHDS.SetScale(AValue: TGLCoordinates); begin with OwnerHDS.Data.LockList do try FScale.Assign(AValue); // CalcScale; // MarkDirty; finally OwnerHDS.Data.UnlockList; end; end; procedure TGLShadowHDS.SetSoftRange(AValue: cardinal); begin with OwnerHDS.Data.LockList do try FSoftRange := MaxInteger(AValue, 1); // MarkDirty; finally OwnerHDS.Data.UnlockList; end; end; procedure TGLShadowHDS.SetDiffuse(AValue: single); begin with OwnerHDS.Data.LockList do try FDiffuse := ClampValue(AValue, 0.001, 1); // MarkDirty; finally OwnerHDS.Data.UnlockList; end; end; procedure TGLShadowHDS.SetAmbient(AValue: single); begin with OwnerHDS.Data.LockList do try FAmbient := ClampValue(AValue, 0.001, 1); // MarkDirty; finally OwnerHDS.Data.UnlockList; end; end; // ------------------------------------------------------------------ initialization // ------------------------------------------------------------------ RegisterClass(TGLShadowHDS); end.