Renamed GLTypes to GLVectorRecTypes

Demos/CleanDemos.bat

@@ -72,4 +72,4 @@ for /r %1 %%R in (Debug_Build) do if exist "%%R" (rd /s /q "%%R")
 for /r %1 %%R in (Release_Build) do if exist "%%R" (rd /s /q "%%R")
 for /r %1 %%R in (__history) do if exist "%%R" (rd /s /q "%%R")
 for /r %1 %%R in (__recovery) do if exist "%%R" (rd /s /q "%%R")
-for /r %1 %%R in (__astcache) do if exist "%%R" (rd /s /q "%%R")
+for /r %1 %%R in (__astcache) do if exist "%%R" (rd /s /q "%%R")

Packages/Win32/GLScene_RT.dpk

@@ -104,11 +104,11 @@ contains
   GLFileB3D in '..\..\Source\GLFileB3D.pas',
   GLFileBMP in '..\..\Source\GLFileBMP.pas',
   GLFileDDS in '..\..\Source\GLFileDDS.pas',
-  GLFileDXF in '..\..\Source\GLFileDXF.pas',
+  GLS.FileDXF in '..\..\Source\GLS.FileDXF.pas',
   GLFileGL2 in '..\..\Source\GLFileGL2.pas',
   GLFileGLB in '..\..\Source\GLFileGLB.pas',
   GLFileGLTF in '..\..\Source\GLFileGLTF.pas',
-  GLFileGRD in '..\..\Source\GLFileGRD.pas',
+  GLS.FileGRD in '..\..\Source\GLS.FileGRD.pas',
   GLFileGTS in '..\..\Source\GLFileGTS.pas',
   GLFileHDR in '..\..\Source\GLFileHDR.pas',
   GLFileJPEG in '..\..\Source\GLFileJPEG.pas',
@@ -132,7 +132,7 @@ contains
   GLFileSMD in '..\..\Source\GLFileSMD.pas',
   GLFileSTL in '..\..\Source\GLFileSTL.pas',
   GLFileTGA in '..\..\Source\GLFileTGA.pas',
-  GLFileTIN in '..\..\Source\GLFileTIN.pas',
+  GLS.FileTIN in '..\..\Source\GLS.FileTIN.pas',
   GLFileVRML in '..\..\Source\GLFileVRML.pas',
   GLFileWAV in '..\..\Source\GLFileWAV.pas',
   GLFileX in '..\..\Source\GLFileX.pas',
@@ -196,7 +196,7 @@ contains
   GLPhongShader in '..\..\Source\GLPhongShader.pas',
   GLPictureRegisteredFormats in '..\..\Source\GLPictureRegisteredFormats.pas',
   GLPipelineTransformation in '..\..\Source\GLPipelineTransformation.pas',
-  GLPlugInManager in '..\..\Source\GLPlugInManager.pas',
+  GLS.PlugInManager in '..\..\Source\GLS.PlugInManager.pas',
   GLPluginIntf in '..\..\Source\GLPluginIntf.pas',
   GLPolyhedron in '..\..\Source\GLPolyhedron.pas',
   GLPolynomials in '..\..\Source\GLPolynomials.pas',
@@ -229,7 +229,7 @@ contains
   GLSLVertexDisplacementShader in '..\..\Source\GLSLVertexDisplacementShader.pas',
   GLSLanguage in '..\..\Source\GLSLanguage.pas',
   GLSLog in '..\..\Source\GLSLog.pas',
-  GLSMemo in '..\..\Source\GLSMemo.pas',
+  GLS.Memo in '..\..\Source\GLS.Memo.pas',
   GLSRGBE in '..\..\Source\GLSRGBE.pas',
   GLSRedBlackTree in '..\..\Source\GLSRedBlackTree.pas',
   GLScene in '..\..\Source\GLScene.pas',
@@ -272,7 +272,7 @@ contains
   GLTrail in '..\..\Source\GLTrail.pas',
   GLTree in '..\..\Source\GLTree.pas',
   GLTriangulation in '..\..\Source\GLTriangulation.pas',
-  GLTypes in '..\..\Source\GLTypes.pas',
+  GLVectorRecTypes in '..\..\Source\GLVectorRecTypes.pas',
   GLUserShader in '..\..\Source\GLUserShader.pas',
   GLUtils in '..\..\Source\GLUtils.pas',
   GLVectorGeometry in '..\..\Source\GLVectorGeometry.pas',
@@ -283,7 +283,6 @@ contains
   GLVerletHairClasses in '..\..\Source\GLVerletHairClasses.pas',
   GLVerletSkeletonColliders in '..\..\Source\GLVerletSkeletonColliders.pas',
   GLVerletTypes in '..\..\Source\GLVerletTypes.pas',
-  GLVfsPAK in '..\..\Source\GLVfsPAK.pas',
   GLWaterPlane in '..\..\Source\GLWaterPlane.pas',
   GLWin32Context in '..\..\Source\GLWin32Context.pas',
   GLWin32Viewer in '..\..\Source\GLWin32Viewer.pas',
@@ -293,7 +292,8 @@ contains
   GLzBuffer in '..\..\Source\GLzBuffer.pas',
   OpenGLAdapter in '..\..\Source\OpenGLAdapter.pas',
   OpenGLTokens in '..\..\Source\OpenGLTokens.pas',
-  XOpenGL in '..\..\Source\XOpenGL.pas';
+  XOpenGL in '..\..\Source\XOpenGL.pas',
+  GLFileVfsPAK in '..\..\Source\GLFileVfsPAK.pas';
 
 end.
 

Packages/Win32/GLScene_RT.dproj

@@ -198,11 +198,11 @@
         <DCCReference Include="..\..\Source\GLFileB3D.pas"/>
         <DCCReference Include="..\..\Source\GLFileBMP.pas"/>
         <DCCReference Include="..\..\Source\GLFileDDS.pas"/>
-        <DCCReference Include="..\..\Source\GLFileDXF.pas"/>
+        <DCCReference Include="..\..\Source\GLS.FileDXF.pas"/>
         <DCCReference Include="..\..\Source\GLFileGL2.pas"/>
         <DCCReference Include="..\..\Source\GLFileGLB.pas"/>
         <DCCReference Include="..\..\Source\GLFileGLTF.pas"/>
-        <DCCReference Include="..\..\Source\GLFileGRD.pas"/>
+        <DCCReference Include="..\..\Source\GLS.FileGRD.pas"/>
         <DCCReference Include="..\..\Source\GLFileGTS.pas"/>
         <DCCReference Include="..\..\Source\GLFileHDR.pas"/>
         <DCCReference Include="..\..\Source\GLFileJPEG.pas"/>
@@ -226,7 +226,7 @@
         <DCCReference Include="..\..\Source\GLFileSMD.pas"/>
         <DCCReference Include="..\..\Source\GLFileSTL.pas"/>
         <DCCReference Include="..\..\Source\GLFileTGA.pas"/>
-        <DCCReference Include="..\..\Source\GLFileTIN.pas"/>
+        <DCCReference Include="..\..\Source\GLS.FileTIN.pas"/>
         <DCCReference Include="..\..\Source\GLFileVRML.pas"/>
         <DCCReference Include="..\..\Source\GLFileWAV.pas"/>
         <DCCReference Include="..\..\Source\GLFileX.pas"/>
@@ -290,7 +290,7 @@
         <DCCReference Include="..\..\Source\GLPhongShader.pas"/>
         <DCCReference Include="..\..\Source\GLPictureRegisteredFormats.pas"/>
         <DCCReference Include="..\..\Source\GLPipelineTransformation.pas"/>
-        <DCCReference Include="..\..\Source\GLPlugInManager.pas"/>
+        <DCCReference Include="..\..\Source\GLS.PlugInManager.pas"/>
         <DCCReference Include="..\..\Source\GLPluginIntf.pas"/>
         <DCCReference Include="..\..\Source\GLPolyhedron.pas"/>
         <DCCReference Include="..\..\Source\GLPolynomials.pas"/>
@@ -323,7 +323,7 @@
         <DCCReference Include="..\..\Source\GLSLVertexDisplacementShader.pas"/>
         <DCCReference Include="..\..\Source\GLSLanguage.pas"/>
         <DCCReference Include="..\..\Source\GLSLog.pas"/>
-        <DCCReference Include="..\..\Source\GLSMemo.pas"/>
+        <DCCReference Include="..\..\Source\GLS.Memo.pas"/>
         <DCCReference Include="..\..\Source\GLSRGBE.pas"/>
         <DCCReference Include="..\..\Source\GLSRedBlackTree.pas"/>
         <DCCReference Include="..\..\Source\GLScene.pas"/>
@@ -366,7 +366,7 @@
         <DCCReference Include="..\..\Source\GLTrail.pas"/>
         <DCCReference Include="..\..\Source\GLTree.pas"/>
         <DCCReference Include="..\..\Source\GLTriangulation.pas"/>
-        <DCCReference Include="..\..\Source\GLTypes.pas"/>
+        <DCCReference Include="..\..\Source\GLVectorRecTypes.pas"/>
         <DCCReference Include="..\..\Source\GLUserShader.pas"/>
         <DCCReference Include="..\..\Source\GLUtils.pas"/>
         <DCCReference Include="..\..\Source\GLVectorGeometry.pas"/>
@@ -377,7 +377,6 @@
         <DCCReference Include="..\..\Source\GLVerletHairClasses.pas"/>
         <DCCReference Include="..\..\Source\GLVerletSkeletonColliders.pas"/>
         <DCCReference Include="..\..\Source\GLVerletTypes.pas"/>
-        <DCCReference Include="..\..\Source\GLVfsPAK.pas"/>
         <DCCReference Include="..\..\Source\GLWaterPlane.pas"/>
         <DCCReference Include="..\..\Source\GLWin32Context.pas"/>
         <DCCReference Include="..\..\Source\GLWin32Viewer.pas"/>
@@ -388,6 +387,7 @@
         <DCCReference Include="..\..\Source\OpenGLAdapter.pas"/>
         <DCCReference Include="..\..\Source\OpenGLTokens.pas"/>
         <DCCReference Include="..\..\Source\XOpenGL.pas"/>
+        <DCCReference Include="..\..\Source\GLFileVfsPAK.pas"/>
         <BuildConfiguration Include="Debug">
             <Key>Cfg_2</Key>
             <CfgParent>Base</CfgParent>

Packages/Win64/GLScene_RT.dpk

@@ -104,11 +104,11 @@ contains
   GLFileB3D in '..\..\Source\GLFileB3D.pas',
   GLFileBMP in '..\..\Source\GLFileBMP.pas',
   GLFileDDS in '..\..\Source\GLFileDDS.pas',
-  GLFileDXF in '..\..\Source\GLFileDXF.pas',
+  GLS.FileDXF in '..\..\Source\GLS.FileDXF.pas',
   GLFileGL2 in '..\..\Source\GLFileGL2.pas',
   GLFileGLB in '..\..\Source\GLFileGLB.pas',
   GLFileGLTF in '..\..\Source\GLFileGLTF.pas',
-  GLFileGRD in '..\..\Source\GLFileGRD.pas',
+  GLS.FileGRD in '..\..\Source\GLS.FileGRD.pas',
   GLFileGTS in '..\..\Source\GLFileGTS.pas',
   GLFileHDR in '..\..\Source\GLFileHDR.pas',
   GLFileJPEG in '..\..\Source\GLFileJPEG.pas',
@@ -132,7 +132,7 @@ contains
   GLFileSMD in '..\..\Source\GLFileSMD.pas',
   GLFileSTL in '..\..\Source\GLFileSTL.pas',
   GLFileTGA in '..\..\Source\GLFileTGA.pas',
-  GLFileTIN in '..\..\Source\GLFileTIN.pas',
+  GLS.FileTIN in '..\..\Source\GLS.FileTIN.pas',
   GLFileVRML in '..\..\Source\GLFileVRML.pas',
   GLFileWAV in '..\..\Source\GLFileWAV.pas',
   GLFileX in '..\..\Source\GLFileX.pas',
@@ -196,8 +196,7 @@ contains
   GLPhongShader in '..\..\Source\GLPhongShader.pas',
   GLPictureRegisteredFormats in '..\..\Source\GLPictureRegisteredFormats.pas',
   GLPipelineTransformation in '..\..\Source\GLPipelineTransformation.pas',
-  GLPlugInManager in '..\..\Source\GLPlugInManager.pas',
-  GLPluginIntf in '..\..\Source\GLPluginIntf.pas',
+  GLS.PlugInManager in '..\..\Source\GLS.PlugInManager.pas',
   GLPolyhedron in '..\..\Source\GLPolyhedron.pas',
   GLPolynomials in '..\..\Source\GLPolynomials.pas',
   GLPortal in '..\..\Source\GLPortal.pas',
@@ -228,7 +227,7 @@ contains
   GLSLToonShader in '..\..\Source\GLSLToonShader.pas',
   GLSLanguage in '..\..\Source\GLSLanguage.pas',
   GLSLog in '..\..\Source\GLSLog.pas',
-  GLSMemo in '..\..\Source\GLSMemo.pas',
+  GLS.Memo in '..\..\Source\GLS.Memo.pas',
   GLSRGBE in '..\..\Source\GLSRGBE.pas',
   GLSRedBlackTree in '..\..\Source\GLSRedBlackTree.pas',
   GLScene in '..\..\Source\GLScene.pas',
@@ -269,18 +268,17 @@ contains
   GLTrail in '..\..\Source\GLTrail.pas',
   GLTree in '..\..\Source\GLTree.pas',
   GLTriangulation in '..\..\Source\GLTriangulation.pas',
-  GLTypes in '..\..\Source\GLTypes.pas',
   GLUserShader in '..\..\Source\GLUserShader.pas',
   GLUtils in '..\..\Source\GLUtils.pas',
   GLVectorFileObjects in '..\..\Source\GLVectorFileObjects.pas',
   GLVectorGeometry in '..\..\Source\GLVectorGeometry.pas',
   GLVectorLists in '..\..\Source\GLVectorLists.pas',
+  GLVectorRecTypes in '..\..\Source\GLVectorRecTypes.pas',
   GLVectorTypes in '..\..\Source\GLVectorTypes.pas',
   GLVerletClothify in '..\..\Source\GLVerletClothify.pas',
   GLVerletHairClasses in '..\..\Source\GLVerletHairClasses.pas',
   GLVerletSkeletonColliders in '..\..\Source\GLVerletSkeletonColliders.pas',
   GLVerletTypes in '..\..\Source\GLVerletTypes.pas',
-  GLVfsPAK in '..\..\Source\GLVfsPAK.pas',
   GLWaterPlane in '..\..\Source\GLWaterPlane.pas',
   GLWin32Context in '..\..\Source\GLWin32Context.pas',
   GLWin32Viewer in '..\..\Source\GLWin32Viewer.pas',
@@ -291,7 +289,8 @@ contains
   OpenGLTokens in '..\..\Source\OpenGLTokens.pas',
   GLS.OpenGLx in '..\..\Source\GLS.OpenGLx.pas',
   XCollection in '..\..\Source\XCollection.pas',
-  XOpenGL in '..\..\Source\XOpenGL.pas';
+  XOpenGL in '..\..\Source\XOpenGL.pas',
+  GLFileVfsPAK in '..\..\Source\GLFileVfsPAK.pas';
 
 end.
 

Packages/Win64/GLScene_RT.dproj

@@ -206,11 +206,11 @@
         <DCCReference Include="..\..\Source\GLFileB3D.pas"/>
         <DCCReference Include="..\..\Source\GLFileBMP.pas"/>
         <DCCReference Include="..\..\Source\GLFileDDS.pas"/>
-        <DCCReference Include="..\..\Source\GLFileDXF.pas"/>
+        <DCCReference Include="..\..\Source\GLS.FileDXF.pas"/>
         <DCCReference Include="..\..\Source\GLFileGL2.pas"/>
         <DCCReference Include="..\..\Source\GLFileGLB.pas"/>
         <DCCReference Include="..\..\Source\GLFileGLTF.pas"/>
-        <DCCReference Include="..\..\Source\GLFileGRD.pas"/>
+        <DCCReference Include="..\..\Source\GLS.FileGRD.pas"/>
         <DCCReference Include="..\..\Source\GLFileGTS.pas"/>
         <DCCReference Include="..\..\Source\GLFileHDR.pas"/>
         <DCCReference Include="..\..\Source\GLFileJPEG.pas"/>
@@ -234,7 +234,7 @@
         <DCCReference Include="..\..\Source\GLFileSMD.pas"/>
         <DCCReference Include="..\..\Source\GLFileSTL.pas"/>
         <DCCReference Include="..\..\Source\GLFileTGA.pas"/>
-        <DCCReference Include="..\..\Source\GLFileTIN.pas"/>
+        <DCCReference Include="..\..\Source\GLS.FileTIN.pas"/>
         <DCCReference Include="..\..\Source\GLFileVRML.pas"/>
         <DCCReference Include="..\..\Source\GLFileWAV.pas"/>
         <DCCReference Include="..\..\Source\GLFileX.pas"/>
@@ -298,8 +298,7 @@
         <DCCReference Include="..\..\Source\GLPhongShader.pas"/>
         <DCCReference Include="..\..\Source\GLPictureRegisteredFormats.pas"/>
         <DCCReference Include="..\..\Source\GLPipelineTransformation.pas"/>
-        <DCCReference Include="..\..\Source\GLPlugInManager.pas"/>
-        <DCCReference Include="..\..\Source\GLPluginIntf.pas"/>
+        <DCCReference Include="..\..\Source\GLS.PlugInManager.pas"/>
         <DCCReference Include="..\..\Source\GLPolyhedron.pas"/>
         <DCCReference Include="..\..\Source\GLPolynomials.pas"/>
         <DCCReference Include="..\..\Source\GLPortal.pas"/>
@@ -330,7 +329,7 @@
         <DCCReference Include="..\..\Source\GLSLToonShader.pas"/>
         <DCCReference Include="..\..\Source\GLSLanguage.pas"/>
         <DCCReference Include="..\..\Source\GLSLog.pas"/>
-        <DCCReference Include="..\..\Source\GLSMemo.pas"/>
+        <DCCReference Include="..\..\Source\GLS.Memo.pas"/>
         <DCCReference Include="..\..\Source\GLSRGBE.pas"/>
         <DCCReference Include="..\..\Source\GLSRedBlackTree.pas"/>
         <DCCReference Include="..\..\Source\GLScene.pas"/>
@@ -371,18 +370,17 @@
         <DCCReference Include="..\..\Source\GLTrail.pas"/>
         <DCCReference Include="..\..\Source\GLTree.pas"/>
         <DCCReference Include="..\..\Source\GLTriangulation.pas"/>
-        <DCCReference Include="..\..\Source\GLTypes.pas"/>
         <DCCReference Include="..\..\Source\GLUserShader.pas"/>
         <DCCReference Include="..\..\Source\GLUtils.pas"/>
         <DCCReference Include="..\..\Source\GLVectorFileObjects.pas"/>
         <DCCReference Include="..\..\Source\GLVectorGeometry.pas"/>
         <DCCReference Include="..\..\Source\GLVectorLists.pas"/>
+        <DCCReference Include="..\..\Source\GLVectorRecTypes.pas"/>
         <DCCReference Include="..\..\Source\GLVectorTypes.pas"/>
         <DCCReference Include="..\..\Source\GLVerletClothify.pas"/>
         <DCCReference Include="..\..\Source\GLVerletHairClasses.pas"/>
         <DCCReference Include="..\..\Source\GLVerletSkeletonColliders.pas"/>
         <DCCReference Include="..\..\Source\GLVerletTypes.pas"/>
-        <DCCReference Include="..\..\Source\GLVfsPAK.pas"/>
         <DCCReference Include="..\..\Source\GLWaterPlane.pas"/>
         <DCCReference Include="..\..\Source\GLWin32Context.pas"/>
         <DCCReference Include="..\..\Source\GLWin32Viewer.pas"/>
@@ -394,6 +392,7 @@
         <DCCReference Include="..\..\Source\GLS.OpenGLx.pas"/>
         <DCCReference Include="..\..\Source\XCollection.pas"/>
         <DCCReference Include="..\..\Source\XOpenGL.pas"/>
+        <DCCReference Include="..\..\Source\GLFileVfsPAK.pas"/>
         <BuildConfiguration Include="Debug">
             <Key>Cfg_2</Key>
             <CfgParent>Base</CfgParent>
@@ -426,7 +425,7 @@
                 <Platform value="Win64">True</Platform>
             </Platforms>
             <Deployment Version="3">
-                <DeployFile LocalName="..\..\bpl\Win64\GLScene_RT.bpl" Configuration="Release" Class="ProjectOutput">
+                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\21.0\Bpl\Win64\GLScene_RT.bpl" Configuration="Release" Class="ProjectOutput">
                     <Platform Name="Win64">
                         <RemoteName>GLScene_RT.bpl</RemoteName>
                         <Overwrite>true</Overwrite>

Source/FPlugInManagerEditor.pas

@@ -1,11 +1,11 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-  Need a short description of what it does here. 
-}
+
 unit FPlugInManagerEditor;
 
+(* Need a short description of what it does here *)
+
 interface
 
 {$I GLScene.inc}
@@ -24,8 +24,7 @@ uses
   Vcl.ComCtrls, 
   Vcl.ToolWin,
    
-  GLPlugInIntf, 
-  GLPlugInManager;
+  GLS.PlugInManager;
 
 type
   TGLPlugInManagerEditorForm = class(TForm)

Source/FShaderMemo.pas

@@ -1,14 +1,15 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-   Shader code editor. 
+
+unit FShaderMemo;
+
+(*
+  Shader code editor.
 // TODO: need to decide how to load templates from external file
 //       and update it without package recompilation
-}
 
-
-unit FShaderMemo;
+*)
 
 interface
 
@@ -33,7 +34,7 @@ uses
   VCL.StdCtrls,
   VCL.Graphics,
    
-  GLSMemo;
+  GLS.Memo;
 
 type
 

Source/FileOCT.pas

@@ -10,83 +10,84 @@ interface
 
 {$I GLScene.inc}
 
-uses 
-  System.Classes, 
+uses
+  System.Classes,
   System.SysUtils,
-   
+
   GLVectorGeometry,
   GLVectorTypes,
   GLVectorLists;
 
 type
 
-   TOCTHeader = record
-		numVerts : Integer;
-		numFaces : Integer;
-		numTextures : Integer;
-		numLightmaps : Integer;
-		numLights : Integer;
-	end;
-
-	TOCTVertex = record
-		tv : TTexPoint;      // texture coordinates
-		lv : TTexpoint;      // lightmap coordinates
-		pos : TAffineVector; // vertex position
-   end;
-
-	TOCTFace = record
-		start : Integer;     // first face vert in vertex array
-		num : Integer;			// number of verts in the face
-		id : Integer;			// texture index into the texture array
-		lid : Integer;			// lightmap index into the lightmap array
-		p : THmgPlane;
-	end;
-   POCTFace = ^TOCTFace;
-
-	TOCTTexture = record
-		id : Integer;				      // texture id
-		Name : array [0..63] of AnsiChar;	// texture name
-   end;
-
-	TOCTLightmap = record
-		id : Integer;				         // lightmaps id
-		map : array [0..49151] of Byte;	// 128 x 128 raw RGB data
-   end;
-   POCTLightmap = ^TOCTLightmap;
-
-	TOCTLight = record
-		pos : TAffineVector;		      // Position
-		color : TAffineVector;			// Color (RGB)
-		intensity : Integer;			   // Intensity
-	end;
-
-   TOCTFile = class (TObject)
-      public
-         Header         : TOCTHeader;
-         Vertices       : array of TOCTVertex;
-         Faces          : array of TOCTFace;
-         Textures       : array of TOCTTexture;
-         Lightmaps      : array of TOCTLightmap;
-         Lights         : array of TOCTLight;
-         PlayerPos      : TAffineVector;
-         constructor Create; overload;
-         constructor Create(octStream : TStream); overload;
-         {Saves content to stream in OCT format. 
-            The Header is automatically prepared before streaming. }
-         procedure SaveToStream(aStream : TStream);
-         procedure AddTriangles(vertexCoords : TAffineVectorList;
-                                texMapCoords : TAffineVectorList;
-                                const textureName : String);
-         procedure AddLight(const lightPos : TAffineVector;
-                            const lightColor : TVector;
-                            lightIntensity : Integer);
-   end;
-
-// ------------------------------------------------------------------
+  TOCTHeader = record
+    numVerts: Integer;
+    numFaces: Integer;
+    numTextures: Integer;
+    numLightmaps: Integer;
+    numLights: Integer;
+  end;
+
+  TOCTVertex = record
+    tv: TTexPoint; // texture coordinates
+    lv: TTexPoint; // lightmap coordinates
+    pos: TAffineVector; // vertex position
+  end;
+
+  TOCTFace = record
+    start: Integer; // first face vert in vertex array
+    num: Integer; // number of verts in the face
+    id: Integer; // texture index into the texture array
+    lid: Integer; // lightmap index into the lightmap array
+    p: THmgPlane;
+  end;
+
+  POCTFace = ^TOCTFace;
+
+  TOCTTexture = record
+    id: Integer; // texture id
+    Name: array [0 .. 63] of AnsiChar; // texture name
+  end;
+
+  TOCTLightmap = record
+    id: Integer; // lightmaps id
+    map: array [0 .. 49151] of Byte; // 128 x 128 raw RGB data
+  end;
+
+  POCTLightmap = ^TOCTLightmap;
+
+  TOCTLight = record
+    pos: TAffineVector; // Position
+    color: TAffineVector; // Color (RGB)
+    intensity: Integer; // Intensity
+  end;
+
+  TOCTFile = class(TObject)
+  public
+    Header: TOCTHeader;
+    Vertices: array of TOCTVertex;
+    Faces: array of TOCTFace;
+    Textures: array of TOCTTexture;
+    Lightmaps: array of TOCTLightmap;
+    Lights: array of TOCTLight;
+    PlayerPos: TAffineVector;
+    constructor Create; overload;
+    constructor Create(octStream: TStream); overload;
+    (* Saves content to stream in OCT format.
+      The Header is automatically prepared before streaming. *)
+    procedure SaveToStream(aStream: TStream);
+    procedure AddTriangles(vertexCoords: TAffineVectorList;
+      texMapCoords: TAffineVectorList; const textureName: String);
+    procedure AddLight(const lightPos: TAffineVector; const lightColor: TVector;
+      lightIntensity: Integer);
+  end;
+
+  // ------------------------------------------------------------------
 implementation
+
 // ------------------------------------------------------------------
 
-uses 
+uses
   GLMeshUtils;
 
 // ------------------
@@ -95,104 +96,101 @@ uses
 
 constructor TOCTFile.Create;
 begin
-   inherited Create;
+  inherited Create;
 end;
 
-constructor TOCTFile.Create(octStream : TStream);
+constructor TOCTFile.Create(octStream: TStream);
 begin
-   inherited Create;
-   
-   // Read in the header
-   octStream.Read(Header, SizeOf(Header));
-
-   // then the rest of the stuff
-
-   SetLength(Vertices, Header.numVerts);
-   octStream.Read(Vertices[0], Header.numVerts*SizeOf(TOCTVertex));
-
-   SetLength(Faces, Header.numFaces);
-   octStream.Read(Faces[0], Header.numFaces*SizeOf(TOCTFace));
-
-   SetLength(Textures, Header.numTextures);
-   octStream.Read(Textures[0], Header.numTextures*SizeOf(TOCTTexture));
-
-   SetLength(Lightmaps, Header.numLightmaps);
-   octStream.Read(Lightmaps[0], Header.numLightmaps*SizeOf(TOCTLightmap));
-
-   SetLength(Lights, Header.numLights);
-   octStream.Read(Lights[0], Header.numLights*SizeOf(TOCTLight));
-
-   octStream.Read(PlayerPos, SizeOf(PlayerPos))
+  inherited Create;
+  // Read in the header
+  octStream.Read(Header, SizeOf(Header));
+  // then the rest of the stuff
+  SetLength(Vertices, Header.numVerts);
+  octStream.Read(Vertices[0], Header.numVerts * SizeOf(TOCTVertex));
+  SetLength(Faces, Header.numFaces);
+  octStream.Read(Faces[0], Header.numFaces * SizeOf(TOCTFace));
+  SetLength(Textures, Header.numTextures);
+  octStream.Read(Textures[0], Header.numTextures * SizeOf(TOCTTexture));
+  SetLength(Lightmaps, Header.numLightmaps);
+  octStream.Read(Lightmaps[0], Header.numLightmaps * SizeOf(TOCTLightmap));
+  SetLength(Lights, Header.numLights);
+  octStream.Read(Lights[0], Header.numLights * SizeOf(TOCTLight));
+  octStream.Read(PlayerPos, SizeOf(PlayerPos))
 end;
 
-procedure TOCTFile.SaveToStream(aStream : TStream);
+procedure TOCTFile.SaveToStream(aStream: TStream);
 begin
-   with Header, aStream do begin
-      numVerts:=Length(Vertices);
-      numFaces:=Length(Faces);
-      numTextures:=Length(Textures);
-      numLightmaps:=Length(Lightmaps);
-      numLights:=Length(Lights);
-
-      Write(Header, SizeOf(Header));
-      Write(Vertices[0], numVerts*SizeOf(TOCTVertex));
-      Write(Faces[0], numFaces*SizeOf(TOCTFace));
-      Write(Textures[0], numTextures*SizeOf(TOCTTexture));
-      Write(Lightmaps[0], numLightmaps*SizeOf(TOCTLightmap));
-      Write(Lights[0], numLights*SizeOf(TOCTLight));
-      Write(PlayerPos, SizeOf(PlayerPos))
-   end;
+  with Header, aStream do
+  begin
+    numVerts := Length(Vertices);
+    numFaces := Length(Faces);
+    numTextures := Length(Textures);
+    numLightmaps := Length(Lightmaps);
+    numLights := Length(Lights);
+
+    Write(Header, SizeOf(Header));
+    Write(Vertices[0], numVerts * SizeOf(TOCTVertex));
+    Write(Faces[0], numFaces * SizeOf(TOCTFace));
+    Write(Textures[0], numTextures * SizeOf(TOCTTexture));
+    Write(Lightmaps[0], numLightmaps * SizeOf(TOCTLightmap));
+    Write(Lights[0], numLights * SizeOf(TOCTLight));
+    Write(PlayerPos, SizeOf(PlayerPos))
+  end;
 end;
 
-procedure TOCTFile.AddTriangles(vertexCoords : TAffineVectorList;
-                                texMapCoords : TAffineVectorList;
-                                const textureName : String);
+procedure TOCTFile.AddTriangles(vertexCoords: TAffineVectorList;
+  texMapCoords: TAffineVectorList; const textureName: String);
 var
-   i : Integer;
-   baseIdx, texIdx : Integer;
+  i: Integer;
+  baseIdx, texIdx: Integer;
 begin
-   Assert((texMapCoords=nil) or (texMapCoords.Count=vertexCoords.Count));
-
-   texIdx:=Length(Textures);
-   SetLength(Textures, texIdx+1);
-   Move(textureName[1], Textures[texIdx].Name[0], Length(textureName));
-   SetLength(Lightmaps, 1);
-   FillChar(Lightmaps[0].map[0], 128*3, 255);
-
-   baseIdx:=Length(Vertices);
-   SetLength(Vertices, baseIdx+vertexCoords.Count);
-   for i:=0 to vertexCoords.Count-1 do with Vertices[baseIdx+i] do begin
-      pos:=vertexCoords.List[i];
+  Assert((texMapCoords = nil) or (texMapCoords.Count = vertexCoords.Count));
+
+  texIdx := Length(Textures);
+  SetLength(Textures, texIdx + 1);
+  Move(textureName[1], Textures[texIdx].Name[0], Length(textureName));
+  SetLength(Lightmaps, 1);
+  FillChar(Lightmaps[0].map[0], 128 * 3, 255);
+
+  baseIdx := Length(Vertices);
+  SetLength(Vertices, baseIdx + vertexCoords.Count);
+  for i := 0 to vertexCoords.Count - 1 do
+    with Vertices[baseIdx + i] do
+    begin
+      pos := vertexCoords.List[i];
       if Assigned(texMapCoords) then
-         tv:=PTexPoint(@texMapCoords.List[i])^;
-   end;
-
-   SetLength(Faces, vertexCoords.Count div 3);
-   i:=0; while i<vertexCoords.Count do begin
-      with Faces[i div 3] do begin
-         start:=baseIdx+i;
-         num:=3;
-         id:=texIdx;
-         p:=PlaneMake(vertexCoords[i],
-                      CalcPlaneNormal(vertexCoords[i+0], vertexCoords[i+1], vertexCoords[i+0]));
-      end;
-      Inc(i, 3);
-   end;
+        tv := PTexPoint(@texMapCoords.List[i])^;
+    end;
+
+  SetLength(Faces, vertexCoords.Count div 3);
+  i := 0;
+  while i < vertexCoords.Count do
+  begin
+    with Faces[i div 3] do
+    begin
+      start := baseIdx + i;
+      num := 3;
+      id := texIdx;
+      p := PlaneMake(vertexCoords[i], CalcPlaneNormal(vertexCoords[i + 0],
+        vertexCoords[i + 1], vertexCoords[i + 0]));
+    end;
+    Inc(i, 3);
+  end;
 end;
 
-procedure TOCTFile.AddLight(const lightPos : TAffineVector;
-                            const lightColor : TVector;
-                            lightIntensity : Integer);
+procedure TOCTFile.AddLight(const lightPos: TAffineVector;
+  const lightColor: TVector; lightIntensity: Integer);
 var
-   n : Integer;
+  n: Integer;
 begin
-   n:=Length(Lights);
-   SetLength(Lights, n+1);
-   with Lights[n] do begin
-      pos:=lightPos;
-      color:=PAffineVector(@lightColor)^;
-      intensity:=lightIntensity;
-   end;
+  n := Length(Lights);
+  SetLength(Lights, n + 1);
+  with Lights[n] do
+  begin
+    pos := lightPos;
+    color := PAffineVector(@lightColor)^;
+    intensity := lightIntensity;
+  end;
 end;
 
 end.

Source/GLCollision.pas

@@ -1,11 +1,11 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-(*
-  Collision-detection management
-*)
+
 unit GLCollision;
 
+(* Collision-detection management *)
+
 interface
 
 {$I GLScene.inc}
@@ -958,7 +958,6 @@ end;
 initialization
 // ------------------------------------------------------------------
 
-// class registrations
 RegisterXCollectionItemClass(TGLBCollision);
 
 finalization
@@ -966,3 +965,4 @@ finalization
 UnregisterXCollectionItemClass(TGLBCollision);
 
 end.
+

Source/GLCoordinates.pas

@@ -1,39 +1,38 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-  Coordinate related classes.
-}
 
 unit GLCoordinates;
 
+(* Coordinate related classes *)
+
 interface
 
 {$I GLScene.inc}
 
 uses
-  System.Classes, 
+  System.Classes,
   System.SysUtils,
-   
-  GLVectorGeometry, 
-  GLVectorTypes, 
-  OpenGLTokens, 
+
+  GLVectorGeometry,
+  GLVectorTypes,
+  OpenGLTokens,
   GLBaseClasses;
 
 type
 
-  { Identifie le type de données stockées au sein d'un TGLCustomCoordinates.
+  (* Identifie le type de données stockées au sein d'un TGLCustomCoordinates.
      csPoint2D : a simple 2D point (Z=0, W=0)
      csPoint : un point (W=1)
      csVector : un vecteur (W=0)
-     csUnknown : aucune contrainte }
+     csUnknown : aucune contrainte *)
   TGLCoordinatesStyle = (csPoint2D, csPoint, csVector, csUnknown);
 
-  {  Stores and homogeneous vector. 
+  (* Stores and homogeneous vector.
     This class is basicly a container for a TVector, allowing proper use of
     delphi property editors and editing in the IDE. Vector/Coordinates
     manipulation methods are only minimal.
-    Handles dynamic default values to save resource file space.  }
+    Handles dynamic default values to save resource file space.  *)
   TGLCustomCoordinates = class(TGLUpdateAbleObject)
   private
    FCoords: TVector;
@@ -63,12 +62,12 @@ type
     procedure ReadFromFiler(Reader: TReader);
     procedure Initialize(const Value: TVector);
     procedure NotifyChange(Sender: TObject); override;
-    { Identifies the coordinates styles.
+    (* Identifies the coordinates styles.
       The property is NOT persistent, csUnknown by default, and should be
-      managed by owner object only (internally). 
+      managed by owner object only (internally).
       It is used by the TGLCustomCoordinates for internal "assertion" checks
       to detect "misuses" or "misunderstandings" of what the homogeneous
-      coordinates system implies. }
+      coordinates system implies. *)
     property Style: TGLCoordinatesStyle read FStyle write FStyle;
     procedure Translate(const TranslationVector: TVector); overload;
     procedure Translate(const TranslationVector: TAffineVector); overload;
@@ -96,25 +95,25 @@ type
     procedure SetPoint2D(const Vector: TVector2f); overload;
     procedure SetToZero;
     function AsAddress: PGLFloat; inline;
-    {  The coordinates viewed as a vector.
+    (* The coordinates viewed as a vector.
       Assigning a value to this property will trigger notification events,
-      if you don't want so, use DirectVector instead. }
+      if you don't want so, use DirectVector instead. *)
     property AsVector: TVector read FCoords write SetAsVector;
-    { The coordinates viewed as an affine vector.
+    (* The coordinates viewed as an affine vector.
       Assigning a value to this property will trigger notification events,
       if you don't want so, use DirectVector instead.
-      The W component is automatically adjustes depending on style. }
+      The W component is automatically adjustes depending on style. *)
     property AsAffineVector: TAffineVector read GetAsAffineVector  write SetAsAffineVector;
-    {  The coordinates viewed as a 2D point. 
+    (*  The coordinates viewed as a 2D point.
       Assigning a value to this property will trigger notification events,
-      if you don't want so, use DirectVector instead. }
+      if you don't want so, use DirectVector instead. *)
     property AsPoint2D: TVector2f read GetAsPoint2D write SetAsPoint2D;
     property X: TGLFloat index 0 read GetCoordinate write SetCoordinate;
     property Y: TGLFloat index 1 read GetCoordinate write SetCoordinate;
     property Z: TGLFloat index 2 read GetCoordinate write SetCoordinate;
     property W: TGLFloat index 3 read GetCoordinate write SetCoordinate;
     property Coordinate[const AIndex: Integer]: TGLFloat read GetCoordinate write SetCoordinate; default;
-    {  The coordinates, in-between brackets, separated by semi-colons. }
+    // The coordinates, in-between brackets, separated by semi-colons.
     property AsString: String read GetAsString;
     // Similar to AsVector but does not trigger notification events
     property DirectVector: TVector read FCoords write SetDirectVector;
@@ -124,14 +123,14 @@ type
     property DirectW: TGLFloat index 3 read GetDirectCoordinate write SetDirectCoordinate;
   end;
 
-  {  A TGLCustomCoordinates that publishes X, Y properties. }
+  // A TGLCustomCoordinates that publishes X, Y properties.
   TGLCoordinates2 = class(TGLCustomCoordinates)
   published
     property X stored False;
     property Y stored False;
   end;
 
-  {  A TGLCustomCoordinates that publishes X, Y, Z properties. }
+  // A TGLCustomCoordinates that publishes X, Y, Z properties.
   TGLCoordinates3 = class(TGLCustomCoordinates)
   published
     property X stored False;
@@ -139,7 +138,7 @@ type
     property Z stored False;
   end;
 
-  {  A TGLCustomCoordinates that publishes X, Y, Z, W properties. }
+  // A TGLCustomCoordinates that publishes X, Y, Z, W properties.
   TGLCoordinates4 = class(TGLCustomCoordinates)
   published
     property X stored False;

Source/GLCurvesAndSurfaces.pas

@@ -1,12 +1,11 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-  Bezier and B-Spline Curve and Surface Routines.
-}
 
 unit GLCurvesAndSurfaces;
 
+(* Bezier and B-Spline Curve and Surface Routines *)
+
 interface
 
 {$I GLScene.inc}

Source/GLFileDXF.pas

@@ -1,17 +1,16 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-  Support-Code to load DXF (Drawing eXchange Files) TGLFreeForm or
-  TGLActor Components in GLScene. 
 
-  Note that you must manually add this unit to one of your project's uses
-  to enable support for DXF at run-time. 
+unit GLFileDXF;
 
+(*
+  Support-Code to load DXF (Drawing eXchange Files) TGLFreeForm or
+  TGLActor Components in GLScene.
+  Note that you must manually add this unit to one of your project's uses
+  to enable support for DXF at run-time.
   Turn on TwoSideLighting in your Buffer! DXF-Faces have no defined winding order
-}
-
-unit GLFileDXF;
+*)
 
 interface
 

Source/GLFileVfsPAK.pas

@@ -0,0 +1,474 @@
+//
+// This unit is part of the GLScene Engine, http://glscene.org
+//
+
+unit GLFileVfsPAK;
+
+(*
+  Support-code for loading files from Quake II PAK Files.
+  When instance is created all LoadFromFile methods using
+  GLApplicationFileIO mechanism will be pointed into PAK file.
+  You can change current PAK file by ActivePak variable.
+
+*)
+
+interface
+
+{$I GLScene.inc}
+
+uses
+  System.Classes,
+  System.Contnrs,
+  System.SysUtils,
+
+  GLStrings,
+  GLApplicationFileIO;
+
+const
+  SIGN = 'PACK'; // Signature for uncompressed - raw pak.
+  SIGN_COMPRESSED = 'PACZ'; // Signature for compressed pak.
+
+type
+
+  TZCompressedMode = (Good, Fast, Auto, None);
+
+  TPakHeader = record
+    Signature: array [0 .. 3] of AnsiChar;
+    DirOffset: integer;
+    DirLength: integer;
+  end;
+
+  TFileSection = record
+    FileName: array [0 .. 119] of AnsiChar;
+    FilePos: integer;
+    FileLength: integer;
+  end;
+
+  TGLVfsPAK = class(TComponent)
+  private
+    FPakFiles: TStringList;
+    FHeader: TPakHeader;
+    FHeaderList: array of TPakHeader;
+    FStream: TFileStream;
+    FStreamList: TObjectList;
+    FFiles: TStrings;
+    FFilesLists: TObjectList;
+    FFileName: string;
+    FCompressionLevel: TZCompressedMode;
+    FCompressed: Boolean;
+    function GetFileCount: integer;
+    procedure MakeFileList;
+    function GetStreamNumber: integer;
+    procedure SetStreamNumber(i: integer);
+  public
+    property PakFiles: TStringList read FPakFiles;
+    property Files: TStrings read FFiles;
+    property ActivePakNum: integer read GetStreamNumber write SetStreamNumber;
+    property FileCount: integer Read GetFileCount;
+    property PakFileName: string Read FFileName;
+    property Compressed: Boolean read FCompressed;
+    property CompressionLevel: TZCompressedMode read FCompressionLevel;
+    constructor Create(AOwner: TComponent); overload; override;
+    constructor Create(AOwner: TComponent; const CbrMode: TZCompressedMode);
+      reintroduce; overload;
+    destructor Destroy; override;
+    // for Mode value search Delphi Help for "File open mode constants"
+    procedure LoadFromFile(const FileName: string; Mode: word);
+    procedure ClearPakFiles;
+    function FileExists(const FileName: string): Boolean;
+    function GetFile(index: integer): TStream; overload;
+    function GetFile(const FileName: string): TStream; overload;
+    function GetFileSize(index: integer): integer; overload;
+    function GetFileSize(const FileName: string): integer; overload;
+    procedure AddFromStream(const FileName, Path: string; F: TStream);
+    procedure AddFromFile(const FileName, Path: string);
+    procedure AddEmptyFile(const FileName, Path: string);
+    procedure RemoveFile(index: integer); overload;
+    procedure RemoveFile(const FileName: string); overload;
+    procedure Extract(index: integer; const NewName: string); overload;
+    procedure Extract(const FileName, NewName: string); overload;
+  end;
+
+function PAKCreateFileStream(const FileName: string; Mode: word): TStream;
+function PAKFileStreamExists(const FileName: string): Boolean;
+
+var
+  ActiveVfsPAK: TGLVfsPAK;
+
+// ---------------------------------------------------------------------
+implementation
+// ---------------------------------------------------------------------
+
+var
+  Dir: TFileSection;
+
+function BackToSlash(const s: string): string;
+var
+  i: integer;
+begin
+  SetLength(Result, Length(s));
+  for i := 1 to Length(s) do
+    if s[i] = '\' then
+      Result[i] := '/'
+    else
+      Result[i] := s[i];
+end;
+
+function PAKCreateFileStream(const FileName: string; Mode: word): TStream;
+var
+  i: integer;
+begin
+  with ActiveVfsPAK do
+    for i := FStreamList.Count - 1 downto 0 do
+    begin
+      FFiles := TStrings(FFilesLists[i]);
+      if FileExists(BackToSlash(FileName)) then
+      begin
+        FHeader := FHeaderList[i];
+        FStream := TFileStream(FStreamList[i]);
+        Result := GetFile(BackToSlash(FileName));
+        Exit;
+      end
+      else
+      begin
+        if FileExists(FileName) then
+        begin
+          Result := TFileStream.Create(FileName, fmOpenReadWrite or
+            fmShareDenyWrite);
+          Exit;
+        end
+        else
+        begin
+          Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
+          Exit;
+        end;
+      end;
+    end;
+  if FileExists(FileName) then
+  begin
+    Result := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite);
+    Exit;
+  end
+  else
+  begin
+    Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
+    Exit;
+  end;
+  Result.Free;
+end;
+
+function PAKFileStreamExists(const FileName: string): Boolean;
+var
+  i: integer;
+begin
+  with ActiveVfsPAK do
+    for i := 0 to FStreamList.Count - 1 do
+    begin
+      FFiles := TStrings(FFilesLists[i]);
+      if FileExists(BackToSlash(FileName)) then
+      begin
+        Result := True;
+        Exit;
+      end;
+    end;
+  Result := FileExists(FileName);
+end;
+
+// --------------------------
+// TGLVfsPAK
+// --------------------------
+
+function TGLVfsPAK.GetStreamNumber: integer;
+begin
+  Result := FStreamList.IndexOf(FStream);
+end;
+
+procedure TGLVfsPAK.SetStreamNumber(i: integer);
+begin
+  FStream := TFileStream(FStreamList[i]);
+end;
+
+constructor TGLVfsPAK.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FPakFiles := TStringList.Create;
+  FStreamList := TObjectList.Create(True);
+  FFilesLists := TObjectList.Create(True);
+  ActiveVfsPAK := Self;
+  vAFIOCreateFileStream := PAKCreateFileStream;
+  vAFIOFileStreamExists := PAKFileStreamExists;
+  FCompressionLevel := None;
+  FCompressed := False;
+end;
+
+constructor TGLVfsPAK.Create(AOwner: TComponent;
+  const CbrMode: TZCompressedMode);
+begin
+  Self.Create(AOwner);
+  FCompressionLevel := None;
+  FCompressed := FCompressionLevel <> None;
+end;
+
+destructor TGLVfsPAK.Destroy;
+begin
+  vAFIOCreateFileStream := nil;
+  vAFIOFileStreamExists := nil;
+  SetLength(FHeaderList, 0);
+  FPakFiles.Free;
+  // Objects are automatically freed by TObjectList
+  FStreamList.Free;
+  FFilesLists.Free;
+  ActiveVfsPAK := nil;
+  inherited Destroy;
+end;
+
+function TGLVfsPAK.GetFileCount: integer;
+begin
+  Result := FHeader.DirLength div SizeOf(TFileSection);
+end;
+
+procedure TGLVfsPAK.MakeFileList;
+var
+  i: integer;
+begin
+  FStream.Seek(FHeader.DirOffset, soFromBeginning);
+  FFiles.Clear;
+  for i := 0 to FileCount - 1 do
+  begin
+    FStream.ReadBuffer(Dir, SizeOf(TFileSection));
+    FFiles.Add(string(Dir.FileName));
+  end;
+end;
+
+procedure TGLVfsPAK.LoadFromFile(const FileName: string; Mode: word);
+var
+  l: integer;
+begin
+  FFileName := FileName;
+  FPakFiles.Clear;
+  FPakFiles.Add(FileName);
+  FFiles := TStringList.Create;
+  FStream := TFileStream.Create(FileName, Mode);
+  if FStream.Size = 0 then
+  begin
+    if FCompressed then
+      FHeader.Signature := SIGN_COMPRESSED
+    else
+      FHeader.Signature := SIGN;
+    FHeader.DirOffset := SizeOf(TPakHeader);
+    FHeader.DirLength := 0;
+    if FHeader.Signature = SIGN_COMPRESSED then
+    begin
+      FStream.Free;
+      raise Exception.Create
+        (FileName +
+        ' - This is a compressed PAK file. This version of software does not support Compressed Pak files.');
+      Exit;
+    end;
+    FStream.WriteBuffer(FHeader, SizeOf(TPakHeader));
+    FStream.Position := 0;
+  end;
+  FStream.ReadBuffer(FHeader, SizeOf(TPakHeader));
+  if (FHeader.Signature <> SIGN) and (FHeader.Signature <> SIGN_COMPRESSED) then
+  begin
+    FStream.Free;
+    raise Exception.Create(FileName + ' - This is not PAK file');
+    Exit;
+  end;
+
+  // Set the compression flag property.
+  FCompressed := FHeader.Signature = SIGN_COMPRESSED;
+  if FCompressed then
+  begin
+    FStream.Free;
+    raise Exception.Create
+      (FileName +
+      ' - This is a compressed PAK file. This version of software does not support Compressed Pak files.');
+    Exit;
+  end;
+  if FileCount <> 0 then
+    MakeFileList;
+  l := Length(FHeaderList);
+  SetLength(FHeaderList, l + 1);
+  FHeaderList[l] := FHeader;
+  FFilesLists.Add(FFiles);
+  FStreamList.Add(FStream);
+end;
+
+procedure TGLVfsPAK.ClearPakFiles;
+begin
+  SetLength(FHeaderList, 0);
+  FPakFiles.Clear;
+  // Objects are automatically freed by TObjectList
+  FStreamList.Clear;
+  FFilesLists.Clear;
+  ActiveVfsPAK := nil;
+end;
+
+function TGLVfsPAK.GetFile(index: integer): TStream;
+begin
+  FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index,
+    soFromBeginning);
+  FStream.Read(Dir, SizeOf(TFileSection));
+  FStream.Seek(Dir.FilePos, soFromBeginning);
+  Result := TMemoryStream.Create;
+  Result.CopyFrom(FStream, Dir.FileLength);
+  Result.Position := 0;
+end;
+
+function TGLVfsPAK.FileExists(const FileName: string): Boolean;
+begin
+  Result := (FFiles.IndexOf(FileName) > -1);
+end;
+
+function TGLVfsPAK.GetFile(const FileName: string): TStream;
+begin
+  Result := nil;
+  if Self.FileExists(FileName) then
+    Result := GetFile(FFiles.IndexOf(FileName));
+end;
+
+function TGLVfsPAK.GetFileSize(index: integer): integer;
+begin
+  FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index,
+    soFromBeginning);
+  FStream.Read(Dir, SizeOf(Dir));
+  Result := Dir.FileLength;
+end;
+
+function TGLVfsPAK.GetFileSize(const FileName: string): integer;
+begin
+  Result := -1;
+  if Self.FileExists(FileName) then
+    Result := GetFileSize(FFiles.IndexOf(FileName));
+end;
+
+{$WARNINGS OFF}
+
+procedure TGLVfsPAK.AddFromStream(const FileName, Path: string; F: TStream);
+var
+  Temp: TMemoryStream;
+begin
+  FStream.Position := FHeader.DirOffset;
+  if FHeader.DirLength > 0 then
+  begin
+    Temp := TMemoryStream.Create;
+    Temp.CopyFrom(FStream, FHeader.DirLength);
+    Temp.Position := 0;
+    FStream.Position := FHeader.DirOffset;
+  end;
+  Dir.FilePos := FHeader.DirOffset;
+
+  Dir.FileLength := F.Size;
+  FStream.CopyFrom(F, 0);
+  FHeader.DirOffset := FStream.Position;
+  if FHeader.DirLength > 0 then
+  begin
+    FStream.CopyFrom(Temp, 0);
+    Temp.Free;
+  end;
+  StrPCopy(Dir.FileName, Path + ExtractFileName(FileName));
+  FStream.WriteBuffer(Dir, SizeOf(TFileSection));
+  FHeader.DirLength := FHeader.DirLength + SizeOf(TFileSection);
+  FStream.Position := 0;
+  FStream.WriteBuffer(FHeader, SizeOf(TPakHeader));
+  FFiles.Add(Dir.FileName);
+end;
+
+{$WARNINGS ON}
+
+procedure TGLVfsPAK.AddFromFile(const FileName, Path: string);
+var
+  F: TFileStream;
+begin
+  if not FileExists(FileName) then
+    Exit;
+  F := TFileStream.Create(FileName, fmOpenRead);
+  try
+    AddFromStream(FileName, Path, F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TGLVfsPAK.AddEmptyFile(const FileName, Path: string);
+var
+  F: TMemoryStream;
+begin
+  F := TMemoryStream.Create;
+  try
+    AddFromStream(FileName, Path, F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TGLVfsPAK.RemoveFile(index: integer);
+var
+  Temp: TMemoryStream;
+  i: integer;
+  F: TFileSection;
+begin
+  Temp := TMemoryStream.Create;
+  FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index,
+    soFromBeginning);
+  FStream.ReadBuffer(Dir, SizeOf(TFileSection));
+  FStream.Seek(Dir.FilePos + Dir.FileLength, soFromBeginning);
+  Temp.CopyFrom(FStream, FStream.Size - FStream.Position);
+  FStream.Position := Dir.FilePos;
+  FStream.CopyFrom(Temp, 0);
+  FHeader.DirOffset := FHeader.DirOffset - Dir.FileLength;
+  Temp.Clear;
+  for i := 0 to FileCount - 1 do
+    if i > index then
+    begin
+      FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * i,
+        soFromBeginning);
+      FStream.ReadBuffer(F, SizeOf(TFileSection));
+      FStream.Position := FStream.Position - SizeOf(TFileSection);
+      F.FilePos := F.FilePos - Dir.FileLength;
+      FStream.WriteBuffer(F, SizeOf(TFileSection));
+    end;
+
+  i := FHeader.DirOffset + SizeOf(TFileSection) * index;
+  FStream.Position := i + SizeOf(TFileSection);
+  if FStream.Position < FStream.Size then
+  begin
+    Temp.CopyFrom(FStream, FStream.Size - FStream.Position);
+    FStream.Position := i;
+    FStream.CopyFrom(Temp, 0);
+  end;
+  Temp.Free;
+  FHeader.DirLength := FHeader.DirLength - SizeOf(TFileSection);
+  FStream.Position := 0;
+  FStream.WriteBuffer(FHeader, SizeOf(TPakHeader));
+  FStream.Size := FStream.Size - Dir.FileLength - SizeOf(TFileSection);
+  MakeFileList;
+end;
+
+procedure TGLVfsPAK.RemoveFile(const FileName: string);
+begin
+  if Self.FileExists(FileName) then
+    RemoveFile(FFiles.IndexOf(FileName));
+end;
+
+procedure TGLVfsPAK.Extract(index: integer; const NewName: string);
+var
+  s: TFileStream;
+begin
+  if NewName = '' then
+    Exit;
+  if (index < 0) or (index >= FileCount) then
+    Exit;
+  s := TFileStream.Create(NewName, fmCreate);
+  s.CopyFrom(GetFile(index), 0);
+  s.Free;
+end;
+
+procedure TGLVfsPAK.Extract(const FileName, NewName: string);
+begin
+  if Self.FileExists(FileName) then
+    Extract(FFiles.IndexOf(FileName), NewName);
+end;
+
+end.

Source/GLIsolines.pas

@@ -21,7 +21,7 @@ uses
   GLObjects, 
   GLMultiPolygon,  
   GLCoordinates,
-  GLTypes, 
+  GLVectorRecTypes,
   GLColor, 
   GLSpline, 
   GLspaceText, 

Source/GLIsosurface.pas

@@ -42,7 +42,7 @@ uses
   GLMesh,
   GLVectorFileObjects,
   GLVectorTypes,
-  GLTypes;
+  GLVectorRecTypes;
 
 const
   ALLOC_SIZE = 65536;

Source/GLPlugInIntf.pas

@@ -1,32 +0,0 @@
-//
-// This unit is part of the GLScene Engine, http://glscene.org
-//
-{
-  An interface unit to plug-ins. 
-  For more information see help file for writing plug-ins. 
-}
-
-unit GLPlugInIntf;
-
-interface
-
-{$I GLScene.inc}
-
-type
-  TPIServiceType = (stRaw, stObject, stBitmap, stTexture, stImport, stExport);
-  TPIServices = set of TPIServiceType;
-
-  TEnumCallBack = procedure(Name: PAnsiChar); stdcall;
-
-  TEnumResourceNames = procedure(Service: TPIServiceType;
-    Callback: TEnumCallBack); stdcall;
-  TGetServices = function: TPIServices; stdcall;
-  TGetVendor = function: PAnsiChar; stdcall;
-  TGetDescription = function: PAnsiChar; stdcall;
-  TGetVersion = function: PAnsiChar; stdcall;
-
-//------------------------------------------------------------
-implementation
-//------------------------------------------------------------
-
-end.

Source/GLS.FileDXF.pas

@@ -0,0 +1,904 @@
+//
+// This unit is part of the GLScene Engine, http://glscene.org
+//
+
+unit GLS.FileDXF;
+
+(*
+  Support-Code to load DXF (Drawing eXchange Files) TGLFreeForm or
+  TGLActor Components in GLScene.
+  Note that you must manually add this unit to one of your project's uses
+  to enable support for DXF at run-time.
+  Turn on TwoSideLighting in your Buffer! DXF-Faces have no defined winding order
+*)
+
+interface
+
+uses
+  System.Classes,
+  System.SysUtils,
+
+  GLVectorTypes,
+  GLPersistentClasses,
+  GLApplicationFileIO,
+  GLVectorGeometry,
+  GLVectorLists,
+  GLScene,
+  GLTexture,
+  GLVectorFileObjects,
+  GLMaterial;
+
+type
+  TGLDXFVectorFile = class(TGLVectorFile)
+  private
+    // Load from this stream
+    FSourceStream: TStream;
+    // Buffer and current line
+    FBuffer: String;
+    // Line number - for error messages
+    FLineNo: Integer;
+    // Stream done?
+    FEof: Boolean;
+    // Position in the buffer
+    FBufPos: Integer;
+    HasPushedCode: Boolean;
+    PushedCode: Integer;
+    FLayers: TStringList;
+    FBlocks: TStringList;
+    FLastpercentdone: BYTE;
+  protected
+    procedure PushCode(code: Integer);
+    function GetCode: Integer;
+    procedure SkipTable;
+    procedure SkipSection;
+    // procedure DoProgress (Stage: TGLProgressStage; PercentDone: single; RedrawNow: Boolean; const Msg: string);
+    function NeedMesh(basemesh: TGLBaseMesh; layer: STRING): TMeshObject;
+    function NeedFaceGroup(m: TMeshObject; fgmode: TGLFaceGroupMeshMode;
+      fgmat: STRING): TFGVertexIndexList;
+    procedure NeedMeshAndFaceGroup(basemesh: TGLBaseMesh; layer: STRING;
+      fgmode: TGLFaceGroupMeshMode; fgmat: STRING; var m: TMeshObject;
+      var fg: TFGVertexIndexList);
+
+    function ReadLine: STRING;
+    // Read a single line of text from the source stream, set FEof to true when done.
+    function ReadInt: Integer;
+    function ReadDouble: double;
+    procedure ReadTables;
+    procedure ReadLayer;
+    procedure ReadLayerTable;
+    procedure ReadBlocks;
+    procedure ReadInsert(basemesh: TGLBaseMesh);
+    procedure ReadEntity3Dface(basemesh: TGLBaseMesh);
+    procedure ReadEntityPolyLine(basemesh: TGLBaseMesh);
+    procedure ReadEntities(basemesh: TGLBaseMesh);
+
+  public
+    class function Capabilities: TGLDataFileCapabilities; override;
+    procedure LoadFromStream(aStream: TStream); override;
+  end;
+
+implementation
+
+procedure BuildNormals(m: TMeshObject); FORWARD;
+
+const
+  DXFcolorsRGB: ARRAY [1 .. 255] OF LONGINT = ($FF0000, $FFFF00, $00FF00,
+    $00FFFF, $0000FF, $FF00FF, $000000, $000000, $000000, $FF0000, $FF8080,
+    $A60000, $A65353, $800000, $804040, $4D0000, $4D2626, $260000, $261313,
+    $FF4000, $FF9F80, $A62900, $A66853, $802000, $805040, $4D1300, $4D3026,
+    $260A00, $261813, $FF8000, $FFBF80, $A65300, $A67C53, $804000, $806040,
+    $4D2600, $4D3926, $261300, $261D13, $FFBF00, $FFDF80, $A67C00, $A69153,
+    $806000, $807040, $4D3900, $4D4326, $261D00, $262113, $FFFF00, $FFFF80,
+    $A6A600, $A6A653, $808000, $808040, $4D4D00, $4D4D26, $262600, $262613,
+    $BFFF00, $DFFF80, $7CA600, $91A653, $608000, $708040, $394D00, $434D26,
+    $1D2600, $212613, $80FF00, $BFFF80, $53A600, $7CA653, $408000, $608040,
+    $264D00, $394D26, $132600, $1D2613, $40FF00, $9FFF80, $29A600, $68A653,
+    $208000, $508040, $134D00, $304D26, $0A2600, $182613, $00FF00, $80FF80,
+    $00A600, $53A653, $008000, $408040, $004D00, $264D26, $002600, $132613,
+    $00FF40, $80FF9F, $00A629, $53A668, $008020, $408050, $004D13, $264D30,
+    $00260A, $132618, $00FF80, $80FFBF, $00A653, $53A67C, $008040, $408060,
+    $004D26, $264D39, $002613, $13261D, $00FFBF, $80FFDF, $00A67C, $53A691,
+    $008060, $408070, $004D39, $264D43, $00261D, $132621, $00FFFF, $80FFFF,
+    $00A6A6, $53A6A6, $008080, $408080, $004D4D, $264D4D, $002626, $132626,
+    $00BFFF, $80DFFF, $007CA6, $5391A6, $006080, $407080, $00394D, $26434D,
+    $001D26, $132126, $0080FF, $80BFFF, $0053A6, $537CA6, $004080, $406080,
+    $00264D, $26394D, $001326, $131D26, $0040FF, $809FFF, $0029A6, $5368A6,
+    $002080, $405080, $00134D, $26304D, $000A26, $131826, $0000FF, $8080FF,
+    $0000A6, $5353A6, $000080, $404080, $00004D, $26264D, $000026, $131326,
+    $4000FF, $9F80FF, $2900A6, $6853A6, $200080, $504080, $13004D, $30264D,
+    $0A0026, $181326, $8000FF, $BF80FF, $5300A6, $7C53A6, $400080, $604080,
+    $26004D, $39264D, $130026, $1D1326, $BF00FF, $DF80FF, $7C00A6, $9153A6,
+    $600080, $704080, $39004D, $43264D, $1D0026, $211326, $FF00FF, $FF80FF,
+    $A600A6, $A653A6, $800080, $804080, $4D004D, $4D264D, $260026, $261326,
+    $FF00BF, $FF80DF, $A6007C, $A65391, $800060, $804070, $4D0039, $4D2643,
+    $26001D, $261321, $FF0080, $FF80BF, $A60053, $A6537C, $800040, $804060,
+    $4D0026, $4D2639, $260013, $26131D, $FF0040, $FF809F, $A60029, $A65368,
+    $800020, $804050, $4D0013, $4D2630, $26000A, $261318, $545454, $767676,
+    $989898, $BBBBBB, $DDDDDD, $FFFFFF);
+
+const
+  BufSize = 65536; // Load input data in chunks of BufSize Bytes.
+  LineLen = 100; // Allocate memory for the current line in chunks
+
+  function RGB2BGR(bgr: LONGINT): LONGINT;
+  begin
+    result := ((bgr SHR 16) and $FF) or (bgr AND $FF00) or
+      ((bgr SHL 16) and $FF0000)
+  end;
+
+  function StreamEOF(S: TStream): Boolean;
+  begin // Is the stream at its end?
+    result := (S.Position >= S.Size);
+  end;
+
+  class function TGLDXFVectorFile.Capabilities: TGLDataFileCapabilities;
+  begin
+    result := [dfcRead];
+  end;
+
+  function TGLDXFVectorFile.ReadLine: STRING;
+  var
+    j: Integer;
+    FLine: STRING;
+    NewlineChar: CHAR;
+    procedure FillBuffer;
+    var
+      l: Integer;
+    begin
+      l := FSourceStream.Size - FSourceStream.Position;
+      if l > BufSize then
+        l := BufSize;
+      SetLength(FBuffer, l);
+      FSourceStream.Read(FBuffer[1], l);
+      FBufPos := 1;
+    end;
+
+  begin
+    Inc(FLineNo);
+    if FBufPos < 1 then
+      FillBuffer;
+    j := 1;
+    while True do
+    begin
+      if FBufPos > Length(FBuffer) then
+      begin
+        if StreamEOF(FSourceStream) then
+        begin
+          FEof := True;
+          break;
+        end
+        else
+          FillBuffer
+      end
+      else
+      begin
+        case FBuffer[FBufPos] of
+          #10, #13:
+            begin
+              NewlineChar := FBuffer[FBufPos];
+              Inc(FBufPos);
+              if FBufPos > Length(FBuffer) then
+                if StreamEOF(FSourceStream) then
+                  break
+                else
+                  FillBuffer;
+              if ((FBuffer[FBufPos] = #10) or (FBuffer[FBufPos] = #13)) and
+                (FBuffer[FBufPos] <> NewlineChar) then
+                Inc(FBufPos);
+              break;
+            end;
+        else
+          if j > Length(FLine) then
+            SetLength(FLine, Length(FLine) + LineLen);
+          if FBuffer[FBufPos] = #9 then
+            FLine[j] := #32
+          else
+            FLine[j] := FBuffer[FBufPos];
+          Inc(FBufPos);
+          Inc(j);
+        end;
+      end;
+    end;
+    SetLength(FLine, j - 1);
+    ReadLine := Trim(FLine);
+  end;
+
+(*
+  procedure TGLDXFVectorFile.DoProgress (Stage: TGLProgressStage; PercentDone: single; RedrawNow: Boolean; const Msg: string);
+  var perc:BYTE;
+  begin
+  // If the following line stops your compiler, just comment this function
+  if @owner.OnProgress<>NIL then
+  begin
+  perc:=round(percentdone);
+  if (perc<>Flastpercentdone) or (msg<>'') or redrawnow then
+  owner.OnProgress (owner,stage,perc,redrawnow,msg);
+  Flastpercentdone:=perc;
+  end;
+  end;
+*)
+  procedure TGLDXFVectorFile.PushCode(code: Integer);
+  begin
+    PushedCode := code;
+    HasPushedCode := True;
+  end;
+
+  function TGLDXFVectorFile.GetCode: Integer;
+  var
+    S: STRING;
+  begin
+    if HasPushedCode then
+    begin
+      GetCode := PushedCode;
+      HasPushedCode := FALSE;
+    end
+    else
+    begin
+      S := ReadLine;
+      result := StrToIntDef(S, -1);
+      if result = -1 then
+        raise Exception.create('Invalid DXF Code ' + S + ' on Line #' +
+          IntToStr(FLineNo));
+    end;
+  end;
+
+  function TGLDXFVectorFile.ReadDouble: double;
+  var
+    S: String;
+    c: CHAR;
+  begin
+    c := FormatSettings.DecimalSeparator;
+    FormatSettings.DecimalSeparator := '.';
+    S := Trim(ReadLine);
+    result := StrToFloat(S);
+    FormatSettings.DecimalSeparator := c;
+  end;
+
+  function TGLDXFVectorFile.ReadInt: Integer;
+  var
+    S: String;
+  begin
+    S := Trim(ReadLine);
+    result := StrToInt(S);
+  end;
+
+  procedure TGLDXFVectorFile.SkipSection;
+  var
+    S: String;
+    code: Integer;
+  begin
+    repeat
+      code := GetCode;
+      S := ReadLine;
+    until (code = 0) and (S = 'ENDSEC');
+  end;
+
+  procedure TGLDXFVectorFile.SkipTable;
+  var
+    S: String;
+    code: Integer;
+  begin
+    repeat
+      code := GetCode;
+      S := ReadLine;
+    until (code = 0) and (S = 'ENDTAB');
+  end;
+
+  procedure TGLDXFVectorFile.ReadLayer;
+  var
+    layername, color: String;
+    code: Integer;
+  begin
+    color := '1';
+    repeat
+      code := GetCode;
+      case code of
+        0:
+          ;
+        2:
+          layername := ReadLine;
+        70:
+          ReadLine; // freeze and lock flags
+        62:
+          color := ReadLine;
+      else
+        ReadLine;
+      end;
+    until code = 0;
+    PushCode(0);
+    FLayers.AddObject(layername, POINTER(StrToIntDef(color, 1)));
+  end;
+
+  procedure TGLDXFVectorFile.ReadLayerTable;
+  var
+    S: STRING;
+    code: Integer;
+  begin
+    repeat
+      code := GetCode;
+      S := ReadLine;
+      if (code = 0) and (S = 'LAYER') then
+        ReadLayer;
+    until (code = 0) and (S = 'ENDTAB');
+  end;
+
+  procedure TGLDXFVectorFile.ReadTables;
+  var
+    S: String;
+    code: Integer;
+  begin
+    repeat
+      code := GetCode;
+      S := ReadLine;
+      if (code = 0) and (S = 'TABLE') then
+      begin
+        code := GetCode;
+        S := ReadLine;
+        if (code = 2) then
+          if S = 'LAYER' then
+            ReadLayerTable
+          else
+            SkipTable; // LTYPE, STYLE, UCS, and more currently skipped
+      end
+      until (code = 0) and (S = 'ENDSEC');
+    end;
+
+    procedure TGLDXFVectorFile.ReadBlocks;
+    var
+      S: String;
+      code: Integer;
+      blockname: String;
+      blockmesh: TGLFreeForm;
+
+    begin
+      // This code reads blocks into orphaned TGLFreeForms.
+      // ReadInsert then either copies or parents this object to its parent
+      // unused blocks are freed upon completion
+      repeat
+        code := GetCode;
+        S := ReadLine;
+        if (code = 0) and (S = 'BLOCK') then
+        begin
+          blockmesh := TGLFreeForm.create(owner);
+          blockmesh.IgnoreMissingTextures := True;
+          blockmesh.MaterialLibrary := owner.MaterialLibrary;
+          blockmesh.OnProgress := NIL;
+          blockname := 'DXFBLOCK' + IntToStr(FBlocks.count);
+          repeat
+            code := GetCode;
+            case code of
+              0:
+                ;
+              2:
+                blockname := ReadLine;
+            else
+              S := ReadLine;
+            end;
+          until code = 0;
+          PushCode(0);
+          FBlocks.AddObject(blockname, blockmesh);
+          ReadEntities(blockmesh);
+          // basemesh.Direction.SetVector(0,1,0);
+          // code:=GetCode;
+          // s:=ReadLine;
+          // asm nop end;
+        end;
+      until (code = 0) and (S = 'ENDSEC');
+    end;
+
+    procedure TGLDXFVectorFile.ReadInsert(basemesh: TGLBaseMesh);
+    var
+      code, idx, indexoffset: Integer;
+      i, j, k: Integer;
+      blockname, S: STRING;
+      pt, insertpoint, scale: TAffineVector;
+      blockmesh: TGLBaseMesh;
+      // blockproxy  :TGLProxyObject;
+      mo_block: TMeshObject;
+      mo_base: TMeshObject;
+      fg_block, fg_base: TFGVertexIndexList;
+    begin
+      blockname := '';
+      insertpoint := NullVector;
+      scale := XYZvector;
+      repeat // see ReadBlocks for details
+        code := GetCode;
+        case code of
+          0:
+            ;
+          2:
+            blockname := ReadLine;
+          10:
+            insertpoint.X := ReadDouble;
+          20:
+            insertpoint.Y := ReadDouble;
+          30:
+            insertpoint.Z := ReadDouble;
+          41:
+            scale.X := ReadDouble;
+          42:
+            scale.Y := ReadDouble;
+          43:
+            scale.Z := ReadDouble;
+        else
+          S := ReadLine;
+        end;
+      until code = 0;
+      idx := FBlocks.IndexOf(blockname);
+      if idx >= 0 then
+      begin
+        blockmesh := FBlocks.Objects[idx] as TGLBaseMesh;
+
+        // FLAT STRUCTURES
+        // Insert a block into its parent by copying the contents.
+        // the blockmesh will be freed upon completion, leaving only the copies.
+        for i := 0 to blockmesh.MeshObjects.count - 1 do
+        begin
+          mo_block := blockmesh.MeshObjects[i];
+          mo_base := NeedMesh(basemesh, mo_block.name);
+          indexoffset := mo_base.vertices.count;
+          for j := 0 to mo_block.vertices.count - 1 do
+          begin
+            pt := mo_block.vertices[j];
+            ScaleVector(pt, scale);
+            AddVector(pt, insertpoint);
+            mo_base.vertices.Add(pt);
+          end;
+          for j := 0 to mo_block.FaceGroups.count - 1 do
+          begin
+            fg_block := mo_block.FaceGroups[j] as TFGVertexIndexList;
+            fg_base := NeedFaceGroup(mo_base, fg_block.mode,
+              fg_block.MaterialName);
+            for k := 0 to fg_block.VertexIndices.count - 1 do
+            begin
+              fg_base.VertexIndices.Add(fg_block.VertexIndices[k] +
+                indexoffset);
+            end;
+          end;
+        end;
+
+        // TREE STRUCTURES
+        // Instead of copying the contents of the block, they are parented to the
+        // base mesh. If the block already has a parent, a proxy object is created.
+        // WARNING: THE CODE BELOW DOES NOT WORK.
+        (*
+          if blockmesh.Parent =NIL then
+          begin
+          blockmesh.Position.AsAffineVector:=insertpoint;
+          blockmesh.ShowAxes:=TRUE;
+          basemesh.AddChild(blockmesh);
+          for i:=0 to blockmesh.MeshObjects.Count-1 do
+          BuildNormals(blockmesh.MeshObjects[i]);
+          end
+          else
+          begin
+          blockproxy:=TGLproxyObject.CreateAsChild(basemesh);
+          blockproxy.MasterObject:=blockmesh;
+          blockproxy.Position.AsAffineVector:=insertpoint;
+          blockproxy.ShowAxes:=TRUE;
+          end;
+        *)
+      end;
+      PushCode(0);
+    end;
+
+    function TGLDXFVectorFile.NeedMesh(basemesh: TGLBaseMesh; layer: STRING)
+      : TMeshObject;
+    var
+      i: Integer;
+    begin
+      i := 0;
+      while (i < basemesh.MeshObjects.count) and
+        not(basemesh.MeshObjects[i].name = layer) do
+        Inc(i);
+      if i < basemesh.MeshObjects.count then
+        result := basemesh.MeshObjects[i]
+      else
+      begin
+        result := TMeshObject.CreateOwned(basemesh.MeshObjects);
+        result.mode := momFaceGroups;
+        result.name := layer;
+      end;
+    end;
+
+    function TGLDXFVectorFile.NeedFaceGroup(m: TMeshObject;
+      fgmode: TGLFaceGroupMeshMode; fgmat: STRING): TFGVertexIndexList;
+    var
+      i: Integer;
+      acadcolor: LONGINT;
+      libmat: TGLLibMaterial;
+      fg: TFGVertexIndexList;
+    begin
+      i := 0;
+      while (i < m.FaceGroups.count) and
+        not((m.FaceGroups[i] is TFGVertexIndexList) and
+        ((m.FaceGroups[i] as TFGVertexIndexList).mode = fgmode) and
+        (m.FaceGroups[i].MaterialName = fgmat)) do
+        Inc(i);
+      if i < m.FaceGroups.count then
+        fg := m.FaceGroups[i] as TFGVertexIndexList
+      else
+      begin
+        fg := TFGVertexIndexList.CreateOwned(m.FaceGroups);
+        fg.mode := fgmode;
+        fg.MaterialName := fgmat;
+        if owner.MaterialLibrary <> NIL then
+        begin
+          libmat := owner.MaterialLibrary.Materials.GetLibMaterialByName(fgmat);
+          if libmat = NIL then // creates a colored material
+          begin
+            acadcolor := StrToIntDef(fgmat, 0);
+            if acadcolor in [1 .. 255] then
+            begin
+              libmat := owner.MaterialLibrary.Materials.Add;
+              libmat.name := fgmat;
+              libmat.Material.FrontProperties.Diffuse.AsWinColor :=
+                RGB2BGR(DXFcolorsRGB[acadcolor]);
+              libmat.Material.BackProperties.Diffuse.AsWinColor :=
+                RGB2BGR(DXFcolorsRGB[acadcolor]);
+              libmat.Material.FaceCulling := fcNoCull;
+            end;
+          end;
+        end;
+      end;
+      result := fg;
+    end;
+
+    procedure TGLDXFVectorFile.NeedMeshAndFaceGroup(basemesh: TGLBaseMesh;
+      layer: STRING; fgmode: TGLFaceGroupMeshMode; fgmat: STRING;
+      var m: TMeshObject; var fg: TFGVertexIndexList);
+    begin
+      m := NeedMesh(basemesh, layer);
+      fg := NeedFaceGroup(m, fgmode, fgmat);
+    end;
+
+    procedure TGLDXFVectorFile.ReadEntity3Dface(basemesh: TGLBaseMesh);
+    var
+      code, i: Integer;
+      pts: ARRAY [0 .. 3] of TAffineVector;
+      isquad: Boolean;
+      fg: TFGVertexIndexList;
+      color, layer: STRING;
+      m: TMeshObject;
+    begin
+      color := '';
+      layer := '';
+      isquad := FALSE;
+      for i := 0 to 3 do
+        pts[i] := NullVector;
+      repeat
+        code := GetCode;
+        case code of
+          0:
+            ;
+          8:
+            layer := ReadLine; // Layer
+          10:
+            pts[0].X := ReadDouble;
+          11:
+            pts[1].X := ReadDouble;
+          12:
+            pts[2].X := ReadDouble;
+          13:
+            begin
+              pts[3].X := ReadDouble;
+              isquad := True
+            end;
+          20:
+            pts[0].Y := ReadDouble;
+          21:
+            pts[1].Y := ReadDouble;
+          22:
+            pts[2].Y := ReadDouble;
+          23:
+            begin
+              pts[3].Y := ReadDouble;
+              isquad := True
+            end;
+          30:
+            pts[0].Z := ReadDouble;
+          31:
+            pts[1].Z := ReadDouble;
+          32:
+            pts[2].Z := ReadDouble;
+          33:
+            begin
+              pts[3].Z := ReadDouble;
+              isquad := True
+            end;
+          62:
+            color := ReadLine; // Color
+        else
+          ReadLine;
+        end;
+      until code = 0;
+      PushCode(0);
+      isquad := isquad and ((pts[2].X <> pts[3].X) or (pts[2].Y <> pts[3].Y) or
+        (pts[2].Z <> pts[3].Z));
+      if isquad then
+        NeedMeshAndFaceGroup(basemesh, layer, fgmmQuads, color, m, fg)
+      else
+        NeedMeshAndFaceGroup(basemesh, layer, fgmmTriangles, color, m, fg);
+      fg.Add(m.vertices.FindOrAdd(pts[0]));
+      fg.Add(m.vertices.FindOrAdd(pts[1]));
+      fg.Add(m.vertices.FindOrAdd(pts[2]));
+      if isquad then
+        fg.Add(m.vertices.FindOrAdd(pts[3]));
+    end;
+
+    procedure TGLDXFVectorFile.ReadEntityPolyLine(basemesh: TGLBaseMesh);
+
+      procedure ReadPolylineVertex(m: TMeshObject; vertexindexbase: Integer);
+      var
+        color: STRING;
+        pt: TAffineVector;
+        fg: TFGVertexIndexList;
+        code, idx, i70, i71, i72, i73, i74: Integer;
+      begin
+        color := '';
+        pt := NullVector;
+        i70 := 0;
+        i71 := 0;
+        i72 := 0;
+        i73 := 0;
+        i74 := 0;
+        repeat
+          code := GetCode;
+          case code of
+            0:
+              ;
+            5:
+              ReadLine; // ID   :=ReadHex16;
+            8:
+              ReadLine; // ignore per vertex layer. Polyline vertices cannot cross layers!
+            10:
+              pt.X := ReadDouble;
+            20:
+              pt.Y := ReadDouble;
+            30:
+              pt.Z := ReadDouble;
+            62:
+              color := ReadLine;
+            70:
+              i70 := ReadInt;
+            71:
+              i71 := abs(ReadInt);
+              // negative values should hide points... we cannot
+            72:
+              i72 := abs(ReadInt);
+            73:
+              i73 := abs(ReadInt);
+            74:
+              i74 := abs(ReadInt);
+            100:
+              ReadLine; // Subclass Marker
+            330:
+              ReadLine; // Soft Pointer?
+          else
+            ReadLine;
+          end;
+        until code = 0;
+        PushCode(0);
+        if (color = '') or (color = '256') or (color = 'BYLAYER') then
+        begin
+          idx := FLayers.IndexOf(m.name);
+          if idx >= 0 then
+            color := IntToStr(LONGINT(FLayers.Objects[idx]));
+        end;
+        if i70 and 192 = 192 then
+        begin
+          m.vertices.Add(pt);
+        end
+        else if i70 and 192 = 128 then
+        begin
+          i71 := i71 - 1 + vertexindexbase;
+          i72 := i72 - 1 + vertexindexbase;
+          i73 := i73 - 1 + vertexindexbase;
+          if i74 = 0 then
+          begin
+            fg := NeedFaceGroup(m, fgmmTriangles, color);
+            fg.Add(i71);
+            fg.Add(i72);
+            fg.Add(i73);
+          end
+          else
+          begin
+            i74 := i74 - 1 + vertexindexbase;
+            fg := NeedFaceGroup(m, fgmmQuads, color);
+            fg.Add(i71);
+            fg.Add(i72);
+            fg.Add(i73);
+            fg.Add(i74);
+          end
+        end
+        else
+          // hmm?
+      end;
+
+    var
+      m: TMeshObject;
+      code, vertexindexbase: Integer;
+      S, layer: STRING;
+    begin
+      m := NIL;
+      vertexindexbase := 0;
+      repeat
+        code := GetCode;
+        S := ReadLine;
+        if (code = 8) then
+        begin
+          layer := S;
+          m := NeedMesh(basemesh, layer);
+          vertexindexbase := m.vertices.count;
+        end;
+        if (code = 0) and (S = 'VERTEX') and (m <> NIL) then
+          ReadPolylineVertex(m, vertexindexbase);
+      until (code = 0) and (S = 'SEQEND');
+      repeat
+        code := GetCode;
+        if code <> 0 then
+          ReadLine;
+      until (code = 0);
+      PushCode(0);
+    end;
+
+    procedure TGLDXFVectorFile.ReadEntities(basemesh: TGLBaseMesh);
+    var
+      code: Integer;
+      S: STRING;
+    begin
+      repeat
+        code := GetCode;
+        // DoProgress (psRunning,FSourceStream.Position/FSourceStream.Size*100,false,'');
+        case code of
+          0:
+            begin
+              S := ReadLine;
+              if S = 'POLYLINE' then
+                ReadEntityPolyLine(basemesh)
+              else if S = '3DFACE' then
+                ReadEntity3Dface(basemesh)
+              else if S = 'INSERT' then
+                ReadInsert(basemesh)
+              else if S = 'ENDSEC' then
+              begin
+              end
+              else if S = 'ENDBLK' then
+              begin
+              end
+              else
+                (*
+                asm
+                  nop
+                end    // put breakpoint here to catch other entities
+                *)
+            end;
+        else
+          S := ReadLine;
+        end;
+      until (code = 0) and ((S = 'ENDSEC') or (S = 'ENDBLK'));
+    end;
+
+    // build normals
+    procedure BuildNormals(m: TMeshObject);
+    var
+      i, j: Integer;
+      v1, v2, v3, v4, n: TAffineVector;
+    begin
+      for i := 0 to m.vertices.count - 1 do
+        m.Normals.Add(0, 0, 0);
+      for i := 0 to m.FaceGroups.count - 1 do
+        if m.FaceGroups[i] is TFGVertexIndexList then
+          with m.FaceGroups[i] as TFGVertexIndexList do
+            case mode of
+              fgmmTriangles:
+                begin
+                  for j := 0 to (VertexIndices.count div 3) - 1 do
+                  begin
+                    v1 := m.vertices[VertexIndices[j * 3]];
+                    v2 := m.vertices[VertexIndices[j * 3 + 1]];
+                    v3 := m.vertices[VertexIndices[j * 3 + 2]];
+                    n := CalcPlaneNormal(v1, v2, v3);
+                    m.Normals.items[VertexIndices[j * 3]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 3]], n);
+                    m.Normals.items[VertexIndices[j * 3 + 1]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 3 + 1]], n);
+                    m.Normals.items[VertexIndices[j * 3 + 2]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 3 + 2]], n);
+                  end;
+                end;
+              fgmmQuads:
+                begin
+                  for j := 0 to (VertexIndices.count div 4) - 1 do
+                  begin
+                    v1 := m.vertices[VertexIndices[j * 4]];
+                    v2 := m.vertices[VertexIndices[j * 4 + 1]];
+                    v3 := m.vertices[VertexIndices[j * 4 + 2]];
+                    v4 := m.vertices[VertexIndices[j * 4 + 3]];
+                    n := CalcPlaneNormal(v1, v2, v3);
+                    m.Normals.items[VertexIndices[j * 4]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 4]], n);
+                    m.Normals.items[VertexIndices[j * 4 + 1]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 4 + 1]], n);
+                    m.Normals.items[VertexIndices[j * 4 + 2]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 4 + 2]], n);
+                    m.Normals.items[VertexIndices[j * 4 + 3]] :=
+                      VectorAdd(m.Normals.items[VertexIndices[j * 4 + 3]], n);
+                  end;
+                end;
+            end;
+      for i := 0 to m.Normals.count - 1 do
+        m.Normals.items[i] := VectorNormalize(m.Normals.items[i]);
+    end;
+
+    procedure TGLDXFVectorFile.LoadFromStream(aStream: TStream);
+    var
+      S: STRING;
+      code, i: Integer;
+    begin
+      FLastpercentdone := 1;
+      /// DoProgress (psStarting,0,false,'Starting');
+      FEof := FALSE;
+      FSourceStream := aStream;
+      FLineNo := 0;
+      HasPushedCode := FALSE;
+      FLayers := TStringList.create;
+      FBlocks := TStringList.create;
+      while not FEof do
+      begin
+        /// DoProgress (psStarting,FSourceStream.Position/FSourceStream.Size*90,false,'');
+        code := GetCode;
+        if (code = 0) then
+        begin
+          S := ReadLine;
+          if S = 'EOF' then
+            break
+          else if S = 'SECTION' then
+          begin
+            code := GetCode;
+            if code <> 2 then
+              raise Exception.create('Name must follow Section' + ' on Line #' +
+                IntToStr(FLineNo))
+            else
+            begin
+              S := ReadLine;
+              if S = 'HEADER' then
+                SkipSection
+              else if S = 'BLOCKS' then
+                ReadBlocks
+              else if S = 'ENTITIES' then
+                ReadEntities(owner)
+              else if S = 'CLASSES' then
+                SkipSection
+              else if S = 'TABLES' then
+                ReadTables
+              else if S = 'OBJECTS' then
+                SkipSection
+              else
+                SkipSection;
+            end
+          end
+          else if S = 'ENDSEC' then
+            raise Exception.create('SECTION/ENDSEC Mismatch' + ' on Line #' +
+              IntToStr(FLineNo))
+        end
+        else
+          S := ReadLine; // raise Exception.create ('Invalid Group Code');
+      end;
+      // calc normals
+      FLayers.free;
+      for i := FBlocks.count - 1 downto 0 do
+        (FBlocks.Objects[i] as TGLFreeForm).free;
+      FBlocks.free;
+      for i := 0 to owner.MeshObjects.count - 1 do
+        BuildNormals(owner.MeshObjects[i]);
+      /// DoProgress (psEnding,100,false,'');
+    end;
+
+//----------------------------------------------
+initialization
+//----------------------------------------------
+
+RegisterVectorFileFormat('dxf', 'AutoCAD Exchange Format', TGLDXFVectorFile);
+
+end.

Source/GLFileGRD.pas → Source/GLS.FileGRD.pas

@@ -1,247 +1,247 @@
-//
-// This unit is part of the GLScene Engine, http://glscene.org
-//
-
-unit GLFileGRD;
-
-(* GRD (Grid Text Format) vector file format implementation *)
-
-interface
-
-{$I GLScene.inc}
-
-uses
-  System.Classes,
-  System.SysUtils,
-
-  GLVectorGeometry,
-  GLVectorTypes,
-  GLVectorFileObjects,
-  GLApplicationFileIO,
-  GLGraph;
-
-type
-  (* The GRD file represents ascii grid formats in 2D/3D.
-    This is a format for storing regular grid values as a
-    matrices of cell centers. The format supports variations and
-    subformats. This importer works for Sutfer, ArcInfo and GMS formats *)
-  TGLGRDVectorFile = class(TGLVectorFile)
-  public
-    GLHeightField: TGLHeightField;
-    Nodes: array of TSingleArray;
-    class function Capabilities: TGLDataFileCapabilities; override;
-    procedure LoadFromStream(aStream: TStream); override;
-  private
-    StrVal: String;
-    StrLine: String;
-    MaxZ: Single;
-    function ExtractWord(N: Integer; const S: string;
-      const WordDelims: TSysCharSet): string;
-    function WordPosition(const N: Integer; const S: string;
-      const WordDelims: TSysCharSet): Integer;
-  end;
-
-// ------------------------------------------------------------------
-implementation
-// ------------------------------------------------------------------
-
-// ------------------
-// ------------------ TGLGRDVectorFile ------------------
-// ------------------
-
-const
-  dSURFBLANKVAL = 1.70141E38; // default value in Surfer for blanking
-  NODATA_value = -9999; // default value in GIS ArcInfo for blanking
-
-class function TGLGRDVectorFile.Capabilities: TGLDataFileCapabilities;
-begin
-  Result := [dfcRead];
-end;
-
-function TGLGRDVectorFile.WordPosition(const N: Integer; const S: string;
-  const WordDelims: TSysCharSet): Integer;
-var
-  Count, I: Integer;
-begin
-  Count := 0;
-  I := 1;
-  Result := 0;
-  while ((I <= Length(S)) and (Count <> N)) do
-  begin
-    // skip over delimiters
-    while (I <= Length(S)) and CharInSet(S[I], WordDelims) do
-      Inc(I);
-    // if we're not beyond end of S, we're at the start of a word
-    if I <= Length(S) then
-      Inc(Count);
-    // if not finished, find the end of the current word
-    if Count <> N then
-      while (I <= Length(S)) and not CharInSet(S[I], WordDelims) do
-        Inc(I)
-    else
-      Result := I;
-  end;
-end;
-
-function TGLGRDVectorFile.ExtractWord(N: Integer; const S: string;
-  const WordDelims: TSysCharSet): string;
-
-var
-  I, Len: Integer;
-
-begin
-  Len := 0;
-  I := WordPosition(N, S, WordDelims);
-  if (I <> 0) then
-    // find the end of the current word
-    while (I <= Length(S)) and not CharInSet(S[I], WordDelims) do
-    begin
-      // add the I'th character to result
-      Inc(Len);
-      SetLength(Result, Len);
-      Result[Len] := S[I];
-      Inc(I);
-    end;
-  SetLength(Result, Len);
-end;
-
-procedure TGLGRDVectorFile.LoadFromStream(aStream: TStream);
-var
-  I, J, K: Integer;
-  N: Integer; // N => counter to increment through file
-  Sl, Tl: TStringList;
-
-  Nx, Ny: Integer;
-  Dx, Dy: Single;
-  Xo, Xe, Yo, Ye, Zo, Ze: Single;
-  NBlanks: Integer; // Number of blank nodes
-  BlankVal, NoData: Double;
-
-  { sub } function ReadLine: string;
-begin
-  Result := Sl[N];
-  Inc(N);
-end;
-
-begin
-  Sl := TStringList.Create;
-  Tl := TStringList.Create;
-  try
-    Sl.LoadFromStream(aStream);
-    if (Copy(Sl[0], 1, 4) <> 'DSAA') and (Copy(Sl[0], 1, 5) <> 'ncols') then
-    begin
-      raise Exception.Create('Not a valid grd file !');
-      Exit;
-    end;
-
-    GLHeightField := TGLHeightField.Create(Owner);
-
-    Zo := 3 * 10E38; // Low
-    Ze := -3 * 10E38; // High
-    Tl.DelimitedText := Copy(ReadLine, 1, 4);
-
-    if (Tl[0] = 'DSAA') then // Surfer ASCII grid
-    begin
-      Tl.DelimitedText := ReadLine;
-      Nx := StrToInt(Tl[0]);
-      Ny := StrToInt(Tl[1]);
-
-      Tl.DelimitedText := ReadLine;
-      Xo := StrToFloat(Tl[0]);
-      Xe := StrToFloat(Tl[1]);
-
-      Tl.DelimitedText := ReadLine;
-      Yo := StrToFloat(Tl[0]);
-      Ye := StrToFloat(Tl[1]);
-
-      Tl.DelimitedText := ReadLine;
-      Zo := StrToFloat(Tl[0]);
-      Ze := StrToFloat(Tl[1]);
-
-      Dx := (Xe - Xo) / Nx;
-      Dy := (Ye - Yo) / Ny;
-
-      SetLength(Nodes, Ny, Nx);
-
-      NBlanks := 0;
-      BlankVal := dSURFBLANKVAL;
-      NoData := BlankVal; // NoData value
-
-      // loop over the Ny-1 Rows
-      for I := 0 to Ny - 1 do
-      begin
-        J := 0;
-        // reading lines until Nx-1 Cols entries have been obtained
-        while J <= Nx - 1 do
-        begin
-          StrLine := ReadLine;
-          K := 1;
-          StrVal := ExtractWord(K, StrLine, [' ']);
-          while (StrVal <> '') do
-          begin
-            if (J <= Nx - 1) then
-              Nodes[I, J] := StrToFloat(StrVal);
-            if Nodes[I, J] > MaxZ then
-              MaxZ := Nodes[I, J];
-            if (Nodes[I, J] >= BlankVal) then
-              NBlanks := NBlanks + 1;
-
-            Inc(J);
-            Inc(K);
-            StrVal := ExtractWord(K, StrLine, [' ']);
-          end;
-          if (J > Nx - 1) then
-            Break;
-        end;
-      end
-    end
-    else // ArcInfo ASCII grid
-    begin
-      Tl.DelimitedText := Sl[0];
-      Ny := StrToInt(Tl[1]); // ncols
-      Tl.DelimitedText := Sl[1];
-      Nx := StrToInt(Tl[1]); // nrows
-      Tl.DelimitedText := Sl[2];
-      Xo := StrToFloat(Tl[1]); // xllcorner
-      Tl.DelimitedText := Sl[3];
-      Yo := StrToFloat(Tl[1]); // yllcorner
-      Tl.DelimitedText := Sl[4];
-      Dx := StrToFloat(Tl[1]);
-      Dy := Dx; // cellsize
-      Tl.DelimitedText := Sl[5];
-      NoData := StrToFloat(Tl[1]); // NoData value
-
-      MaxZ := -3 * 10E38;
-      SetLength(Nodes, Nx, Ny);
-
-      for I := 0 to Nx - 1 do
-      begin
-        Tl.DelimitedText := Sl[I + 6];
-        for J := 0 to Ny - 1 do
-        begin
-          StrVal := Tl[J];
-          Nodes[I, J] := StrToFloat(StrVal);
-          if Nodes[I, J] > MaxZ then
-            MaxZ := Nodes[I, J];
-        end;
-      end;
-    end;
-
-    GLHeightField.XSamplingScale.Min := -(Nx div 2);
-    GLHeightField.XSamplingScale.Max := (Nx div 2);
-    GLHeightField.YSamplingScale.Min := -(Ny div 2);
-    GLHeightField.YSamplingScale.Max := (Ny div 2);
-
-  finally
-    Tl.Free;
-    Sl.Free;
-  end;
-end;
-
-// ------------------------------------------------------------------
-initialization
-// ------------------------------------------------------------------
-
-RegisterVectorFileFormat('grd', 'ArcInfo/Surfer grids', TGLGRDVectorFile);
-
-end.
+//
+// This unit is part of the GLScene Engine, http://glscene.org
+//
+
+unit GLS.FileGRD;
+
+(* GRD (Grid Text Format) vector file format implementation *)
+
+interface
+
+{$I GLScene.inc}
+
+uses
+  System.Classes,
+  System.SysUtils,
+
+  GLVectorGeometry,
+  GLVectorTypes,
+  GLVectorFileObjects,
+  GLApplicationFileIO,
+  GLGraph;
+
+type
+  (* The GRD file represents ascii grid formats in 2D/3D.
+    This is a format for storing regular grid values as a
+    matrices of cell centers. The format supports variations and
+    subformats. This importer works for Sutfer, ArcInfo and GMS formats *)
+  TGLGRDVectorFile = class(TGLVectorFile)
+  public
+    GLHeightField: TGLHeightField;
+    Nodes: array of TSingleArray;
+    class function Capabilities: TGLDataFileCapabilities; override;
+    procedure LoadFromStream(aStream: TStream); override;
+  private
+    StrVal: String;
+    StrLine: String;
+    MaxZ: Single;
+    function ExtractWord(N: Integer; const S: string;
+      const WordDelims: TSysCharSet): string;
+    function WordPosition(const N: Integer; const S: string;
+      const WordDelims: TSysCharSet): Integer;
+  end;
+
+// ------------------------------------------------------------------
+implementation
+// ------------------------------------------------------------------
+
+// ------------------
+// ------------------ TGLGRDVectorFile ------------------
+// ------------------
+
+const
+  dSURFBLANKVAL = 1.70141E38; // default value in Surfer for blanking
+  NODATA_value = -9999; // default value in GIS ArcInfo for blanking
+
+class function TGLGRDVectorFile.Capabilities: TGLDataFileCapabilities;
+begin
+  Result := [dfcRead];
+end;
+
+function TGLGRDVectorFile.WordPosition(const N: Integer; const S: string;
+  const WordDelims: TSysCharSet): Integer;
+var
+  Count, I: Integer;
+begin
+  Count := 0;
+  I := 1;
+  Result := 0;
+  while ((I <= Length(S)) and (Count <> N)) do
+  begin
+    // skip over delimiters
+    while (I <= Length(S)) and CharInSet(S[I], WordDelims) do
+      Inc(I);
+    // if we're not beyond end of S, we're at the start of a word
+    if I <= Length(S) then
+      Inc(Count);
+    // if not finished, find the end of the current word
+    if Count <> N then
+      while (I <= Length(S)) and not CharInSet(S[I], WordDelims) do
+        Inc(I)
+    else
+      Result := I;
+  end;
+end;
+
+function TGLGRDVectorFile.ExtractWord(N: Integer; const S: string;
+  const WordDelims: TSysCharSet): string;
+
+var
+  I, Len: Integer;
+
+begin
+  Len := 0;
+  I := WordPosition(N, S, WordDelims);
+  if (I <> 0) then
+    // find the end of the current word
+    while (I <= Length(S)) and not CharInSet(S[I], WordDelims) do
+    begin
+      // add the I'th character to result
+      Inc(Len);
+      SetLength(Result, Len);
+      Result[Len] := S[I];
+      Inc(I);
+    end;
+  SetLength(Result, Len);
+end;
+
+procedure TGLGRDVectorFile.LoadFromStream(aStream: TStream);
+var
+  I, J, K: Integer;
+  N: Integer; // N => counter to increment through file
+  Sl, Tl: TStringList;
+
+  Nx, Ny: Integer;
+  Dx, Dy: Single;
+  Xo, Xe, Yo, Ye, Zo, Ze: Single;
+  NBlanks: Integer; // Number of blank nodes
+  BlankVal, NoData: Double;
+
+  { sub } function ReadLine: string;
+begin
+  Result := Sl[N];
+  Inc(N);
+end;
+
+begin
+  Sl := TStringList.Create;
+  Tl := TStringList.Create;
+  try
+    Sl.LoadFromStream(aStream);
+    if (Copy(Sl[0], 1, 4) <> 'DSAA') and (Copy(Sl[0], 1, 5) <> 'ncols') then
+    begin
+      raise Exception.Create('Not a valid grd file !');
+      Exit;
+    end;
+
+    GLHeightField := TGLHeightField.Create(Owner);
+
+    Zo := 3 * 10E38; // Low
+    Ze := -3 * 10E38; // High
+    Tl.DelimitedText := Copy(ReadLine, 1, 4);
+
+    if (Tl[0] = 'DSAA') then // Surfer ASCII grid
+    begin
+      Tl.DelimitedText := ReadLine;
+      Nx := StrToInt(Tl[0]);
+      Ny := StrToInt(Tl[1]);
+
+      Tl.DelimitedText := ReadLine;
+      Xo := StrToFloat(Tl[0]);
+      Xe := StrToFloat(Tl[1]);
+
+      Tl.DelimitedText := ReadLine;
+      Yo := StrToFloat(Tl[0]);
+      Ye := StrToFloat(Tl[1]);
+
+      Tl.DelimitedText := ReadLine;
+      Zo := StrToFloat(Tl[0]);
+      Ze := StrToFloat(Tl[1]);
+
+      Dx := (Xe - Xo) / Nx;
+      Dy := (Ye - Yo) / Ny;
+
+      SetLength(Nodes, Ny, Nx);
+
+      NBlanks := 0;
+      BlankVal := dSURFBLANKVAL;
+      NoData := BlankVal; // NoData value
+
+      // loop over the Ny-1 Rows
+      for I := 0 to Ny - 1 do
+      begin
+        J := 0;
+        // reading lines until Nx-1 Cols entries have been obtained
+        while J <= Nx - 1 do
+        begin
+          StrLine := ReadLine;
+          K := 1;
+          StrVal := ExtractWord(K, StrLine, [' ']);
+          while (StrVal <> '') do
+          begin
+            if (J <= Nx - 1) then
+              Nodes[I, J] := StrToFloat(StrVal);
+            if Nodes[I, J] > MaxZ then
+              MaxZ := Nodes[I, J];
+            if (Nodes[I, J] >= BlankVal) then
+              NBlanks := NBlanks + 1;
+
+            Inc(J);
+            Inc(K);
+            StrVal := ExtractWord(K, StrLine, [' ']);
+          end;
+          if (J > Nx - 1) then
+            Break;
+        end;
+      end
+    end
+    else // ArcInfo ASCII grid
+    begin
+      Tl.DelimitedText := Sl[0];
+      Ny := StrToInt(Tl[1]); // ncols
+      Tl.DelimitedText := Sl[1];
+      Nx := StrToInt(Tl[1]); // nrows
+      Tl.DelimitedText := Sl[2];
+      Xo := StrToFloat(Tl[1]); // xllcorner
+      Tl.DelimitedText := Sl[3];
+      Yo := StrToFloat(Tl[1]); // yllcorner
+      Tl.DelimitedText := Sl[4];
+      Dx := StrToFloat(Tl[1]);
+      Dy := Dx; // cellsize
+      Tl.DelimitedText := Sl[5];
+      NoData := StrToFloat(Tl[1]); // NoData value
+
+      MaxZ := -3 * 10E38;
+      SetLength(Nodes, Nx, Ny);
+
+      for I := 0 to Nx - 1 do
+      begin
+        Tl.DelimitedText := Sl[I + 6];
+        for J := 0 to Ny - 1 do
+        begin
+          StrVal := Tl[J];
+          Nodes[I, J] := StrToFloat(StrVal);
+          if Nodes[I, J] > MaxZ then
+            MaxZ := Nodes[I, J];
+        end;
+      end;
+    end;
+
+    GLHeightField.XSamplingScale.Min := -(Nx div 2);
+    GLHeightField.XSamplingScale.Max := (Nx div 2);
+    GLHeightField.YSamplingScale.Min := -(Ny div 2);
+    GLHeightField.YSamplingScale.Max := (Ny div 2);
+
+  finally
+    Tl.Free;
+    Sl.Free;
+  end;
+end;
+
+// ------------------------------------------------------------------
+initialization
+// ------------------------------------------------------------------
+
+RegisterVectorFileFormat('grd', 'ArcInfo/Surfer grids', TGLGRDVectorFile);
+
+end.

Source/GLFileTIN.pas → Source/GLS.FileTIN.pas

@@ -1,10 +1,10 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-   TIN (Triangular Irregular Network) vector file format implementation. 
-}
-unit GLFileTIN;
+
+unit GLS.FileTIN;
+
+(* TIN (Triangular Irregular Network) vector file format implementation *)
 
 interface
 
@@ -19,7 +19,7 @@ uses
   GLApplicationFileIO,
   GLVectorGeometry,
   GLUtils,
-  GLTypes;
+  GLVectorRecTypes;
 
 
 type

Source/GLSMemo.pas → Source/GLS.Memo.pas

@@ -1,5462 +1,5461 @@
-//
-// This unit is part of the GLScene Engine, http://glscene.org
-//
-{
-  Memo for GLScene
-}
-
-unit GLSMemo;
-
-interface
-
-{$I GLScene.inc}
-
-uses
-  WinApi.Windows,
-  WinApi.Messages,
-  System.SysUtils,
-  System.Classes,
-  System.UITypes,
-  VCL.Graphics,
-  VCL.Controls, 
-  VCL.Forms, 
-  VCL.Dialogs, 
-  VCL.ClipBrd,
-  VCL.StdCtrls, 
-  VCL.ExtCtrls;
-
-
-
-type
-  TBorderType = (btRaised, btLowered, btFlatRaised, btFlatLowered);
-  TCommand = Integer;
-
-  TCellSize = record
-    W, H: integer;
-  end;
-
-  TCellPos = record
-    X, Y: integer;
-  end;
-
-  TFullPos = record
-    LineNo, Pos: integer;
-  end;
-
-  TLineProp = class
-    FObject: TObject;
-    FStyleNo: integer;
-    FInComment: Boolean;
-    FInBrackets: integer;
-    FValidAttrs: Boolean;
-    FCharAttrs: string;
-  end;
-
-  TCharStyle = class(TPersistent)
-  private
-    FTextColor, FBkColor: TColor;
-    FStyle: TFontStyles;
-  published
-
-    property TextColor: TColor read FTextColor write FTextColor;
-    property BkColor: TColor read FBkColor write FBkColor;
-    property Style: TFontStyles read FStyle write FStyle;
-  end;
-
-  TStyleList = class(TList)
-  private
-    procedure CheckRange(Index: integer);
-    function GetTextColor(Index: Integer): TColor;
-    procedure SetTextColor(Index: Integer; Value: TColor);
-    function GetBkColor(Index: Integer): TColor;
-    procedure SetBkColor(Index: Integer; Value: TColor);
-    function GetStyle(Index: Integer): TFontStyles;
-    procedure SetStyle(Index: Integer; Value: TFontStyles);
-  protected
-    
-    property TextColor[Index: Integer]: TColor read GetTextColor write
-    SetTextColor;
-    property BkColor[Index: Integer]: TColor read GetBkColor write SetBkColor;
-    property Style[Index: Integer]: TFontStyles read GetStyle write SetStyle;
-  public
-    
-    destructor Destroy; override;
-    procedure Clear; override;
-    procedure Delete(Index: Integer);
-    function Add(ATextColor, ABkCOlor: TColor; AStyle: TFontStyles): Integer;
-    procedure Change(Index: integer; ATextColor, ABkColor: TColor; AStyle:
-      TFontStyles);
-  end;
-
-  TGLAbstractMemoObject = class(TObject)
-  public
-    function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
-      Boolean; virtual; abstract;
-    function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
-      Boolean; virtual; abstract;
-    function MouseMove(Shift: TShiftState; X, Y: Integer):
-      Boolean; virtual; abstract;
-  end;
-
-  TGLSMemoScrollBar = class;
-
-  TGLSMemoAbstractScrollableObject = class(TCustomControl)
-  protected
-    procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
-      virtual; abstract;
-    procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer);
-      virtual; abstract;
-  end;
-
-  TGLSCustomMemo = class;
-
-  TsbState =
-    (
-    sbsWait,
-    sbsBack,
-    sbsForward,
-    sbsPageBack,
-    sbsPageForward,
-    sbsDragging
-    );
-
-  TGLSMemoScrollBar = class(TGLAbstractMemoObject)
-  private
-    FKind: TScrollBarKind;
-    FParent: TGLSMemoAbstractScrollableObject;
-    FLeft, FTop, FWidth, FHeight: integer;
-    FTotal, FMaxPosition, FPosition: integer;
-    FButtonLength: integer;
-    FState: TsbState;
-    FXOffset, FYOffset: integer;
-    procedure SetParams(Index: integer; Value: integer);
-    procedure SetState(Value: TsbState);
-    function GetRect: TRect;
-    function GetThumbRect: TRect;
-    function GetBackRect: TRect;
-    function GetMiddleRect: TRect;
-    function GetForwardRect: TRect;
-    function GetPgBackRect: TRect;
-    function GetPgForwardRect: TRect;
-  public
-    constructor Create(AParent: TGLSMemoAbstractScrollableObject;
-      AKind: TScrollBarKind);
-    procedure PaintTo(ACanvas: TCanvas);
-    function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
-      Boolean; override;
-    function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
-      Boolean; override;
-    function MouseMove(Shift: TShiftState; X, Y: Integer):
-      Boolean; override;
-    function MoveThumbTo(X, Y: Integer): integer;
-    property Parent: TGLSMemoAbstractScrollableObject read FParent;
-    property Kind: TScrollBarKind read FKind write FKind;
-    property State: TsbState read FState write SetState;
-    property Left: integer index 0 read FLeft write SetParams;
-    property Top: integer index 1 read FTop write SetParams;
-    property Width: integer index 2 read FWidth write SetParams;
-    property Height: integer index 3 read FHeight write SetParams;
-    property Total: integer index 4 read FTotal write SetParams;
-    property MaxPosition: integer index 5 read FMaxPosition write SetParams;
-    property Position: integer index 6 read FPosition write SetParams;
-    property FullRect: TRect read GetRect;
-    property ThumbRect: TRect read GetThumbRect;
-    property BackRect: TRect read GetBackRect;
-    property MiddleRect: TRect read GetMiddleRect;
-    property ForwardRect: TRect read GetForwardRect;
-    property PageForwardRect: TRect read GetPgForwardRect;
-    property PageBackRect: TRect read GetPgBackRect;
-  end;
-
-  TGLSMemoStrings = class(TStringList)
-  private
-    FMemo: TGLSCustomMemo;
-    FLockCount: integer;
-    FDeleting: Boolean;
-    procedure CheckRange(Index: integer);
-    function GetLineProp(Index: integer): TLineProp;
-    procedure SetLineStyle(Index: integer; Value: integer);
-    function GetLineStyle(Index: integer): integer;
-    function GetInComment(Index: Integer): Boolean;
-    procedure SetInComment(Index: Integer; Value: Boolean);
-    function GetInBrackets(Index: Integer): integer;
-    procedure SetInBrackets(Index: Integer; Value: integer);
-    function GetValidAttrs(Index: Integer): Boolean;
-    procedure SetValidAttrs(Index: Integer; Value: Boolean);
-    function GetCharAttrs(Index: Integer): string;
-    procedure SetCharAttrs(Index: Integer; const Value: string);
-  protected
-    function GetObject(Index: Integer): TObject; override;
-    procedure PutObject(Index: Integer; AObject: TObject); override;
-    procedure SetUpdateState(Updating: Boolean); override;
-    function CreateProp(Index: integer): TLineProp;
-    property LineProp[Index: integer]: TLineProp read GetLineProp; //PALOFF
-    property Style[Index: integer]: integer read GetLineStyle write
-    SetLineStyle;
-    property InComment[Index: integer]: Boolean read GetInComment write
-    SetInComment;
-    property InBrackets[Index: integer]: integer read GetInBrackets write
-    SetInBrackets;
-    property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write
-    SetValidAttrs;
-    property CharAttrs[Index: integer]: string read GetCharAttrs write
-    SetCharAttrs;
-  public
-    destructor Destroy; override;
-    procedure Clear; override;
-    function DoAdd(const S: string): Integer;
-    function Add(const S: string): Integer; override;
-    function AddObject(const S: string; AObject: TObject): Integer; override;
-    procedure Assign(Source: TPersistent); override;
-    procedure Insert(Index: Integer; const S: string); override;
-    procedure DoInsert(Index: Integer; const S: string);
-    procedure InsertObject(Index: Integer; const S: string; AObject: TObject);
-      override;
-    procedure Delete(Index: Integer); override;
-    procedure LoadFromFile(const FileName: string); override;
-  end;
-
-  TGLSMemoGutter = class(TObject)
-  private
-    FMemo: TGLSCustomMemo;
-    FLeft, FTop, FWidth, FHeight: integer;
-    FColor: TColor;
-    procedure SetParams(Index: integer; Value: integer);
-    function GetRect: TRect;
-  protected
-    procedure PaintTo(ACanvas: TCanvas);
-    procedure Invalidate;
-  public
-    property Left: integer index 0 read FLeft write SetParams;
-    property Top: integer index 1 read FTop write SetParams;
-    property Width: integer index 2 read FWidth write SetParams;
-    property Height: integer index 3 read FHeight write SetParams;
-    property FullRect: TRect read GetRect;
-  end;
-
-  TGLSMemoUndo = class
-  private
-    FMemo: TGLSCustomMemo;
-    FUndoCurX0, FUndoCurY0: integer;
-    FUndoCurX, FUndoCurY: integer;
-    FUndoText: string;
-  public
-    constructor Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText: string);
-    function Append(NewUndo: TGLSMemoUndo): Boolean; virtual;
-    procedure Undo;
-    procedure Redo;
-    procedure PerformUndo; virtual; abstract;
-    procedure PerformRedo; virtual; abstract;
-    property UndoCurX0: integer read FUndoCurX0 write FUndoCurX0;
-    property UndoCurY0: integer read FUndoCurY0 write FUndoCurY0;
-    property UndoCurX: integer read FUndoCurX write FUndoCurX;
-    property UndoCurY: integer read FUndoCurY write FUndoCurY;
-  end;
-
-  TGLSMemoInsCharUndo = class(TGLSMemoUndo)
-  public
-    function Append(NewUndo: TGLSMemoUndo): Boolean; override;
-    procedure PerformUndo; override;
-    procedure PerformRedo; override;
-  end;
-
-  TGLSMemoDelCharUndo = class(TGLSMemoUndo)
-  private
-    FIsBackspace: Boolean;
-  public
-    function Append(NewUndo: TGLSMemoUndo): Boolean; override;
-    procedure PerformUndo; override;
-    procedure PerformRedo; override;
-    property IsBackspace: Boolean read FIsBackspace write FIsBackspace;
-  end;
-
-  TGLSMEmoDelLineUndo = class(TGLSMemoUndo)
-  private
-    FIndex: integer;
-  public
-    constructor Create(AIndex, ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
-      string);
-    procedure PerformUndo; override;
-    procedure PerformRedo; override;
-  end;
-
-  TGLSMemoSelUndo = class(TGLSMemoUndo)
-  private
-    FUndoSelStartX, FUndoSelStartY,
-      FUndoSelEndX, FUndoSelEndY: integer;
-  public
-    property UndoSelStartX: integer read FUndoSelStartX write FUndoSelStartX;
-    property UndoSelStartY: integer read FUndoSelStartY write FUndoSelStartY;
-    property UndoSelEndX: integer read FUndoSelEndX write FUndoSelEndX;
-    property UndoSelEndY: integer read FUndoSelEndY write FUndoSelEndY;
-  end;
-
-  TGLSMemoDeleteBufUndo = class(TGLSMemoSelUndo)
-  public
-    procedure PerformUndo; override;
-    procedure PerformRedo; override;
-  end;
-
-  TGLSMemoPasteUndo = class(TGLSMemoUndo)
-  public
-    procedure PerformUndo; override;
-    procedure PerformRedo; override;
-  end;
-
-  TGLSMemoUndoList = class(TList)
-  private
-    FPos: integer;
-    FMemo: TGLSCustomMemo;
-    FIsPerforming: Boolean;
-    FLimit: integer;
-  protected
-    function Get(Index: Integer): TGLSMemoUndo;
-    procedure SetLimit(Value: integer);
-  public
-    constructor Create;
-    destructor Destroy; override;
-    function Add(Item: Pointer): Integer;
-    procedure Clear; override;
-    procedure Delete(Index: Integer);
-    procedure Undo;
-    procedure Redo;
-    property Items[Index: Integer]: TGLSMemoUndo read Get; default;
-    property IsPerforming: Boolean read FIsPerforming write FIsPerforming;
-    property Memo: TGLSCustomMemo read FMemo write FMemo;
-    property Pos: integer read FPos write FPos;
-    property Limit: integer read FLimit write SetLimit;
-  end;
-
-  //--------------------------------------------------------------
-
-  TGutterClickEvent = procedure(Sender: TObject; LineNo: integer) of object;
-  TGutterDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas;
-    LineNo: integer; rct: TRect) of object;
-  TGetLineAttrsEvent = procedure(Sender: TObject; LineNo: integer;
-    var Attrs: string) of object;
-  TUndoChangeEvent = procedure(Sender: TObject;
-    CanUndo, CanRedo: Boolean) of object;
-  TScrollMode = (smAuto, smStrict);
-
-  TGLSCustomMemo = class(TGLSMemoAbstractScrollableObject)
-  private
-    FAutoIndent: Boolean;
-    FMargin: integer;
-    FHiddenCaret, FCaretVisible: Boolean;
-    FCellSize: TCellSize;
-    FCurX, FCurY: integer;
-    FLeftCol, FTopLine: integer;
-    FTabSize: integer;
-    FFont: TFont;
-    FBkColor: TColor;
-    FSelColor: TColor;
-    FSelBkColor: TColor;
-    FReadOnly: Boolean;
-    FDelErase: Boolean;
-    FLines: TStrings;
-    FSelStartX, FSelStartY,
-      FSelEndX, FSelEndY,
-      FPrevSelX, FPrevSelY: integer;
-    FScrollBars: System.UITypes.TScrollStyle;
-    FScrollBarWidth: integer;
-    FGutter: TGLSMemoGutter;
-    FGutterWidth: integer;
-    sbVert, sbHorz: TGLSMemoScrollBar;
-    FStyles: TStyleList;
-    FLineBitmap: TBitmap;
-    FSelCharPos: TFullPos;
-    FSelCharStyle: integer;
-    FLeftButtonDown: Boolean;
-    FScrollMode: TScrollMode;
-    FUndoList: TGLSMemoUndoList;
-    FFirstUndoList: TGLSMemoUndoList;
-    FUndoLimit: integer;
-    FLastMouseUpX,
-      FLastMouseUpY: integer;
-    FAfterDoubleClick: Boolean;
-    {events}
-    FOnMoveCursor: TNotifyEvent;
-    FOnChange: TNotifyEvent;
-    FOnAttrChange: TNotifyEvent;
-    FOnStatusChange: TNotifyEvent;
-    FOnSelectionChange: TNotifyEvent;
-    FOnGutterDraw: TGutterDrawEvent;
-    FOnGutterClick: TGutterClickEvent;
-    FOnGetLineAttrs: TGetLineAttrsEvent;
-    FOnUndoChange: TUndoChangeEvent;
-    FHideCursor: Boolean;
-    procedure SetHiddenCaret(Value: Boolean);
-    procedure SetScrollBars(Value: System.UITypes.TScrollStyle);
-    procedure SetGutterWidth(Value: integer);
-    procedure SetGutterColor(Value: TColor);
-    function GetGutterColor: TColor;
-    procedure SetCurX(Value: integer);
-    procedure SetCurY(Value: integer);
-    procedure SetFont(Value: TFont);
-    procedure SetColor(Index: integer; Value: TColor);
-    function GetSelStart: TPoint;
-    function GetSelEnd: TPoint;
-    procedure SetLines(ALines: TStrings);
-    procedure SetLineStyle(Index: integer; Value: integer);
-    function GetLineStyle(Index: integer): integer;
-    function GetInComment(Index: integer): Boolean;
-    procedure SetInComment(Index: integer; Value: Boolean);
-    function GetInBrackets(Index: Integer): integer;
-    procedure SetInBrackets(Index: Integer; Value: integer);
-    function GetValidAttrs(Index: integer): Boolean;
-    procedure SetValidAttrs(Index: integer; Value: Boolean);
-    function GetCharAttrs(Index: integer): string;
-    procedure SetCharAttrs(Index: integer; const Value: string);
-    procedure ExpandSelection;
-    function GetSelText: string;
-    procedure SetSelText(const AValue: string);
-    function GetSelLength: integer;
-    procedure MovePage(dP: integer; Shift: TShiftState);
-    procedure ShowCaret(State: Boolean);
-    procedure MakeVisible;
-    function GetVisible(Index: integer): integer;
-    function MaxLength: integer;
-    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
-    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
-    procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
-    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
-    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
-    procedure WMKillFocus(var Msg: TWMSetFocus); message WM_KILLFOCUS;
-    procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
-    procedure MoveCursor(dX, dY: integer; Shift: TShiftState);
-    procedure ResizeEditor;
-    procedure ResizeScrollBars;
-    procedure ResizeGutter;
-    procedure DoCommand(cmd: TCommand; const AShift: TShiftState);
-    procedure DrawLine(LineNo: integer);
-    function IsLineVisible(LineNo: integer): Boolean;
-    procedure FreshLineBitmap;
-    procedure SetUndoLimit(Value: integer);
-  protected
-    procedure WndProc(var Message: TMessage); override;
-    function EditorRect: TRect;
-    function LineRangeRect(FromLine, ToLine: integer): TRect;
-    function ColRangeRect(FromCol, ToCol: integer): TRect;
-    procedure InvalidateLineRange(FromLine, ToLine: integer);
-    function AddString(const S: string): integer;
-    procedure InsertString(Index: integer; S: string);
-    procedure GoHome(Shift: TShiftState);
-    procedure GoEnd(Shift: TShiftState);
-    procedure InsertChar(C: Char);
-    procedure DeleteChar(OldX, OldY: integer);
-    procedure DeleteLine(Index, OldX, OldY, NewX, NewY: integer; FixUndo: Boolean);
-    procedure BackSpace;
-    procedure BackSpaceWord;
-    function IndentCurrLine: string;
-    procedure NewLine;
-    procedure CreateParams(var Params: TCreateParams); override;
-    procedure Paint; override;
-    procedure DrawMargin;
-    procedure DrawGutter;
-    procedure DrawScrollBars;
-    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
-    procedure KeyPress(var Key: Char); override;
-    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
-    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
-    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
-    procedure DblClick; override;
-    procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer); override;
-    procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer); override;
-    property VisiblePosCount: integer index 0 read GetVisible;
-    property VisibleLineCount: integer index 1 read GetVisible;
-    property LastVisiblePos: integer index 2 read GetVisible;
-    property LastVisibleLine: integer index 3 read GetVisible;
-    procedure DeleteSelection(bRepaint: Boolean);
-    procedure Changed(FromLine, ToLine: integer); virtual;
-    procedure AttrChanged(LineNo: integer); virtual;
-    procedure SelectionChanged; virtual;
-    procedure StatusChanged; virtual;
-    procedure ClearUndoList;
-    procedure UndoChange;
-    property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
-    property GutterWidth: integer read FGutterWidth write SetGutterWidth;
-    property GutterColor: TColor read GetGutterColor write SetGutterColor;
-    property ScrollBars: System.UITypes.TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
-    property Font: TFont read FFont write SetFont;
-    property ReadOnly: Boolean read FReadOnly write FReadOnly;
-    property Lines: TStrings read FLines write SetLines;
-    property BkColor: TColor index 0 read FBkColor write SetColor;
-    property SelColor: TColor index 1 read FSelColor write SetColor;
-    property SelBkColor: TColor index 2 read FSelBkColor write SetColor;
-    property HiddenCaret: Boolean read FHiddenCaret write SetHiddenCaret;
-    property TabSize: integer read FTabSize write FTabSize;
-    property ScrollMode: TScrollMode read FScrollMode write FScrollMode default smAuto;
-    property UndoLimit: integer read FUndoLimit write SetUndoLimit;
-    property HideCursor: Boolean read FHideCursor write FHideCursor;
-    property InComment[Index: integer]: Boolean read GetInComment write SetInComment;
-    property InBrackets[Index: integer]: integer read GetInBrackets write SetInBrackets;
-    property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write SetValidAttrs;
-    property CharAttrs[Index: integer]: string read GetCharAttrs write SetCharAttrs;
-    {events}
-    property OnGutterClick: TGutterClickEvent read FOnGutterClick write FOnGutterClick;
-    property OnGutterDraw: TGutterDrawEvent read FOnGutterDraw write FOnGutterDraw;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-    property OnMoveCursor: TNotifyEvent read FOnMoveCursor write FOnMoveCursor;
-    property OnAttrChange: TNotifyEvent read FOnAttrChange write FOnAttrChange;
-    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
-    property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
-    property OnGetLineAttrs: TGetLineAttrsEvent read FOnGetLineAttrs write FOnGetLineAttrs;
-    property OnUndoChange: TUndoChangeEvent read FOnUndoChange write FOnUndoChange;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure CopyToClipBoard;
-    procedure PasteFromClipBoard;
-    procedure CutToClipBoard;
-    procedure SelectLines(StartLine, EndLine: Integer);
-    procedure SelectAll;
-    property SelStart: TPoint read GetSelStart;
-    property SelEnd: TPoint read GetSelEnd;
-    property Selection: string read GetSelText write SetSelText;
-    property SelLength: integer read GetSelLength;
-    procedure ClearSelection;
-    procedure Clear;
-    procedure SetCursor(ACurX, ACurY: Integer);
-    function SelectLine(LineNo, StyleNo: Integer): integer;
-    procedure SelectChar(LineNo, Pos, StyleNo: Integer);
-    function CellFromPos(X, Y: integer): TCellPos;
-    function CharFromPos(X, Y: integer): TFullPos;
-    function CellRect(ACol, ARow: integer): TRect;
-    function LineRect(ARow: integer): TRect;
-    function ColRect(ACol: integer): TRect;
-    function CharStyleNo(LineNo, Pos: integer): integer;
-    procedure InsertTemplate(AText: string);
-    procedure UnSelectChar;
-    procedure Undo;
-    procedure Redo;
-    function CanUndo: Boolean;
-    function CanRedo: Boolean;
-    function FindText(Text: string; Options: TFindOptions; Select: Boolean): Boolean;
-    property CurX: integer read FCurX write SetCurX;
-    property CurY: integer read FCurY write SetCurY;
-    property DelErase: Boolean read FDelErase write FDelErase;
-    property LineStyle[Index: integer]: integer read GetLineStyle write
-    SetLineStyle;
-    property Styles: TStyleList read FStyles;
-    property UndoList: TGLSMemoUndoList read FUndoList write FUndoList;
-  end;
-
-  TGLSMemo = class(TGLSCustomMemo)
-  published
-    {TControl }
-    property PopupMenu;
-    {TCustomControl }
-    property Align;
-    property Enabled;
-    property ShowHint;
-    property TabOrder;
-    property TabStop;
-    property Visible;
-    property ReadOnly;
-    {TGLSCustomMemo }
-    property AutoIndent;
-    property GutterColor;
-    property GutterWidth;
-    property ScrollBars;
-    property Font;
-    property BkColor;
-    property Selection;
-    property SelColor;
-    property SelBkColor;
-    property Lines;
-    property HiddenCaret;
-    property TabSize;
-    property ScrollMode;
-    property UndoLimit;
-    property DelErase;
-    {Inherited events }
-    property OnClick;
-    property OnDblClick;
-    property OnDragDrop;
-    property OnDragOver;
-    property OnEndDrag;
-    property OnMouseDown;
-    property OnMouseMove;
-    property OnMouseUp;
-    property OnStartDrag;
-    property OnEnter;
-    property OnExit;
-    property OnKeyDown;
-    property OnKeyPress;
-    property OnKeyUp;
-    {Events }
-    property OnGutterDraw;
-    property OnGutterClick;
-    property OnChange;
-    property OnMoveCursor;
-    property OnAttrChange;
-    property OnSelectionChange;
-    property OnStatusChange;
-    property OnGetLineAttrs;
-    property OnUndoChange;
-  end;
-
-  TGLSMemoStringList = class(TStringList)
-  private
-    procedure ReadStrings(Reader: TReader);
-    procedure WriteStrings(Writer: TWriter);
-  protected
-    procedure DefineProperties(Filer: TFiler); override;
-  end;
-
-  TDelimiters = TSysCharSet;
-  TTokenType =
-    (
-    ttWord,
-    ttBracket,
-    ttSpecial,
-    ttDelimiter,
-    ttSpace,
-    ttEOL,
-    ttInteger,
-    ttFloat,
-    ttComment,
-    ttOther,
-    ttWrongNumber);
-
-  //--------------------------------------------------------------
-  //        SYNTAX MEMO - declaration
-  //--------------------------------------------------------------
-  TGLSSynHiMemo = class(TGLSCustomMemo)
-  private
-
-    FIsPainting: Boolean;
-    FInComment: Boolean;
-
-    FWordList: TGLSMemoStringList;
-    FSpecialList: TGLSMemoStringList;
-    FBracketList: TGLSMemoStringList;
-    FDelimiters: TDelimiters;
-    FInBrackets: integer;
-    FLineComment: string;
-    FMultiCommentLeft: string;
-    FMultiCommentRight: string;
-    FDelimiterStyle: TCharStyle;
-    FCommentStyle: TCharStyle;
-    FNumberStyle: TCharStyle;
-    FDelimiterStyleNo,
-      FCommentStyleNo,
-      FNumberStyleNo: integer;
-    FCaseSensitive: Boolean;
-    function GetToken(const S: string; var From: integer;
-      out TokenType: TTokenType; out StyleNo: integer): string;
-    procedure SetWordList(Value: TGLSMemoStringList);
-    procedure SetSpecialList(Value: TGLSMemoStringList);
-    procedure SetBracketList(Value: TGLSMemoStringList);
-    procedure FindLineAttrs(Sender: TObject; LineNo: integer; var Attrs:
-      string);
-    procedure SetStyle(Index: integer; Value: TCharStyle);
-    procedure SetCaseSensitive(Value: Boolean);
-  protected
-    procedure Paint; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure AddWord(StyleNo: integer; const ArrS: array of string);
-    procedure AddSpecial(StyleNo: integer; const ArrS: array of string);
-    procedure AddBrackets(StyleNo: integer; const ArrS: array of string);
-    property Delimiters: TDelimiters read FDelimiters write FDelimiters;
-  published
-    {TControl}
-    property PopupMenu;
-    {TCustomControl}
-    property Align;
-    property Enabled;
-    property ShowHint;
-    property TabOrder;
-    property TabStop;
-    property Visible;
-    property ReadOnly;
-    {TGLSCustomMemo}
-    property AutoIndent;
-    property GutterColor;
-    property GutterWidth;
-    property ScrollBars;
-    property Font;
-    property BkColor;
-    property SelColor;
-    property SelBkColor;
-    property Lines;
-    property HiddenCaret;
-    property TabSize;
-    property ScrollMode;
-    property UndoLimit;
-    property DelErase;
-    {Inherited events }
-    property OnClick;
-    property OnDblClick;
-    property OnDragDrop;
-    property OnDragOver;
-    property OnEndDrag;
-    property OnMouseDown;
-    property OnMouseMove;
-    property OnMouseUp;
-    property OnStartDrag;
-    property OnEnter;
-    property OnExit;
-    property OnKeyDown;
-    property OnKeyPress;
-    property OnKeyUp;
-    {Events }
-    property OnGutterClick;
-    property OnGutterDraw;
-    property OnChange;
-    property OnMoveCursor;
-    property OnSelectionChange;
-    property OnStatusChange;
-    property OnUndoChange;
-    {TGLSSyntaxMemo }
-    property LineComment: string read FLineComment write FLineComment;
-    property MultiCommentLeft: string read FMultiCommentLeft write FMultiCommentLeft;
-    property MultiCommentRight: string read FMultiCommentRight write FMultiCommentRight;
-    property WordList: TGLSMemoStringList read FWordList write SetWordList;
-    property SpecialList: TGLSMemoStringList read FSpecialList write SetSpecialList;
-    property BracketList: TGLSMemoStringList read FBracketList write SetBracketList;
-    property DelimiterStyle: TCharStyle index 0 read FDelimiterStyle write SetStyle;
-    property CommentStyle: TCharStyle index 1 read FCommentStyle write SetStyle;
-    property NumberStyle: TCharStyle index 2 read FNumberStyle write SetStyle;
-    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
-  end;
-
-procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
-
-//==========================================================
-implementation
-//==========================================================
-
-const
-  cmDelete = VK_DELETE;
-  cmBackSpace = VK_BACK;
-  cmWordBackSpace = 127; // Ctrl-BackSpace
-  cmNewLine = VK_RETURN;
-  cmHome = VK_HOME;
-  cmEnd = VK_END;
-  cmPageUp = VK_PRIOR;
-  cmPageDown = VK_NEXT;
-  cmInsert = VK_INSERT;
-  cmDelLine = 25; // Ctrl-Y
-  cmCopy = 3; // Ctrl-C
-  cmCut = 24; // Ctrl-X
-  cmPaste = 22; // Ctrl-V
-
-resourcestring
-  SObjectsNotSupported = 'Linked object not supported';
-
-var
-  bmScrollBarFill: TBitmap;
-  bmScrollBarUp: TBitmap;
-  bmScrollBarDown: TBitmap;
-  bmScrollBarLeft: TBitmap;
-  bmScrollBarRight: TBitmap;
-
-  fIntelliWheelSupport: Boolean; // True if IntelliMouse + wheel enabled
-  fIntelliMessage: UINT; // message sent from mouse on wheel roll
-  fIntelliScrollLines: Integer; // number of lines to scroll per wheel roll
-
-// ---------------------Helper functions 
-
-function PointInRect(const P: TPoint; const rct: TRect): Boolean; inline;
-begin
-  with rct do
-    Result := (Left <= P.X) and (Top <= P.Y) and
-      (Right >= P.X) and (Bottom >= P.Y);
-end;
-
-procedure Swap(var I1, I2: integer); inline;
-var
-  temp: integer;
-begin
-  temp := I1;
-  I1 := I2;
-  I2 := temp;
-end;
-
-procedure OrderPos(var StartX, StartY, EndX, EndY: integer); inline;
-begin
-  if (EndY < StartY) or
-    ((EndY = StartY) and (EndX < StartX)) then
-  begin
-    Swap(StartX, EndX);
-    Swap(StartY, EndY);
-  end;
-end;
-
-function TotalRect(const rct1, rct2: TRect): TRect; inline;
-begin
-  Result := rct1;
-  with Result do
-  begin
-    if rct2.Left < Left then
-      Left := rct2.Left;
-    if rct2.Top < Top then
-      Top := rct2.Top;
-    if rct2.Right > Right then
-      Right := rct2.Right;
-    if rct2.Bottom > Bottom then
-      Bottom := rct2.Bottom;
-  end;
-end;
-
-
-
-// ---------------------TGLSCustomMemo functions
-
-procedure TGLSCustomMemo.WndProc(var Message: TMessage);
-  function GetShiftState: Integer;
-  begin
-    Result := 0;
-    if GetAsyncKeyState(vk_Shift) < 0 then
-      Result := Result or mk_Shift;
-    if GetAsyncKeyState(vk_Control) < 0 then
-      Result := Result or mk_Control;
-    if GetAsyncKeyState(vk_LButton) < 0 then
-      Result := Result or mk_LButton;
-    if GetAsyncKeyState(vk_RButton) < 0 then
-      Result := Result or mk_RButton;
-    if GetAsyncKeyState(vk_MButton) < 0 then
-      Result := Result or mk_MButton;
-  end;
-  //---------------------------------------------------
-begin
-  if (Message.Msg = fIntelliMessage) and (fIntelliMessage <> wm_MouseWheel) then
-  begin
-    PostMessage(Handle, wm_MouseWheel, MakeLong(GetShiftState, Message.wParam),
-      Message.lParam);
-  end
-  else
-    inherited;
-end;
-
-//------------------------------------------------
-//    INTELLIMOUSE INIT
-//------------------------------------------------
-
-procedure IntelliMouseInit;
-var
-  hWndMouse: hWnd;
-  mQueryScrollLines: UINT;
-  //--------------------------------------------
-  function NativeMouseWheelSupport: Boolean;
-  var
-    ver: TOSVersionInfo;
-  begin
-    Result := False;
-    ver.dwOSVersionInfoSize := sizeof(ver);
-    // For Windows 98, assume dwMajorVersion = 5 (It's 4 for W95)
-    // For NT, we need 4.0 or better.
-    if GetVersionEx(ver) then
-      case ver.dwPlatformID of
-        ver_Platform_Win32_Windows: Result := ver.dwMajorVersion >= 5;
-        ver_Platform_Win32_NT: Result := ver.dwMajorVersion >= 4;
-      end;
-    { Quick and dirty temporary hack for Windows 98 beta 3 }
-    if (not Result) and (ver.szCSDVersion = ' Beta 3') then
-      Result := True;
-  end;
-  //--------------------------------------------
-begin
-  if NativeMouseWheelSupport then
-  begin
-    fIntelliWheelSupport := Boolean(GetSystemMetrics(sm_MouseWheelPresent));
-    SystemParametersInfo(spi_GetWheelScrollLines, 0, @fIntelliScrollLines, 0);
-    fIntelliMessage := wm_MouseWheel;
-  end
-  else
-  begin
-    { Look for hidden mouse window }
-    hWndMouse := FindWindow('MouseZ', 'Magellan MSWHEEL');
-    if hWndMouse <> 0 then
-    begin
-      { We're in business - get the scroll line info }
-      fIntelliWheelSupport := True;
-      mQueryScrollLines := RegisterWindowMessage('MSH_SCROLL_LINES_MSG');
-      fIntelliScrollLines := SendMessage(hWndMouse, mQueryScrollLines, 0, 0);
-      { Finally, get the custom mouse message as well }
-      fIntelliMessage := RegisterWindowMessage('MSWHEEL_ROLLMSG');
-    end;
-  end;
-  if (fIntelliScrollLines < 0) or (fIntelliScrollLines > 100) then
-    fIntelliScrollLines := 3;
-end;
-
-//------------------------------------------------
-//    WM MOUSE WHEEL
-//------------------------------------------------
-
-procedure TGLSCustomMemo.WMMouseWheel(var Message: TMessage);
-{$J+}
-{$IFOPT R+} {$DEFINE StoreRangeCheck} {$ENDIF} {$R-}
-const
-  Delta: SmallInt = 0;
-begin
-  Delta := Delta + SmallInt(HiWord(Message.wParam));
-  while Abs(Delta) >= 120 do
-  begin
-    if Delta < 0 then
-    begin
-      DoScroll(sbVert, fIntelliScrollLines);
-      Delta := Delta + 120;
-    end
-    else
-    begin
-      DoScroll(sbVert, -fIntelliScrollLines);
-      Delta := Delta - 120;
-    end;
-  end;
-end;
-{$J-}
-{$IFDEF StoreRangeCheck} {$R+} {$UNDEF StoreRangeCheck} {$ENDIF}
-
-//--------------------------------------------------------------
-//        SET CURSOR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetCursor(ACurX, ACurY: Integer);
-begin
-  ClearSelection;
-  CurX := 0;
-  CurY := ACurY;
-  CurX := ACurX;
-end;
-
-//--------------------------------------------------------------
-//        SELECT LINE, CHAR
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.SelectLine(LineNo, StyleNo: Integer): integer;
-var
-  rct: TRect;
-begin
-  Result := LineStyle[LineNo];
-  LineStyle[LineNo] := StyleNo;
-  rct := LineRect(LineNo);
-  InvalidateRect(Handle, @rct, True);
-end;
-
-procedure TGLSCustomMemo.SelectLines(StartLine, EndLine: Integer);
-var
-  rct: TRect;
-begin
-  FSelStartX := 0;
-  FSelStartY := StartLine;
-  FSelEndX := Length(Lines[EndLine]);
-  FSelEndY := EndLine;
-  rct := LineRangeRect(FSelStartY, FSelEndY);
-  SelectionChanged;
-  InvalidateRect(Handle, @rct, true);
-end;
-
-procedure TGLSCustomMemo.SelectChar(LineNo, Pos, StyleNo: Integer);
-var
-  rct: TRect;
-begin
-  UnselectChar;
-  FSelCharPos.LineNo := LineNo;
-  FSelCharPos.Pos := Pos;
-  FSelCharStyle := StyleNo;
-  rct := LineRect(LineNo);
-  InvalidateRect(Handle, @rct, True);
-end;
-
-procedure TGLSCustomMemo.UnSelectChar;
-var
-  rct: TRect;
-begin
-  with FSelCharPos do
-  begin
-    if LineNo < 0 then
-      Exit;
-    rct := LineRect(LineNo);
-    LineNo := -1;
-    Pos := -1;
-  end;
-  FSelCharStyle := -1;
-  InvalidateRect(Handle, @rct, True);
-end;
-
-//--------------------------------------------------------------
-//        CLEAR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.Clear;
-begin
-  CurY := 0;
-  CurX := 0;
-  FLeftCol := 0;
-  FTopLine := 0;
-  Lines.Clear;
-  TGLSMemoStrings(Lines).DoAdd('');
-  ClearUndoList;
-  Invalidate;
-end;
-
-//--------------------------------------------------------------
-//        SELECT ALL
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SelectAll;
-begin
-  FSelStartY := 0;
-  FSelStartX := 0;
-  FSelEndY := Lines.Count - 1;
-  FSelEndX := Length(Lines[Lines.Count - 1]);
-  Invalidate;
-end;
-
-//-----------------------------------------------------------
-//   SET CLIPBOARD CODE PAGE
-//-----------------------------------------------------------
-
-procedure SetClipboardCodePage(const CodePage: longint);
-var
-  Data: THandle;
-  DataPtr: Pointer;
-begin
-  // Define new code page for clipboard
-  Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, 4);
-  try
-    DataPtr := GlobalLock(Data);
-    try
-      Move(CodePage, DataPtr^, 4);
-      SetClipboardData(CF_LOCALE, Data);
-    finally
-      GlobalUnlock(Data);
-    end;
-  except
-    GlobalFree(Data);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        COPY TO CLIPBOARD
-//--------------------------------------------------------------
-
-procedure CopyStringToClipboard(const Value: string);
-const
-  RusLocale = (SUBLANG_DEFAULT shl $A) or LANG_RUSSIAN;
-begin
-  Clipboard.Open;
-  SetClipboardCodePage(RusLocale);
-  try
-    Clipboard.AsText := Value;
-  finally
-    SetClipboardCodePage(RusLocale);
-    Clipboard.Close;
-  end;
-end;
-
-procedure TGLSCustomMemo.CopyToClipBoard;
-begin
-  CopyStringToClipboard(GetSelText);
-end;
-//--------------------------------------------------------------
-//        PASTE FROM CLIPBOARD
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.PasteFromClipBoard;
-var
-  H, len: integer;
-  Buff: string;
-begin
-  H := ClipBoard.GetAsHandle(CF_TEXT);
-  len := GlobalSize(H);
-  if len = 0 then
-    Exit;
-
-  SetLength(Buff, len);
-  SetLength(Buff, ClipBoard.GetTextBuf(PChar(Buff), len));
-  AdjustLineBreaks(Buff);
-
-  SetSelText(Buff);
-end;
-
-//--------------------------------------------------------------
-//        DELETE SELECTION
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DeleteSelection(bRepaint: Boolean);
-var
-  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
-  i, len: integer;
-  OldX, OldY: integer;
-  S1, S2, S, AddSpaces: string;
-  Undo: TGLSMemoDeleteBufUndo;
-begin
-  if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
-    Exit;
-
-  OldX := CurX;
-  OldY := CurY;
-  xSelStartX := FSelStartX;
-  xSelStartY := FSelStartY;
-  xSelEndX := FSelEndX;
-  xSelEndY := FSelEndY;
-  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
-
-  if xSelStartY = xSelEndY then
-  begin
-    S1 := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX);
-    S2 := '';
-    AddSpaces := '';
-  end
-  else
-  begin
-    len := Length(Lines[xSelStartY]);
-    S1 := Copy(Lines[xSelStartY], xSelStartX + 1, len);
-    AddSpaces := StringOfChar(' ', xSelStartX - len);
-    S2 := Copy(Lines[xSelEndY], 1, xSelEndX);
-  end;
-  Lines[xSelStartY] := Copy(Lines[xSelStartY], 1, xSelStartX) + AddSpaces +
-    Copy(Lines[xSelEndY], xSelEndX + 1, Length(Lines[xSelEndY]));
-  S := S1;
-  for i := xSelStartY + 1 to xSelEndY do
-  begin
-    S := S + #13#10;
-    if i <> xSelEndY then
-      S := S + Lines[xSelStartY + 1];
-    DeleteLine(xSelStartY + 1, -1, -1, -1, -1, False);
-  end;
-  S := S + S2;
-
-  CurY := xSelStartY;
-  CurX := xSelStartX;
-  ClearSelection;
-
-  Changed(xSelStartY, -1);
-  SelectionChanged;
-  if bRepaint then
-    Invalidate;
-
-  Undo := TGLSMemoDeleteBufUndo.Create(OldX, OldY, CurX, CurY, S);
-  Undo.UndoSelStartX := xSelStartX;
-  Undo.UndoSelStartY := xSelStartY;
-  Undo.UndoSelEndX := xSelEndX;
-  Undo.UndoSelEndY := xSelEndY;
-  if Assigned(FUndoList) then
-    FUndoList.Add(Undo);
-end;
-
-//--------------------------------------------------------------
-//        CUT TO CLIPBOARD
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.CutToClipBoard;
-begin
-  ClipBoard.SetTextBuf(PChar(GetSelText));
-  DeleteSelection(True);
-end;
-
-//--------------------------------------------------------------
-//        GET SEL TEXT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetSelText: string;
-var
-  i: integer;
-  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
-begin
-  Result := '';
-  if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
-    Exit;
-
-  xSelStartX := FSelStartX;
-  xSelStartY := FSelStartY;
-  xSelEndX := FSelEndX;
-  xSelEndY := FSelEndY;
-  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
-
-  if xSelStartY = xSelEndY then
-    Result := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX)
-  else
-  begin
-    Result := Copy(Lines[xSelStartY], xSelStartX + 1,
-      Length(Lines[xSelStartY]));
-    for i := xSelStartY + 1 to xSelEndY - 1 do
-      Result := Result + #13#10 + Lines[i];
-    Result := Result + #13#10 + Copy(Lines[xSelEndY], 1, xSelEndX);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        GET SEL START
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetSelStart: TPoint;
-var
-  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
-begin
-  xSelStartX := FSelStartX;
-  xSelStartY := FSelStartY;
-  xSelEndX := FSelEndX;
-  xSelEndY := FSelEndY;
-  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
-  Result := Point(xSelStartX, xSelStartY);
-end;
-
-//--------------------------------------------------------------
-//        GET SEL END
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetSelEnd: TPoint;
-var
-  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
-begin
-  xSelStartX := FSelStartX;
-  xSelStartY := FSelStartY;
-  xSelEndX := FSelEndX;
-  xSelEndY := FSelEndY;
-  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
-  Result := Point(xSelEndX, xSelEndY);
-end;
-
-//--------------------------------------------------------------
-//        SET SEL TEXT
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetSelText(const AValue: string);
-var
-  i, k: integer;
-  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
-  Buff, S: string;
-  OldX, OldY: integer;
-begin
-  Buff := AValue;
-  xSelStartX := FSelStartX;
-  xSelStartY := FSelStartY;
-  xSelEndX := FSelEndX;
-  xSelEndY := FSelEndY;
-  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
-
-  DeleteSelection(False);
-
-  OldX := CurX;
-  OldY := CurY;
-  i := Pos(#13#10, Buff);
-  S := Lines[xSelStartY];
-  if i = 0 then
-  begin
-    Lines[xSelStartY] := Copy(S, 1, xSelStartX) + Buff
-      + Copy(S, xSelStartX + 1, Length(S));
-    CurX := xSelStartX;
-    if Buff <> '' then
-      CurX := CurX + Length(Buff);
-  end
-  else
-  begin
-    k := xSelStartY;
-    Lines[k] := Copy(S, 1, xSelStartX) + Copy(Buff, 1, i - 1);
-    TGLSMemoStrings(Lines).DoInsert(k + 1, Copy(S, xSelStartX + 1, Length(S)));
-    while True do
-    begin
-      Buff := Copy(Buff, i + 2, Length(Buff));
-      i := Pos(#13#10, Buff);
-      k := k + 1;
-      if i = 0 then
-        break;
-      TGLSMemoStrings(Lines).DoInsert(k, Copy(Buff, 1, i - 1));
-    end;
-    Lines[k] := Buff + Lines[k];
-    CurY := k;
-    CurX := Length(Buff);
-  end;
-
-  ClearSelection;
-  Changed(xSelStartY, -1);
-  if Assigned(FUndoList) then
-    FUndoList.Add(TGLSMemoPasteUndo.Create(OldX, OldY, CurX, CurY, AValue));
-  Invalidate;
-end;
-
-//--------------------------------------------------------------
-//        GET SEL LENGTH
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetSelLength: integer;
-begin
-  Result := Length(GetSelText);
-end;
-
-//--------------------------------------------------------------
-//        CHANGED
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.Changed(FromLine, ToLine: integer);
-var
-  i: integer;
-begin
-  if ToLine < FromLine then
-    ToLine := Lines.Count - 1;
-  for i := FromLine to ToLine do
-    ValidAttrs[i] := False;
-  InvalidateLineRange(FromLine, ToLine);
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-//--------------------------------------------------------------
-//        ATTR CHANGED
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.AttrChanged(LineNo: integer);
-begin
-  ValidAttrs[LineNo] := False;
-  InvalidateLineRange(LineNo, LineNo);
-  if Assigned(FOnAttrChange) then
-    FOnAttrChange(Self);
-end;
-
-//--------------------------------------------------------------
-//        SELECTION CHANGED
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SelectionChanged;
-begin
-  if Assigned(FOnSelectionChange) then
-    FOnSelectionChange(Self);
-end;
-
-//--------------------------------------------------------------
-//        STATUS CHANGED
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.StatusChanged;
-begin
-  if Assigned(FOnStatusChange) then
-    FOnStatusChange(Self);
-end;
-
-//--------------------------------------------------------------
-//        CLEAR SELECTION
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ClearSelection;
-var
-  rct: TRect;
-  Changed: Boolean;
-begin
-  Changed := not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY));
-  rct := LineRangeRect(FSelStartY, FSelEndY);
-  FSelStartX := CurX;
-  FSelStartY := CurY;
-  FSelEndX := CurX;
-  FSelEndY := CurY;
-  FPrevSelX := CurX;
-  FPrevSelY := CurY;
-  if Changed then
-  begin
-    SelectionChanged;
-    InvalidateRect(Handle, @rct, true);
-  end;
-  if Assigned(FOnMoveCursor) then
-    FOnMoveCursor(Self);
-end;
-
-//--------------------------------------------------------------
-//        EXPAND SELECTION
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ExpandSelection;
-var
-  rct: TRect;
-begin
-  rct := LineRangeRect(FPrevSelY, CurY);
-  FSelEndX := CurX;
-  FSelEndY := CurY;
-  FPrevSelX := CurX;
-  FPrevSelY := CurY;
-  SelectionChanged;
-  InvalidateRect(Handle, @rct, true);
-  if Assigned(FOnMoveCursor) then
-    FOnMoveCursor(Self);
-end;
-
-//--------------------------------------------------------------
-//        MAX LENGTH
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.MaxLength: integer;
-var
-  i, len: integer;
-begin
-  Result := 0;
-  for i := 0 to Lines.Count - 1 do
-  begin
-    len := Length(Lines[i]);
-    if len > Result then
-      Result := len;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        DO SCROLL
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
-var
-  eRect, scrRect, sbRect: TRect;
-  Old: integer;
-begin
-  eRect := EditorRect;
-  case Sender.Kind of
-    sbVertical:
-      begin
-        Old := FTopLine;
-        FTopLine := FTopLine + ByValue;
-        if FTopLine > Sender.MaxPosition then
-          FTopLine := Sender.MaxPosition;
-        if FTopLine < 0 then
-          FTopLine := 0;
-        if Old <> FTopLine then
-        begin
-          ShowCaret(False);
-          if CurY < FTopLine then
-            CurY := FTopLine;
-          if CurY > LastVisibleLine then
-            CurY := LastVisibleLine;
-
-          ScrollDC(Canvas.Handle, 0, (Old - FTopLine) * FCellSize.H,
-            eRect, eRect, 0, @scrRect);
-          InvalidateRect(Handle, @scrRect, True);
-          sbRect := Sender.FullRect;
-          InvalidateRect(Handle, @sbRect, True);
-          FGutter.Invalidate;
-          ShowCaret(True);
-        end;
-      end;
-    sbHorizontal:
-      begin
-        Old := FLeftCol;
-        FLeftCol := FLeftCol + ByValue;
-        if FLeftCol > Sender.MaxPosition then
-          FLeftCol := Sender.MaxPosition;
-        if FLeftCol < 0 then
-          FLeftCol := 0;
-        if Old <> FLeftCol then
-        begin
-          ShowCaret(False);
-          if CurX < FLeftCol then
-            CurX := FLeftCol;
-          if CurX > LastVisiblePos then
-            CurX := LastVisiblePos;
-          ScrollDC(Canvas.Handle, (Old - FLeftCol) * FCellSize.W, 0,
-            eRect, eRect, 0, @scrRect);
-          InvalidateRect(Handle, @scrRect, True);
-          sbRect := Sender.FullRect;
-          InvalidateRect(Handle, @sbRect, True);
-          ShowCaret(True);
-        end;
-      end;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        DO SCROLL PAGE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DoScrollPage(Sender: TGLSMemoScrollBar; ByValue:
-  integer);
-begin
-  case Sender.Kind of
-    sbVertical: DoScroll(Sender, ByValue * VisibleLineCount);
-    sbHorizontal: DoScroll(Sender, ByValue * VisiblePosCount);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SET LINES
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetLines(ALines: TStrings);
-begin
-  if ALines <> nil then
-  begin
-    FLines.Assign(ALines);
-    Changed(0, -1);
-    SelectionChanged;
-    Invalidate;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SET/GET LINE STYLE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetLineStyle(Index: integer; Value: integer);
-begin
-  TGLSMemoStrings(FLines).Style[Index] := Value;
-  if IsLineVisible(Index) then
-    AttrChanged(Index);
-end;
-
-function TGLSCustomMemo.GetLineStyle(Index: integer): integer;
-begin
-  Result := TGLSMemoStrings(FLines).Style[Index];
-end;
-
-//--------------------------------------------------------------
-//        GET/SET IN COMMENT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetInComment(Index: integer): Boolean;
-begin
-  Result := TGLSMemoStrings(FLines).InComment[Index];
-end;
-
-procedure TGLSCustomMemo.SetInComment(Index: integer; Value: Boolean);
-begin
-  TGLSMemoStrings(FLines).InComment[Index] := Value;
-end;
-
-//--------------------------------------------------------------
-//        GET/SET IN BRACKETS
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetInBrackets(Index: integer): integer;
-begin
-  Result := TGLSMemoStrings(FLines).InBrackets[Index];
-end;
-
-procedure TGLSCustomMemo.SetInBrackets(Index: integer; Value: integer);
-begin
-  TGLSMemoStrings(FLines).InBrackets[Index] := Value;
-end;
-
-//--------------------------------------------------------------
-//        GET/SET VALID ATTRS
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetValidAttrs(Index: integer): Boolean;
-begin
-  Result := TGLSMemoStrings(FLines).ValidAttrs[Index];
-end;
-
-procedure TGLSCustomMemo.SetValidAttrs(Index: integer; Value: Boolean);
-begin
-  TGLSMemoStrings(FLines).ValidAttrs[Index] := Value;
-end;
-
-//--------------------------------------------------------------
-//        GET/SET CHAR ATTRS
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetCharAttrs(Index: integer): string;
-begin
-  Result := TGLSMemoStrings(FLines).CharAttrs[Index];
-end;
-
-procedure TGLSCustomMemo.SetCharAttrs(Index: integer; const Value: string);
-begin
-  TGLSMemoStrings(FLines).CharAttrs[Index] := Value;
-  if IsLineVisible(Index) then
-    AttrChanged(Index);
-end;
-
-//--------------------------------------------------------------
-//        SET CUR X
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetCurX(Value: integer);
-var
-  len: integer;
-  WasVisible: Boolean;
-begin
-  if Value < 0 then
-    if CurY = 0 then
-      Value := 0
-    else
-    begin
-      CurY := CurY - 1;
-      Value := Length(Lines[CurY]);
-    end;
-
-  if (CurY >= 0) and (CurY < Lines.Count) then
-  begin
-    len := Length(Lines[CurY]);
-    if Value > len then
-    begin
-      Lines[CurY] := Lines[CurY] + StringOfChar(' ', Value - len);
-      // Value := len;
-      ValidAttrs[CurY] := False;
-      InvalidateLineRange(CurY, CurY);
-    end;
-  end;
-
-  FCurX := Value;
-
-  WasVisible := FCaretVisible;
-  if WasVisible then
-    ShowCaret(False);
-  MakeVisible;
-  ResizeScrollBars;
-  StatusChanged;
-  if WasVisible then
-    ShowCaret(True);
-end;
-
-//--------------------------------------------------------------
-//        SET CUR Y
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetCurY(Value: integer);
-var
-  Old: integer;
-  WasVisible: Boolean;
-begin
-  WasVisible := FCaretVisible;
-  if WasVisible then
-    ShowCaret(False);
-  Old := CurY;
-
-  if Value < 0 then
-    Value := 0;
-  if Value >= Lines.Count then
-    Value := Lines.Count - 1;
-
-  FCurY := Value;
-  if (CurY <> Old) and (Old >= 0) and (Old < Lines.Count) then
-    Lines[Old] := TrimRight(Lines[Old]);
-  CurX := CurX;
-
-  MakeVisible;
-  ResizeScrollBars;
-  StatusChanged;
-  if WasVisible then
-    ShowCaret(True);
-end;
-
-//--------------------------------------------------------------
-//        MOVE CURSOR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.MoveCursor(dX, dY: integer; Shift: TShiftState);
-var
-  Selecting: Boolean;
-  //------------------------------------------------------------
-  function IsDelimiter(c: char): Boolean;
-  begin
-    Result := Pos(c, ' .,;:/?!@#$%^&*(){}[]<>-+=|\') > 0;
-  end;
-  //------------------------------------------------------------
-  function IsStopChar(c, cThis: char): Boolean;
-  begin
-    Result := IsDelimiter(c) <> IsDelimiter(cThis);
-  end;
-  //------------------------------------------------------------
-  procedure MoveWordLeft;
-  var
-    S: string;
-  begin
-    CurX := CurX - 1;
-    S := TrimRight(Lines[CurY]);
-    while CurX > 0 do
-    begin
-      if IsStopChar(S[CurX], S[CurX + 1]) then
-        break;
-      CurX := CurX - 1;
-    end;
-    if (CurX < 0) then
-      if CurY > 0 then
-      begin
-        CurY := CurY - 1;
-        CurX := Length(Lines[CurY]);
-      end;
-  end;
-  //------------------------------------------------------------
-  procedure MoveWordRight;
-  var
-    Len: integer;
-    S: string;
-  begin
-    S := TrimRight(Lines[CurY]);
-    Len := Length(S);
-    CurX := CurX + 1;
-    while CurX < Len do
-    begin
-      if IsStopChar(S[CurX + 1], S[CurX]) then
-        break;
-      CurX := CurX + 1;
-    end;
-    if CurX > Len then
-      if CurY < Lines.Count - 1 then
-      begin
-        CurY := CurY + 1;
-        CurX := 0;
-      end;
-  end;
-  //------------------------------------------------------------
-begin
-  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
-    and (CurY = FPrevSelY);
-  if ssCtrl in Shift then
-  begin
-    if dX > 0 then
-      MoveWordRight;
-    if dX < 0 then
-      MoveWordLeft;
-  end
-  else
-  begin
-    CurY := CurY + dY;
-    CurX := CurX + dX;
-  end;
-  if Selecting then
-    ExpandSelection
-  else
-    ClearSelection;
-end;
-
-//--------------------------------------------------------------
-//        MOVE PAGE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.MovePage(dP: integer; Shift: TShiftState);
-var
-  eRect: TRect;
-  LinesPerPage: integer;
-  Selecting: Boolean;
-begin
-  if FCellSize.H = 0 then
-    Exit;
-  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
-    and (CurY = FPrevSelY);
-  eRect := EditorRect;
-  LinesPerPage := (eRect.Bottom - eRect.Top) div FCellSize.H - 1;
-  CurY := CurY + dP * LinesPerPage;
-  if ssCtrl in Shift then
-    if dP > 0 then
-    begin
-      CurY := Lines.Count - 1;
-      CurX := Length(Lines[Lines.Count - 1]);
-    end
-    else
-    begin
-      CurY := 0;
-      CurX := 0;
-    end;
-  if Selecting then
-    ExpandSelection
-  else
-    ClearSelection;
-end;
-
-//--------------------------------------------------------------
-//        GO HOME
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.GoHome(Shift: TShiftState);
-var
-  Selecting: Boolean;
-begin
-  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
-    and (CurY = FPrevSelY);
-  CurX := 0;
-  FLeftCol := 0;
-  if Selecting then
-    ExpandSelection
-  else
-    ClearSelection;
-end;
-
-//--------------------------------------------------------------
-//        GO END
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.GoEnd(Shift: TShiftState);
-var
-  Selecting: Boolean;
-  S, S1: string;
-begin
-  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
-    and (CurY = FPrevSelY);
-
-  S := Lines[CurY];
-  if not Selecting then
-    S := TrimRight(S);
-  S1 := TrimRight(Copy(S, CurX + 1, Length(S)));
-  S := Copy(S, 1, CurX);
-  Lines[CurY] := S + S1;
-
-  CurX := Length(Lines[CurY]);
-  if Selecting then
-    ExpandSelection
-  else
-    ClearSelection;
-end;
-
-//--------------------------------------------------------------
-//        INSERT CHAR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.InsertChar(C: Char);
-var
-  S, S1: string;
-  NewPlace: integer;
-  rct: TRect;
-  CurX0, CurY0: integer;
-begin
-  CurX0 := CurX;
-  CurY0 := CurY;
-  S := Lines[CurY];
-  NewPlace := CurX + 1;
-  if C = #9 then
-  begin
-    while (NewPlace mod TabSize) <> 0 do
-      Inc(NewPlace);
-    S1 := StringOfChar(' ', NewPlace - CurX);
-  end
-  else
-    S1 := C;
-  Insert(S1, S, CurX + 1);
-  Lines[CurY] := S;
-  CurX := NewPlace;
-  ClearSelection;
-  rct := LineRect(CurY);
-  Changed(CurY, CurY);
-
-  if Assigned(FUndoList) then
-    FUndoList.Add(TGLSMemoInsCharUndo.Create(CurX0, CurY0, CurX, CurY, S1));
-
-  InvalidateRect(Handle, @rct, True);
-end;
-
-//--------------------------------------------------------------
-//        INSERT TEMPLATE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.InsertTemplate(AText: string);
-var
-  i, NewCurX, NewCurY: integer;
-  Indent: string;
-  FoundCursor: Boolean;
-begin
-  Indent := IndentCurrLine;
-
-  DeleteSelection(False);
-  ClearSelection;
-
-  NewCurX := CurX;
-  NewCurY := CurY;
-  FoundCursor := False;
-  i := 1;
-  while i <= Length(AText) do
-  begin
-    if AText[i] = #13 then
-    begin
-      if (i = Length(AText)) or (AText[i + 1] <> #10) then
-        Insert(#10 + Indent, AText, i + 1);
-      if not FoundCursor then
-      begin
-        Inc(NewCurY);
-        NewCurX := Length(Indent);
-      end;
-      Inc(i, 1 + Length(Indent));
-    end
-    else if AText[i] = #7 then
-    begin
-      FoundCursor := True;
-      Delete(AText, i, 1);
-      Dec(i);
-    end
-    else if Ord(AText[i]) < Ord(' ') then
-    begin
-      Delete(AText, i, 1);
-      Dec(i);
-    end
-    else if not FoundCursor then
-      Inc(NewCurX);
-    Inc(i);
-  end;
-
-  SetSelText(AText);
-  SetCursor(NewCurX, NewCurY);
-  ClearSelection;
-  try
-    SetFocus;
-  except
-  end;
-
-end;
-
-//--------------------------------------------------------------
-//        DELETE CHAR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DeleteChar(OldX, OldY: integer);
-var
-  S, S1: string;
-  rct: TRect;
-  C: char;
-  Undo: TGLSMemoDelCharUndo;
-  IsBackspace: Boolean;
-begin
-  if FReadOnly then
-    Exit;
-  if OldX < 0 then
-  begin
-    OldX := CurX;
-    OldY := CurY;
-    IsBackspace := False;
-  end
-  else
-    IsBackspace := True;
-
-  ClearSelection;
-
-  S := Lines[CurY];
-  S1 := Copy(S, CurX + 1, Length(S));
-  if not IsBackspace then
-    S1 := TrimRight(S1);
-  S := Copy(S, 1, CurX);
-  Lines[CurY] := S + S1;
-
-  if CurX < Length(Lines[CurY]) then
-  begin
-    S := Lines[CurY];
-    C := S[CurX + 1];
-    Delete(S, CurX + 1, 1);
-    Lines[CurY] := S;
-    Changed(CurY, CurY);
-    rct := LineRect(CurY);
-    Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, C);
-    Undo.IsBackSpace := IsBackSpace;
-    if Assigned(FUndoList) then
-      FUndoList.Add(Undo);
-  end
-  else if CurY < Lines.Count - 1 then
-  begin
-    S := Lines[CurY] + Lines[CurY + 1];
-    Lines[CurY] := S;
-    DeleteLine(CurY + 1, OldX, OldY, CurX, CurY, False);
-    Changed(CurY, -1);
-    rct := EditorRect;
-    Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, #13);
-    Undo.IsBackSpace := IsBackSpace;
-    if Assigned(FUndoList) then
-      FUndoList.Add(Undo);
-  end;
-  ClearSelection;
-  InvalidateRect(Handle, @rct, True);
-end;
-
-//--------------------------------------------------------------
-//        DELETE LINE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DeleteLine(Index, OldX, OldY, NewX, NewY: integer;
-  FixUndo: Boolean);
-var
-  rct: TRect;
-  s: string;
-begin
-  if Index < 0 then
-    Index := CurY;
-  if OldX < 0 then
-  begin
-    OldX := CurX;
-    OldY := CurY;
-  end;
-
-  s := Lines[Index];
-
-  TGLSMemoStrings(Lines).FDeleting := True;
-  if Lines.Count = 1 then
-    TGLSMemoStrings(Lines)[0] := ''
-  else
-    Lines.Delete(Index);
-  TGLSMemoStrings(Lines).FDeleting := False;
-
-  ClearSelection;
-  if Index >= Lines.Count then
-    Changed(Index - 1, -1)
-  else
-    Changed(Index, -1);
-  rct := EditorRect;
-  InvalidateRect(Handle, @rct, True);
-
-  if NewX < 0 then
-  begin
-    if Length(Lines[0]) < CurX then
-      CurX := Length(Lines[0]);
-    if Index >= Lines.Count then
-      CurY := Index - 1
-    else
-      CurY := Index;
-    NewX := CurX;
-    NewY := CurY;
-  end
-  else
-  begin
-    CurX := NewX;
-    CurY := NewY;
-  end;
-  if Assigned(FUndoList) and FixUndo then
-    FUndoList.Add(TGLSMEmoDelLineUndo.Create(Index, OldX, OldY, NewX, NewY, s));
-end;
-
-//--------------------------------------------------------------
-//        BACK SPACE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.BackSpace;
-var
-  OldX, OldY: integer;
-begin
-  OldX := CurX;
-  OldY := CurY;
-  MoveCursor(-1, 0, []);
-  if (OldX = CurX) and (OldY = CurY) then
-    Exit;
-  DeleteChar(OldX, OldY);
-end;
-
-//--------------------------------------------------------------
-//        BACK SPACE WORD
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.BackSpaceWord;
-begin
-  ClearSelection;
-  MoveCursor(-1, 0, [ssShift, ssCtrl]);
-  DeleteSelection(True);
-end;
-
-//--------------------------------------------------------------
-//        INDENT CURR LINE
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.IndentCurrLine: string;
-var
-  Len, Count: integer;
-  CurS: string;
-begin
-  Result := '';
-  if not AutoIndent then
-    Exit;
-  CurS := Lines[CurY];
-  Len := Length(CurS);
-  Count := 0;
-  while (Count < CurX) and (Count < Len) do
-  begin
-    if CurS[Count + 1] <> ' ' then
-      break;
-    Inc(Count);
-  end;
-  Result := StringOfChar(' ', Count);
-end;
-
-//--------------------------------------------------------------
-//        NEW LINE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.NewLine;
-var
-  S, sIndent: string;
-  OldX, OldY: integer;
-begin
-  OldX := CurX;
-  OldY := CurY;
-  S := Lines[CurY];
-  sIndent := IndentCurrLine;
-  Lines[CurY] := Copy(S, 1, CurX);
-
-  S := TrimRight(Copy(S, CurX + 1, Length(S)));
-  if AutoIndent then
-    while (Length(S) > 0) and (S[1] = ' ') do
-      Delete(S, 1, 1);
-
-  TGLSMemoStrings(Lines).DoInsert(CurY + 1, sIndent + S);
-  GoHome([]);
-  MoveCursor(0, 1, []);
-  CurX := Length(sIndent);
-  ClearSelection;
-  if Assigned(FUndoList) then
-    FUndoList.Add(TGLSMemoInsCharUndo.Create(OldX, OldY, CurX, CurY, #13 +
-      sIndent));
-  Invalidate;
-  Changed(CurY - 1, -1);
-end;
-
-//--------------------------------------------------------------
-//        ADD STRING
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.AddString(const S: string): integer;
-begin
-  if Lines.Count = 0 then
-    TGLSMemoStrings(Lines).DoAdd('');
-  MovePage(1, [ssCtrl]); // end of text
-  if not ((Lines.Count = 1) and (Lines[0] = '')) then
-  begin
-    TGLSMemoStrings(Lines).DoAdd('');
-    CurX := 0;
-    CurY := Lines.Count;
-    ClearSelection;
-    // S := #13#10 + S;
-  end;
-  SetSelText(S);
-  Result := Lines.Count - 1;
-end;
-
-//--------------------------------------------------------------
-//        INSERT STRING
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.InsertString(Index: integer; S: string);
-begin
-  CurY := Index;
-  CurX := 0;
-  ClearSelection;
-  if not ((Lines.Count = 1) and (Lines[0] = '')) then
-    S := S + #13#10;
-  SetSelText(S);
-end;
-
-//--------------------------------------------------------------
-//        DO COMMAND
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DoCommand(cmd: TCommand; const AShift: TShiftState);
-begin
-  case cmd of
-    cmDelete: if not FReadOnly then
-      begin
-        if ssShift in AShift then
-          CutToClipboard
-        else if FDelErase and
-          (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY))) then
-          DeleteSelection(True)
-        else
-          DeleteChar(-1, -1);
-      end;
-    cmBackSpace: BackSpace;
-    cmWordBackSpace: BackSpaceWord;
-    cmNewLine: NewLine;
-    cmDelLine: DeleteLine(-1, -1, -1, -1, -1, True);
-    cmCopy: CopyToClipboard;
-    cmCut: CutToClipboard;
-    cmPaste: PasteFromClipboard;
-    cmHome: GoHome(AShift);
-    cmEnd: GoEnd(AShift);
-    cmPageDown: MovePage(1, AShift);
-    cmPageUp: MovePage(-1, AShift);
-    cmInsert:
-      begin
-        if ssShift in AShift then
-          PasteFromClipboard;
-        if ssCtrl in AShift then
-          CopyToClipboard;
-      end;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        KEY DOWN
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.KeyDown(var Key: Word; Shift: TShiftState);
-begin
-  ShowCaret(False);
-  inherited;
-  case Key of
-    VK_LEFT: MoveCursor(-1, 0, Shift);
-    VK_RIGHT: MoveCursor(1, 0, Shift);
-    VK_UP: MoveCursor(0, -1, Shift);
-    VK_DOWN: MoveCursor(0, 1, Shift);
-    VK_HOME, VK_END,
-      VK_DELETE: DoCommand(Key, Shift);
-    VK_PRIOR, VK_NEXT:
-      DoCommand(Key, Shift);
-    VK_INSERT: DoCommand(Key, Shift);
-  end;
-  ShowCaret(True);
-end;
-
-//--------------------------------------------------------------
-//        KEY PRESS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.KeyPress(var Key: Char);
-begin
-  if FReadOnly then
-    Exit;
-  ShowCaret(False);
-  inherited;
-  if (ord(Key) in [9, 32..255]) and (ord(Key) <> 127) then
-  begin
-    if FDelErase and (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY)))
-      then
-      DeleteSelection(True);
-    InsertChar(Key);
-  end
-  else
-    DoCommand(Ord(Key), []);
-  ShowCaret(True);
-end;
-
-//--------------------------------------------------------------
-//        MOUSE DOWN
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
-  X, Y: Integer);
-var
-  newPos: TCellPos;
-  charPos: TFullPos;
-  Selecting: Boolean;
-begin
-  inherited;
-  if not Focused then
-  begin
-    SetFocus;
-    //     Exit;
-  end;
-
-  if FAfterDoubleClick then
-  begin
-    FAfterDoubleClick := False;
-    Exit;
-  end;
-
-  if Button <>mbLeft then
-    Exit;
-
-
-  if sbVert.MouseDown(Button, Shift, X, Y) then
-    Exit;
-  if sbHorz.MouseDown(Button, Shift, X, Y) then
-    Exit;
-
-  if PointInRect(Point(X, Y), EditorRect) then
-  begin
-    ShowCaret(False);
-    newPos := CellFromPos(X, Y);
-    CurY := newPos.Y + FTopLine;
-    CurX := newPos.X + FLeftCol;
-    if Assigned(FOnMoveCursor) then
-      FOnMoveCursor(Self);
-
-    Selecting := ssShift in Shift;
-    if Button = mbLeft then
-    begin
-      if Selecting then
-        ExpandSelection
-      else
-        ClearSelection;
-      FLeftButtonDown := True;
-    end
-    else
-      ShowCaret(True);
-  end;
-
-  if Assigned(FOnGutterClick) then
-    if PointInRect(Point(X, Y), FGutter.FullRect) then
-    begin
-      charPos := CharFromPos(X, Y);
-      if charPos.LineNo < Lines.Count then
-        FOnGutterClick(Self, charPos.LineNo);
-    end;
-end;
-
-//--------------------------------------------------------------
-//        MOUSE MOVE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
-var
-  newPos: TCellPos;
-begin
-  inherited;
-  if sbVert.MouseMove(Shift, X, Y) then
-    Exit;
-  if sbHorz.MouseMove(Shift, X, Y) then
-    Exit;
-  if PointInRect(Point(X, Y), EditorRect) then
-  begin
-    if (ssLeft in Shift) and FLeftButtonDown then
-    begin
-      newPos := CellFromPos(X, Y);
-      CurY := newPos.Y + FTopLine;
-      CurX := newPos.X + FLeftCol;
-      ExpandSelection;
-    end;
-  end
-end;
-
-//--------------------------------------------------------------
-//        MOUSE UP
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
-  Integer);
-begin
-  inherited;
-  if sbVert.MouseUp(Button, Shift, X, Y) then
-    Exit;
-  if sbHorz.MouseUp(Button, Shift, X, Y) then
-    Exit;
-  if Button = mbLeft then
-    ShowCaret(True);
-  FLeftButtonDown := False;
-  FLastMouseUpX := X;
-  FLastMouseUpY := Y;
-end;
-
-//--------------------------------------------------------------
-//        DBL CLICK
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DblClick;
-var
-  clickPos: TCellPos;
-  clickX, clickY: integer;
-  //------------------------------------------------------------
-  //   SELECT WORD
-  //------------------------------------------------------------
-  procedure SelectWord;
-  const
-    stopChars: TSysCharSet = [' ', ';', '.', ',', ':', '?', '!', '''', '"',
-      '<', '>', '/', '*', '+', '-', '=', '(', ')',
-      '[', ']', '{', '}', '@', '#', '$', '%', '^',
-      '&', '|', '\'];
-  var
-    s: string;
-    i: integer;
-    rct: TRect;
-  begin
-    CurX := clickX;
-    CurY := clickY;
-    if (CurX = clickX) and (CurY = clickY) then
-    begin
-      s := Lines[clickY];
-      if s[clickX + 1] = ' ' then
-        Exit;
-
-      i := clickX;
-      while (i >= 0) and not CharInSet(s[i + 1], stopChars) do
-        Dec(i);
-      FSelStartY := clickY;
-      FSelStartX := i + 1;
-
-      i := clickX;
-      while (i < Length(s)) and not CharInSet(s[i + 1], stopChars) do
-        Inc(i);
-      FSelEndY := clickY;
-      FSelEndX := i;
-
-      if FSelEndX <> FSelStartX then
-      begin
-        FAfterDoubleClick := True;
-        rct := LineRangeRect(CurY, CurY);
-        SelectionChanged;
-        InvalidateRect(Handle, @rct, true);
-      end;
-    end;
-  end;
-  //------------------------------------------------------------
-begin
-
-  if PointInRect(Point(FLastMouseUpX, FLastMouseUpY), EditorRect) then
-  begin
-    clickPos := CellFromPos(FLastMouseUpX, FLastMouseUpY);
-    clickX := clickPos.X + FLeftCol;
-    clickY := clickPos.Y + FTopLine;
-    SelectWord;
-  end;
-  inherited;
-end;
-
-//--------------------------------------------------------------
-//        WM_GETDLGCODE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.WMGetDlgCode(var Msg: TWMGetDlgCode);
-begin
-  Msg.Result := DLGC_WANTARROWS or DLGC_WANTTAB;
-end;
-
-//--------------------------------------------------------------
-//        WM_ERASEBKGND
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
-begin
-  Msg.Result := 1;
-end;
-
-//--------------------------------------------------------------
-//        WM_SIZE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.WMSize(var Msg: TWMSize);
-begin
-  if not (csLoading in ComponentState) then
-    try
-      ResizeEditor;
-    except
-    end;
-end;
-
-//--------------------------------------------------------------
-//        WM_SETCURSOR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.WMSetCursor(var Msg: TWMSetCursor);
-var
-  P: TPoint;
-begin
-  Msg.Result := 1;
-  GetCursorPos(P);
-  P := ScreenToClient(P);
-  if PointInRect(P, EditorRect) then
-    Winapi.Windows.SetCursor(Screen.Cursors[crIBeam])
-  else
-    Winapi.Windows.SetCursor(Screen.Cursors[crArrow]);
-end;
-
-//--------------------------------------------------------------
-//        WM_SETFOCUS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.WMSetFocus(var Msg: TWMSetFocus);
-begin
-  if FCellSize.H = 0 then
-    SetFont(FFont);
-  CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
-  ShowCaret(true);
-end;
-
-//--------------------------------------------------------------
-//        WM_KILLFOCUS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.WMKillFocus(var Msg: TWMSetFocus);
-begin
-  DestroyCaret;
-  FCaretVisible := False;
-  inherited;
-end;
-
-//--------------------------------------------------------------
-//        SHOW CARET
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ShowCaret(State: Boolean);
-var
-  rct: TRect;
-begin
-  FCaretVisible := False;
-  if not State then
-    HideCaret(Handle)
-  else if Focused and not HiddenCaret then
-  begin
-    rct := CellRect(CurX - FLeftCol, CurY - FTopLine);
-    SetCaretPos(rct.Left, rct.Top + 1);
-    Winapi.Windows.ShowCaret(Handle);
-    FCaretVisible := True;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        CELL RECT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.CellRect(ACol, ARow: integer): TRect;
-var
-  rct: TRect;
-begin
-  rct := EditorRect;
-  with FCellSize do
-    Result := Rect(rct.Left + W * ACol, rct.Top + H * ARow,
-      rct.Left + W * (ACol + 1), rct.Top + H * (ARow + 1));
-end;
-
-//--------------------------------------------------------------
-//        LINE RECT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.LineRect(ARow: integer): TRect;
-var
-  rct: TRect;
-begin
-  rct := EditorRect;
-  ARow := ARow - FTopLine;
-  with FCellSize do
-    Result := Rect(rct.Left, rct.Top + H * ARow, rct.Right, rct.Top + H * (ARow
-      + 1));
-end;
-
-//--------------------------------------------------------------
-//        COL RECT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.ColRect(ACol: integer): TRect;
-var
-  rct: TRect;
-begin
-  rct := EditorRect;
-  ACol := ACol - FLeftCol;
-  with FCellSize do
-    Result := Rect(rct.Left + W * ACol, rct.Top, rct.Left + W * (ACol + 1),
-      rct.Bottom);
-end;
-
-//--------------------------------------------------------------
-//        LINE RANGE RECT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.LineRangeRect(FromLine, ToLine: integer): TRect;
-var
-  rct1, rct2: TRect;
-begin
-  rct1 := LineRect(FromLine);
-  rct2 := LineRect(ToLine);
-  Result := TotalRect(rct1, rct2);
-end;
-
-//--------------------------------------------------------------
-//        INVALIDATE LINE RANGE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.InvalidateLineRange(FromLine, ToLine: integer);
-var
-  rct: TRect;
-begin
-  if ToLine < FromLine then
-    ToLine := Lines.Count - 1;
-  rct := LineRangeRect(FromLine, ToLine);
-  if GutterWidth > 2 then
-    rct.Left := FGutter.Left;
-  InvalidateRect(Handle, @rct, True);
-end;
-
-//--------------------------------------------------------------
-//        COL RANGE RECT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.ColRangeRect(FromCol, ToCol: integer): TRect;
-var
-  rct1, rct2: TRect;
-begin
-  rct1 := ColRect(FromCol);
-  rct2 := ColRect(ToCol);
-  Result := TotalRect(rct1, rct2);
-end;
-
-//--------------------------------------------------------------
-//        CELL and CHAR FROM POS
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.CellFromPos(X, Y: integer): TCellPos;
-var
-  rct: TRect;
-begin
-  rct := EditorRect;
-  if (FCellSize.H = 0) and Assigned(FFont) then
-    SetFont(FFont);
-  if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
-  begin
-    Result.X := (X - rct.Left) div FCellSize.W;
-    Result.Y := (Y - rct.Top) div FCellSize.H;
-  end
-  else
-  begin
-    Result.X := 0;
-    Result.Y := 0;
-  end;
-end;
-
-function TGLSCustomMemo.CharFromPos(X, Y: integer): TFullPos;
-var
-  rct: TRect;
-begin
-  rct := EditorRect;
-  if (FCellSize.H = 0) and Assigned(FFont) then
-    SetFont(FFont);
-  if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
-  begin
-    Result.Pos := (X - rct.Left) div FCellSize.W + FLeftCol;
-    Result.LineNo := (Y - rct.Top) div FCellSize.H + FTopLine;
-  end
-  else
-  begin
-    Result.Pos := 1;
-    Result.LineNo := 1;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SET COLOR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetColor(Index: integer; Value: TColor);
-var
-  eRect: TRect;
-  Changed: Boolean;
-begin
-  Changed := False;
-  case Index of
-    0: if FBkColor <> Value then
-      begin
-        FBkColor := Value;
-        FStyles.BkColor[0] := Value;
-        Changed := True;
-      end;
-    1: if FSelColor <> Value then
-      begin
-        FSelColor := Value;
-        Changed := True;
-      end;
-    2: if FSelBkColor <> Value then
-      begin
-        FSelBkColor := Value;
-        Changed := True;
-      end;
-  end;
-  if Changed then
-  begin
-    eRect := EditorRect;
-    InvalidateRect(Handle, @eRect, True);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SET FONT
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetFont(Value: TFont);
-var
-  wW, wi: integer;
-  OldFontName: string;
-  eRect: TRect;
-begin
-  OldFontName := Canvas.Font.Name;
-  Canvas.Font.Name := Value.Name;
-  wW := Canvas.TextWidth('W');
-  wi := Canvas.TextWidth('i');
-  Canvas.Font.Name := OldFontName;
-
-  if wW <> wi then
-    raise EAbort.Create('Monospace font required');
-
-  FFont.Assign(Value);
-  Canvas.Font.Assign(Value);
-  FCellSize.W := Canvas.TextWidth('W');
-  FCellSize.H := Canvas.TextHeight('W') + 1;
-
-  if FCaretVisible then
-  begin
-    ShowCaret(False);
-    DestroyCaret;
-    CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
-    ShowCaret(true);
-  end;
-
-  FStyles.TextColor[0] := FFont.Color;
-  FStyles.Style[0] := FFont.Style;
-
-  eRect := EditorRect;
-  InvalidateRect(Handle, @eRect, True);
-end;
-
-//--------------------------------------------------------------
-//        SET GUTTER WIDTH
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetGutterWidth(Value: integer);
-begin
-  FGutterWidth := Value;
-  FGutter.FWidth := Value;
-  if not (csLoading in ComponentState) then
-    ResizeEditor;
-end;
-
-//--------------------------------------------------------------
-//        SET GUTTER COLOR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetGutterColor(Value: TColor);
-begin
-  if FGutter.FColor <> Value then
-  begin
-    FGutter.FColor := Value;
-    FGutter.Invalidate;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        GET GUTTER COLOR
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetGutterColor: TColor;
-begin
-  Result := FGutter.FColor;
-end;
-
-//--------------------------------------------------------------
-//        CHAR STYLE NO
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.CharStyleNo(LineNo, Pos: integer): integer;
-var
-  ChStyle: string;
-begin
-  Result := 0;
-  if (LineNo < 0) or (LineNo >= Lines.Count) then
-    Exit;
-
-  ChStyle := CharAttrs[LineNo];
-  if (Pos <= 0) or (Pos > Length(ChStyle)) then
-    Exit;
-
-  Result := integer(ChStyle[Pos]);
-end;
-
-//--------------------------------------------------------------
-//        DRAW LINE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DrawLine(LineNo: integer);
-var
-  eRect, rct0, rct1, rct, lineRct: TRect;
-  LineSelStart, LineSelEnd, LineStyleNo, pos: integer;
-  S, S1, S2, S3, ChStyle: string;
-  //--------- FIND LINE SELECTION -------------
-  procedure FindLineSelection;
-  var
-    len: integer;
-    xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
-  begin
-    xSelStartX := FSelStartX;
-    xSelStartY := FSelStartY;
-    xSelEndX := FSelEndX;
-    xSelEndY := FSelEndY;
-    OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
-    len := Length(Lines[LineNo]);
-    LineSelStart := 0;
-    LineSelEnd := 0;
-    if xSelStartY = Lineno then
-    begin
-      LineSelStart := xSelStartX - FLeftCol;
-      LineSelEnd := len - FLeftCol;
-    end
-    else if (xSelStartY < LineNo) and (LineNo < xSelEndY) then
-    begin
-      LineSelStart := 0;
-      LineSelEnd := len - FLeftCol;
-    end;
-
-    if xSelEndY = LineNo then
-      LineSelEnd := xSelEndX - FLeftCol;
-
-    if LineSelEnd < LineSelStart then
-      Swap(LineSelEnd, LineSelStart);
-
-    if LineSelStart < 0 then
-      LineSelStart := 0;
-    S := Copy(Lines[LineNo], FLeftCol + 1, len);
-    S1 := Copy(S, 1, LineSelStart);
-    S2 := Copy(S, LineSelStart + 1, LineSelEnd - LineSelStart);
-    S3 := Copy(S, LineSelEnd + 1, len);
-  end;
-  //------------- DRAW PART ---------------------
-  procedure DrawPart(const Part: string; PartStyle, StartPos: integer;
-    var rct: TRect; IsSelection: Boolean);
-  var
-    len, w: integer;
-    rctInternal: TRect;
-  begin
-    len := Length(Part);
-    if len > 0 then
-      with FLineBitmap.Canvas do
-      begin
-        w := FCellSize.W * len;
-        Font.Style := FStyles.Style[PartStyle];
-        if IsSelection then
-        begin
-          Font.Color := SelColor;
-          Brush.Color := SelBkColor;
-        end
-        else
-        begin
-          if LineStyleNo = 0 then
-          begin
-            Font.Color := FStyles.TextColor[PartStyle];
-            Brush.Color := FStyles.BkColor[PartStyle];
-          end
-          else
-          begin
-            if (LineNo = FSelCharPos.LineNo) and
-              (StartPos = FSelCharPos.Pos + 1) and (Length(Part) = 1) then
-            begin
-              Font.Color := FStyles.TextColor[PartStyle];
-              Brush.Color := FStyles.BkColor[PartStyle];
-            end
-            else
-            begin
-              Font.Color := FStyles.TextColor[LineStyleNo];
-              Brush.Color := FStyles.BkColor[LineStyleNo];
-              Font.Style := FStyles.Style[LineStyleNo];
-            end;
-          end;
-        end;
-        rct.Right := rct.Left + w;
-        rctInternal := rct;
-        rctInternal.Left := rctInternal.Left - eRect.Left;
-        rctInternal.Right := rctInternal.Right - eRect.Left;
-        rctInternal.Top := rctInternal.Top - rct.Top;
-        rctInternal.Bottom := rctInternal.Bottom - rct.Top;
-        FillRect(rctInternal);
-        DrawText(Handle, PChar(Part), len, rctInternal, DT_LEFT
-          or DT_SINGLELINE or DT_NOPREFIX);
-        rct0.Left := rct.Left + w;
-        rct := rct0;
-      end;
-  end;
-  //------------- DRAW SEGMENTS ---------------------
-  procedure DrawSegments(S: string; WorkPos: integer;
-    var rct: TRect; IsSelection: Boolean);
-  var
-    i, len, ThisStyle: integer;
-  begin
-    while True do
-    begin
-      Len := Length(S);
-      if Len = 0 then
-        Exit;
-      ThisStyle := Ord(ChStyle[WorkPos]);
-      i := 1;
-      while (i <= Len) and
-        (ThisStyle = Ord(ChStyle[WorkPos + i - 1])) do
-        Inc(i);
-      DrawPart(Copy(S, 1, i - 1), ThisStyle, WorkPos, rct, IsSelection);
-      Inc(WorkPos, i - 1);
-      s := Copy(s, i, Len);
-    end;
-  end;
-  //---------------------------------------------
-begin
-  eRect := EditorRect;
-  rct := CellRect(0, LineNo - FTopLine);
-  rct0 := Rect(eRect.Left, rct.Top, eRect.Right, rct.Bottom);
-  lineRct := rct0;
-
-  if LineNo < Lines.Count then
-  begin
-
-    rct := rct0;
-    S := Lines[LineNo];
-    LineStyleNo := LineStyle[LineNo];
-    ChStyle := CharAttrs[LineNo];
-    FindLineSelection;
-
-    if not Assigned(FOnGetLineAttrs) then
-      ChStyle := StringOfChar(#0, Length(Lines[LineNo]));
-
-    if Length(S) > 0 then
-      if (FSelCharStyle >= 0) and (LineNo = FSelCharPos.LineNo) then
-        ChStyle[FSelCharPos.Pos + 1] := Char(FSelCharStyle);
-
-    pos := FLeftCol + 1; // 1
-    DrawSegments(S1, pos, rct, False);
-    Inc(pos, Length(S1));
-    DrawSegments(S2, pos, rct, True);
-    Inc(pos, Length(S2));
-    DrawSegments(S3, pos, rct, False);
-
-    //       else begin
-    //            DrawPart(S1,StyleNo,rct,False);
-    //            DrawPart(S2,StyleNo,rct,True);
-    //            DrawPart(S3,StyleNo,rct,False);
-    //       end;
-
-    rct1 := rct;
-    rct1.Left := rct1.Left - eRect.Left;
-    rct1.Right := rct1.Right - eRect.Left;
-    rct1.Top := rct1.Top - rct.Top;
-    rct1.Bottom := rct1.Bottom - rct.Top;
-    with FLineBitmap.Canvas do
-    begin
-      Brush.Color := FStyles.BkColor[LineStyleNo];
-      FillRect(rct1);
-    end;
-
-    with LineRct do
-      BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
-        FLineBitmap.Canvas.Handle, 0, 0, SRCCOPY);
-  end
-  else
-    with Canvas do
-    begin
-      Brush.Color := BkColor;
-      FillRect(rct0);
-    end;
-end;
-
-//--------------------------------------------------------------
-//        SET HIDDEN CARET
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetHiddenCaret(Value: Boolean);
-begin
-  if Value <> FHiddenCaret then
-  begin
-    FHiddenCaret := Value;
-    if Focused then
-      if FHiddenCaret = FCaretVisible then
-        ShowCaret(not FHiddenCaret);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        BORDER
-//--------------------------------------------------------------
-
-procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
-const
-  Colors: array[TBorderType] of array[1..4] of TColor
-    = (($D0D0D0, clWhite, clGray, clBlack),
-    (clGray, clBlack, $D0D0D0, clWhite),
-    (clWhite, clWhite, clWhite, clGray),
-    (clGray, clWhite, clWhite, clGray));
-begin
-  with Canvas do
-  begin
-    Pen.Color := Colors[BorderType][1];
-    MoveTo(rct.Left, rct.Bottom - 1);
-    LineTo(rct.Left, rct.Top);
-    LineTo(rct.Right, rct.Top);
-    if BorderType in [btRaised, btLowered] then
-    begin
-      Pen.Color := Colors[BorderType][2];
-      MoveTo(rct.Left + 1, rct.Bottom);
-      LineTo(rct.Left + 1, rct.Top + 1);
-      LineTo(rct.Right, rct.Top + 1);
-      Pen.Color := Colors[BorderType][3];
-      MoveTo(rct.Left + 1, rct.Bottom - 2);
-      LineTo(rct.Right - 2, rct.Bottom - 2);
-      LineTo(rct.Right - 2, rct.Top + 1);
-    end;
-    Pen.Color := Colors[BorderType][4];
-    MoveTo(rct.Left, rct.Bottom - 1);
-    LineTo(rct.Right - 1, rct.Bottom - 1);
-    LineTo(rct.Right - 1, rct.Top);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        EDITOR RECT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.EditorRect: TRect;
-var
-  l, t, r, b: integer;
-begin
-  l := 2;
-  r := Width - 2;
-  t := 2;
-  b := Height - 2;
-  if GutterWidth > 2 then
-    l := l + GutterWidth;
-  if FScrollBars in [ssBoth, ssVertical] then
-    r := r - FScrollBarWidth;
-  if FScrollBars in [ssBoth, ssHorizontal] then
-    b := b - FScrollBarWidth;
-  Result := Rect(l + FMargin, t, r, b);
-end;
-
-//--------------------------------------------------------------
-//        DRAW MARGIN
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DrawMargin;
-var
-  eRect: TRect;
-  i: integer;
-begin
-  eRect := EditorRect;
-  with Canvas do
-  begin
-    Pen.Color := clWhite;
-    for i := 1 to FMargin do
-    begin
-      MoveTo(eRect.Left - i, eRect.Top);
-      LineTo(eRect.Left - i, eRect.Bottom + 1);
-    end;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        DRAW GUTTER
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DrawGutter;
-begin
-  if GutterWidth < 2 then
-    Exit;
-  ResizeGutter;
-  FGutter.PaintTo(Canvas);
-end;
-
-//--------------------------------------------------------------
-//        DRAW SCROLLBARS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.DrawScrollBars;
-begin
-  ResizeScrollBars;
-  if FScrollBars in [ssBoth, ssVertical] then
-    sbVert.PaintTo(Canvas);
-  if FScrollBars in [ssBoth, ssHorizontal] then
-    sbHorz.PaintTo(Canvas);
-  if FScrollBars = ssBoth then
-    with Canvas do
-    begin
-      Brush.Color := clSilver;
-      FillRect(Rect(sbVert.Left, sbHorz.Top + 1,
-        sbVert.Left + sbVert.Width, sbHorz.Top + sbHorz.Height));
-    end;
-end;
-
-//--------------------------------------------------------------
-//        FRESH LINE BITMAP
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.FreshLineBitmap;
-var
-  eRect: TRect;
-begin
-  eRect := EditorRect;
-  with FLineBitmap do
-  begin
-    Width := eRect.Right - eRect.Left;
-    Height := FCellSize.H;
-    FLineBitmap.Canvas.Font.Assign(Self.Canvas.Font);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        PAINT
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.Paint;
-var
-  pTop, pBottom: TFullPos;
-  rct, eRect: TRect;
-  i: integer;
-  clipRgn: HRGN;
-  Attrs: string;
-begin
-  if TGLSMemoStrings(Lines).FLockCount > 0 then
-    Exit;
-  with Canvas do
-  begin
-    if FCellSize.H = 0 then
-      SetFont(FFont);
-    FreshLineBitmap;
-
-    Border(Canvas, Rect(0, 0, Width, Height), btLowered);
-    DrawMargin;
-    DrawGutter;
-    DrawScrollBars;
-
-    eRect := EditorRect;
-    clipRgn := CreateRectRgn(eRect.Left, eRect.Top, eRect.Right, eRect.Bottom);
-    ExtSelectClipRgn(Canvas.Handle, clipRgn, RGN_AND);
-    DeleteObject(clipRgn);
-
-    rct := Canvas.ClipRect;
-    pTop := CharFromPos(rct.Left, rct.Top);
-    pBottom := CharFromPos(rct.Left, rct.Bottom);
-
-    if Assigned(FOnGetLineAttrs) then
-      for i := 0 to Lines.Count - 1 do
-        if not ValidAttrs[i] then
-        begin
-          FOnGetLineAttrs(Self, i, Attrs);
-          CharAttrs[i] := Attrs;
-          ValidAttrs[i] := True;
-        end;
-
-    for i := pTop.LineNo to pBottom.LineNo do
-      DrawLine(i);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        GET VISIBLE
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.GetVisible(Index: integer): integer;
-var
-  Coord: TFullPos;
-  Cell: TCellPos;
-  eRect: TRect;
-begin
-  eRect := EditorRect;
-  Coord := CharFromPos(eRect.Right - 1, eRect.Bottom - 1);
-  Cell := CellFromPos(eRect.Right - 1, eRect.Bottom - 1);
-  case Index of
-    0: Result := Cell.X;
-    1: Result := Cell.Y;
-    2: Result := Coord.Pos - 1;
-    3: Result := Coord.LineNo - 1;
-  else
-    Result := 0;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        IS LINE VISIBLE
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.IsLineVisible(LineNo: integer): Boolean;
-begin
-  if FCellSize.H = 0 then
-    SetFont(FFont);
-  Result := (FTopLine <= LineNo) and (LineNo <= LastVisibleLine + 1);
-end;
-
-//--------------------------------------------------------------
-//        MAKE VISIBLE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.MakeVisible;
-var
-  Modified: Boolean;
-begin
-  Modified := False;
-  if CurX < FLeftCol then
-  begin
-    FLeftCol := CurX - 2;
-    if FLeftCol < 0 then
-      FLeftCol := 0;
-    Modified := True;
-  end;
-  if CurX > LastVisiblePos then
-  begin
-    if (FScrollBars in [ssBoth, ssHorizontal]) or
-      (ScrollMode = smAuto) then
-    begin
-      FLeftCol := FLeftCol + CurX - LastVisiblePos + 2;
-    end
-    else
-      CurX := LastVisiblePos;
-    Modified := True;
-  end;
-  if CurY < FTopLine then
-  begin
-    FTopLine := CurY;
-    if FTopLine < 0 then
-      FTopLine := 0;
-    Modified := True;
-  end;
-  if CurY > LastVisibleLine then
-  begin
-    if (FScrollBars in [ssBoth, ssVertical]) or
-      (ScrollMode = smAuto) then
-    begin
-      FTopLine := FTopLine + CurY - LastVisibleLine;
-    end
-    else
-      CurY := LastVisibleLine;
-    Modified := True;
-  end;
-  if Modified then
-    Invalidate;
-end;
-
-//--------------------------------------------------------------
-//        RESIZE EDITOR
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ResizeEditor;
-begin
-  ResizeScrollBars;
-  ResizeGutter;
-  MakeVisible;
-  Invalidate;
-end;
-
-//--------------------------------------------------------------
-//        FIND TEXT
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.FindText(Text: string; Options: TFindOptions; Select:
-  Boolean): Boolean;
-var
-  i, p: integer;
-  s1, s0, s: string;
-  //-----------------------------------------------------------
-  function LastPos(const Substr, s: string): integer;
-  var
-    i, j, lenSub: integer;
-  begin
-    Result := 0;
-    lenSub := Length(Substr);
-    i := Length(s) - lenSub + 1;
-    while i > 0 do
-    begin
-      if s[i] = Substr[1] then
-      begin
-        Result := i;
-        for j := i + 1 to i + lenSub - 1 do
-          if s[j] <> Substr[j - i + 1] then
-          begin
-            Result := 0;
-            break;
-          end;
-      end;
-      if Result <> 0 then
-        break;
-      Dec(i);
-    end;
-  end;
-  //-----------------------------------------------------------
-begin
-  Result := False;
-  if not (frMatchCase in Options) then
-    Text := AnsiLowerCase(Text);
-
-  if SelLength > 0 then
-    ClearSelection;
-  s := Lines[CurY];
-  s0 := Copy(s, 1, CurX);
-  s1 := Copy(s, CurX + 1, Length(s));
-  i := CurY;
-
-  while True do
-  begin
-
-    if not (frMatchCase in Options) then
-    begin
-      s0 := AnsiLowerCase(s0);
-      s1 := AnsiLowerCase(s1);
-    end;
-
-    if frDown in Options then
-      p := Pos(Text, s1)
-    else
-      p := LastPos(Text, s0);
-
-    if p > 0 then
-    begin
-      Result := True;
-      CurY := i;
-      if frDown in Options then
-        CurX := Length(s0) + p - 1
-      else
-        CurX := p - 1;
-      if Select then
-      begin
-        if not (frDown in Options) then
-          CurX := CurX + Length(Text);
-        ClearSelection;
-        if frDown in Options then
-          CurX := CurX + Length(Text)
-        else
-          CurX := CurX - Length(Text);
-        ExpandSelection;
-      end;
-      break;
-    end;
-
-    if frDown in Options then
-      Inc(i)
-    else
-      Dec(i);
-    if (i < 0) or (i > Lines.Count - 1) then
-      break;
-    if frDown in Options then
-    begin
-      s0 := '';
-      s1 := Lines[i];
-    end
-    else
-    begin
-      s0 := Lines[i];
-      s1 := '';
-    end;
-
-  end;
-
-end;
-
-//--------------------------------------------------------------
-//        RESIZE SCROLLBARS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ResizeScrollBars;
-var
-  eRect, sbRect: TRect;
-  MaxLen, OldMax, NewTop, Margin: integer;
-begin
-  eRect := EditorRect;
-  if FScrollBars in [ssBoth, ssVertical] then
-  begin
-    with sbVert do
-    begin
-      Width := 16;
-      Height := eRect.Bottom - eRect.Top + 1;
-      Left := eRect.Right;
-      Top := eRect.Top;
-      OldMax := MaxPosition;
-      MaxPosition := (Lines.Count - 1) - (LastVisibleLine - FTopLine);
-      NewTop := FTopLine;
-      if (FTopLine > 0) and (LastVisibleLine > Lines.Count - 1) then
-      begin
-        Dec(NewTop, LastVisibleLine - (Lines.Count - 1));
-        if NewTop < 0 then
-          NewTop := 0;
-        MaxPosition := NewTop;
-      end;
-      if MaxPosition < 0 then
-        MaxPosition := 0;
-      Position := NewTop;
-      Total := Lines.Count;
-      if OldMax <> MaxPosition then
-      begin
-        if NewTop <> FTopLine then
-        begin
-          DoScroll(sbVert, NewTop - FTopLine);
-          FGutter.Invalidate;
-        end;
-        sbRect := sbVert.FullRect;
-        InvalidateRect(Handle, @sbRect, True);
-      end;
-    end;
-  end;
-  if FScrollBars in [ssBoth, ssHorizontal] then
-  begin
-    MaxLen := MaxLength;
-    with sbHorz do
-    begin
-      Width := Self.Width - 4;
-      if FScrollBars = ssBoth then
-        Width := Width - sbVert.Width;
-      Height := 16;
-      Left := 2;
-      Top := eRect.Bottom;
-      OldMax := MaxPosition;
-
-      Margin := LastVisiblePos - MaxLen;
-      if Margin < 2 then
-        Margin := 2;
-      MaxPosition := MaxLen - (LastVisiblePos - FLeftCol) + Margin;
-
-      if MaxPosition < 0 then
-        MaxPosition := 0;
-      Position := FLeftCol;
-      Total := MaxLen;
-      if OldMax <> MaxPosition then
-      begin
-        if MaxPosition = 0 then
-        begin
-          FLeftCol := 0;
-          InvalidateRect(Handle, @eRect, True);
-          ;
-          FGutter.Invalidate;
-        end;
-        sbRect := sbHorz.FullRect;
-        InvalidateRect(Handle, @sbRect, True);
-      end;
-    end;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        RESIZE GUTTER
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ResizeGutter;
-var
-  eRect: TRect;
-begin
-  eRect := EditorRect;
-  with FGutter do
-  begin
-    Height := eRect.Bottom - eRect.Top;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        CREATE PARAMS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.CreateParams(var Params: TCreateParams);
-begin
-  inherited;
-end;
-
-//--------------------------------------------------------------
-//        UNDO, REDO
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.Undo;
-begin
-  FUndoList.Undo;
-end;
-
-procedure TGLSCustomMemo.Redo;
-begin
-  FUndoList.Redo;
-end;
-
-//--------------------------------------------------------------
-//        SET UNDO LIMIT
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetUndoLimit(Value: integer);
-begin
-  if (FUndoLimit <> Value) then
-  begin
-    if Value <= 0 then
-      Value := 1;
-    if Value > 100 then
-      Value := 100;
-    FUndoLimit := Value;
-    FUndoList.Limit := Value;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        UNDO (REDO) CHANGE
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.UndoChange;
-begin
-  if Assigned(FOnUndoChange) then
-    FOnUndoChange(Self, FUndoList.Pos < FUndoList.Count,
-      FUndoList.Pos > 0);
-end;
-
-//--------------------------------------------------------------
-//        CAN UNDO
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.CanUndo: boolean;
-begin
-  Result := FUndoList.FPos < FUndoList.Count;
-end;
-
-//--------------------------------------------------------------
-//        CAN REDO
-//--------------------------------------------------------------
-
-function TGLSCustomMemo.CanRedo: Boolean;
-begin
-  Result := FUndoList.FPos > 0;
-end;
-
-//--------------------------------------------------------------
-//        CLEAR UNDO LIST
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.ClearUndoList;
-begin
-  if Assigned(FUndoList) then
-    FUndoList.Clear;
-end;
-
-//--------------------------------------------------------------
-//        SET SCROLL BARS
-//--------------------------------------------------------------
-
-procedure TGLSCustomMemo.SetScrollBars(Value: System.UITypes.TScrollStyle);
-begin
-  if FScrollBars <> Value then
-  begin
-    FScrollBars := Value;
-    if not (csLoading in ComponentState) then
-      ResizeEditor;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        CREATE
-//--------------------------------------------------------------
-
-constructor TGLSCustomMemo.Create(AOwner: TComponent);
-begin
-  inherited;
-
-  ControlStyle := [csCaptureMouse, csClickEvents,
-    csDoubleClicks, csReplicatable];
-  Width := 100;
-  Height := 40;
-  TabStop := True;
-  Cursor := crIBeam;
-
-  FFont := TFont.Create;
-  FFont.Name := 'Courier New';
-  FFont.Size := 10;
-  Canvas.Font.Assign(FFont);
-
-  FHiddenCaret := False;
-  FCaretVisible := False;
-
-  FCurX := 0;
-  FCurY := 0;
-  FLeftCol := 0;
-  FTopLine := 0;
-  FTabSize := 4;
-  FMargin := 2;
-  FAutoIndent := True;
-  FLines := TGLSMemoStrings.Create;
-  TGLSMemoStrings(FLines).FMemo := Self;
-
-  FScrollBars := ssBoth;
-  FScrollBarWidth := 16;
-  sbVert := TGLSMemoScrollBar.Create(Self, sbVertical);
-  sbVert.Width := FScrollBarWidth;
-  sbHorz := TGLSMemoScrollBar.Create(Self, sbHorizontal);
-  sbHorz.Height := FScrollBarWidth;
-
-  FGutter := TGLSMemoGutter.Create;
-  with FGutter do
-  begin
-    FLeft := 2;
-    FTop := 2;
-    FWidth := 0;
-    FHeight := 0;
-    FColor := clBtnFace;
-    FMemo := Self;
-  end;
-
-  FSelStartX := 0;
-  FSelStartY := 0;
-  FSelEndX := 0;
-  FSelEndY := 0;
-
-  FBkColor := clWhite;
-  FSelColor := clWhite;
-  FSelBkColor := clNavy;
-
-  FStyles := TStyleList.Create;
-  FStyles.Add(clBlack, clWhite, []);
-
-  FSelCharPos.LineNo := -1;
-  FSelCharPos.Pos := -1;
-  FSelCharStyle := -1;
-
-  FLineBitmap := TBitmap.Create;
-
-  FLeftButtonDown := False;
-  FScrollMode := smAuto;
-
-  FUndoList := TGLSMemoUndoList.Create;
-  FFirstUndoList := FUndoList;
-  FUndoList.Memo := Self;
-
-  FUndoLimit := 100;
-
-  TGLSMemoStrings(FLines).DoAdd('');
-
-  FAfterDoubleClick := False;
-
-end;
-
-//--------------------------------------------------------------
-//        DESTROY
-//--------------------------------------------------------------
-
-destructor TGLSCustomMemo.Destroy;
-begin
-  FFont.Free;
-  FLines.Free;
-  FGutter.Free;
-  sbVert.Free;
-  sbHorz.Free;
-  FStyles.Free;
-  FLineBitmap.Free;
-  FFirstUndoList.Free;
-  inherited;
-end;
-
- 
-
-// ---------------------TGLSMemoScrollBar functions 
-
-procedure TGLSMemoScrollBar.SetParams(Index: integer; Value: integer);
-begin
-  case Index of
-    0: if Left <> Value then
-        FLeft := Value;
-    1: if Top <> Value then
-        FTop := Value;
-    2: if Width <> Value then
-        FWidth := Value;
-    3: if Height <> Value then
-        FHeight := Value;
-    4: if Total <> Value then
-        FTotal := Value;
-    5: if MaxPosition <> Value then
-        FMaxPosition := Value;
-    6: if Position <> Value then
-        FPosition := Value;
-  end;
-end;
-//-------------------- CREATE ------------------------------
-
-constructor TGLSMemoScrollBar.Create(AParent: TGLSMemoAbstractScrollableObject;
-  AKind: TScrollBarKind);
-begin
-  FParent := AParent;
-  FButtonLength := 16;
-  FKind := AKind;
-  FState := sbsWait;
-end;
-//-------------------- RECT -----------------------
-
-function TGLSMemoScrollBar.GetRect: TRect;
-begin
-  Result := Rect(Left, Top, Left + Width, Top + Height);
-end;
-//-------------------- GET THUMB RECT -----------------------
-
-function TGLSMemoScrollBar.GetThumbRect: TRect;
-var
-  TotalLen, FreeLen, ThumbLen, ThumbOffset, ThumbCoord: integer;
-  K: double;
-begin
-  if MaxPosition <= 0 then
-  begin
-    Result := Rect(0, 0, 0, 0);
-    Exit;
-  end;
-  if Kind = sbVertical then
-    TotalLen := Height
-  else
-    TotalLen := Width;
-  FreeLen := TotalLen - 2 * FButtonLength;
-
-  K := (Total - MaxPosition) / MaxPosition;
-  if K > 0 then
-  begin
-    ThumbLen := round(FreeLen * K / (1 + K));
-    if ThumbLen < 8 then
-      ThumbLen := 8;
-  end
-  else
-    ThumbLen := 8;
-
-  if ThumbLen >= FreeLen then
-    Result := Rect(0, 0, 0, 0)
-  else
-  begin
-    ThumbOffset := round((FreeLen - ThumbLen) * Position / MaxPosition);
-    ThumbCoord := FButtonLength + ThumbOffset;
-    if Kind = sbVertical then
-      Result := Rect(Left + 1, Top + ThumbCoord, Left + Width, Top + ThumbCoord
-        + ThumbLen)
-    else
-      Result := Rect(Left + ThumbCoord, Top + 1, Left + ThumbCoord + ThumbLen,
-        Top + Height);
-  end;
-end;
-//-------------------- GET Back RECT -----------------------
-
-function TGLSMemoScrollBar.GetBackRect: TRect;
-begin
-  if Kind = sbVertical then
-    Result := Rect(Left + 1, Top, Left + Width, Top + FButtonLength)
-  else
-    Result := Rect(Left, Top + 1, Left + FButtonLength, Top + Height);
-end;
-//-------------------- GET MIDDLE RECT -----------------------
-
-function TGLSMemoScrollBar.GetMiddleRect: TRect;
-var
-  bRect, fRect: TRect;
-begin
-  bRect := BackRect;
-  fRect := ForwardRect;
-  if Kind = sbVertical then
-    Result := Rect(Left + 1, bRect.Bottom, Left + Width, fRect.Top)
-  else
-    Result := Rect(bRect.Right, Top + 1, fRect.Left, Top + Height);
-end;
-//-------------------- GET Forward RECT -----------------------
-
-function TGLSMemoScrollBar.GetForwardRect: TRect;
-begin
-  if Kind = sbVertical then
-    Result := Rect(Left + 1, Top + Height - FButtonLength, Left + Width, Top +
-      Height)
-  else
-    Result := Rect(Left + Width - FButtonLength, Top + 1, Left + Width, Top +
-      Height);
-end;
-//-------------------- GET PAGE BACK RECT -----------------------
-
-function TGLSMemoScrollBar.GetPgBackRect: TRect;
-var
-  thRect: TRect;
-begin
-  thRect := GetThumbRect;
-  if thRect.Bottom = 0 then
-  begin
-    Result := Rect(0, 0, 0, 0);
-    Exit;
-  end;
-  if Kind = sbVertical then
-    Result := Rect(Left + 1, Top + FButtonLength, Left + Width, thRect.Top - 1)
-  else
-    Result := Rect(Left + FButtonLength, Top + 1, thRect.Left - 1, Top +
-      Height);
-end;
-//-------------------- GET PG FORWARD RECT -----------------------
-
-function TGLSMemoScrollBar.GetPgForwardRect: TRect;
-var
-  thRect: TRect;
-begin
-  thRect := GetThumbRect;
-  if thRect.Bottom = 0 then
-  begin
-    Result := Rect(0, 0, 0, 0);
-    Exit;
-  end;
-  if Kind = sbVertical then
-    Result := Rect(Left + 1, thRect.Bottom, Left + Width, Top + Height -
-      FButtonLength)
-  else
-    Result := Rect(thRect.Right, Top + 1, Left + Width - FButtonLength, Top +
-      Height);
-end;
-//-------------------- PAINT TO -----------------------
-
-procedure TGLSMemoScrollBar.PaintTo(ACanvas: TCanvas);
-var
-  sRect, mRect, gRect, thRect: TRect;
-  iconX, iconY, shift: integer;
-begin
-  with ACanvas do
-  begin
-    if Kind = sbVertical then
-    begin
-      Pen.Color := clSilver;
-      MoveTo(Left, Top);
-      LineTo(Left, Top + Height);
-
-      sRect := BackRect;
-      Brush.Color := clSilver;
-      FillRect(sRect);
-      if State = sbsBack then
-      begin
-        shift := 1;
-        Pen.Color := clGray;
-        with sRect do
-          Rectangle(Left, Top, Right, Bottom);
-      end
-      else
-      begin
-        shift := 0;
-        Border(ACanvas, sRect, btFlatRaised);
-      end;
-      iconX := sRect.Left + (Width - 1 - 7) div 2;
-      iconY := sRect.Top + (FButtonLength - 8) div 2;
-      Draw(iconX + shift, iconY + shift, bmScrollBarUp);
-
-      gRect := ForwardRect;
-      Brush.Color := clSilver;
-      FillRect(gRect);
-      if State = sbsForward then
-      begin
-        shift := 1;
-        Pen.Color := clGray;
-        with gRect do
-          Rectangle(Left, Top, Right, Bottom);
-      end
-      else
-      begin
-        shift := 0;
-        Border(ACanvas, gRect, btFlatRaised);
-      end;
-      iconX := gRect.Left + (Width - 1 - 7) div 2;
-      iconY := gRect.Top + (FButtonLength - 8) div 2;
-      Draw(iconX + shift, iconY + shift, bmScrollBarDown);
-
-      mRect := Rect(sRect.Left, sRect.Bottom, gRect.Right, gRect.Top);
-    end
-    else
-    begin
-      Pen.Color := clSilver;
-      MoveTo(Left, Top);
-      LineTo(Left + Width, Top);
-
-      sRect := BackRect;
-      Brush.Color := clSilver;
-      FillRect(sRect);
-      if State = sbsBack then
-      begin
-        shift := 1;
-        Pen.Color := clGray;
-        with sRect do
-          Rectangle(Left, Top, Right, Bottom);
-      end
-      else
-      begin
-        shift := 0;
-        Border(ACanvas, sRect, btFlatRaised);
-      end;
-      iconX := sRect.Left + shift + (FButtonLength - 8) div 2;
-      iconY := sRect.Top + shift + (Height - 1 - 7) div 2;
-      Draw(iconX + shift, iconY + shift, bmScrollBarLeft);
-
-      gRect := ForwardRect;
-      Brush.Color := clSilver;
-      FillRect(gRect);
-      if State = sbsForward then
-      begin
-        shift := 1;
-        Pen.Color := clGray;
-        with gRect do
-          Rectangle(Left, Top, Right, Bottom);
-      end
-      else
-      begin
-        shift := 0;
-        Border(ACanvas, gRect, btFlatRaised);
-      end;
-      iconX := gRect.Left + (FButtonLength - 8) div 2;
-      iconY := gRect.Top + (Height - 1 - 7) div 2;
-      Draw(iconX + shift, iconY + shift, bmScrollBarRight);
-
-      mRect := Rect(sRect.Right, sRect.Top, gRect.Left, gRect.Bottom);
-    end;
-
-    Brush.Bitmap := bmScrollBarFill;
-    FillRect(mRect);
-    Brush.Bitmap := nil;
-    if State = sbsPageBack then
-    begin
-      Brush.Color := clGray;
-      FillRect(PageBackRect);
-    end;
-    if State = sbsPageForward then
-    begin
-      Brush.Color := clGray;
-      FillRect(PageForwardRect);
-    end;
-
-    thRect := ThumbRect;
-    Brush.Color := clSilver;
-    FillRect(thRect);
-    Border(ACanvas, thRect, btFlatRaised);
-  end;
-end;
-//-------------------- SET STATE ----------
-
-procedure TGLSMemoScrollBar.SetState(Value: TsbState);
-begin
-  if FState <> Value then
-  begin
-    FState := Value;
-  end;
-end;
-//-------------------- MOUSE DOWN ------------
-
-function TGLSMemoScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
-  X,
-  Y: Integer):
-  Boolean;
-var
-  sRect, gRect, thRect, pbRect, pfRect: TRect;
-begin
-  Result := False;
-  if (Width = 0) or (Height = 0) then
-    Exit;
-  sRect := BackRect;
-  gRect := ForwardRect;
-  pbRect := PageBackRect;
-  pfRect := PageForwardRect;
-  thRect := ThumbRect;
-  if PointInRect(Point(X, Y), sRect) then
-  begin
-    State := sbsBack;
-    InvalidateRect(Parent.Handle, @sRect, True);
-    Result := True;
-    Exit;
-  end;
-  if PointInRect(Point(X, Y), gRect) then
-  begin
-    State := sbsForward;
-    InvalidateRect(Parent.Handle, @gRect, True);
-    Result := True;
-    Exit;
-  end;
-  if PointInRect(Point(X, Y), pbRect) then
-  begin
-    State := sbsPageBack;
-    InvalidateRect(Parent.Handle, @pbRect, True);
-    Result := True;
-    Exit;
-  end;
-  if PointInRect(Point(X, Y), pfRect) then
-  begin
-    State := sbsPageForward;
-    InvalidateRect(Parent.Handle, @pfRect, True);
-    Result := True;
-    Exit;
-  end;
-  if PointInRect(Point(X, Y), thRect) then
-  begin
-    State := sbsDragging;
-    FXOffset := X - thRect.Left;
-    FYOffset := Y - thRect.Top;
-    Result := True;
-    Exit;
-  end;
-
-end;
-//-------------------- MOUSE UP ----------
-
-function TGLSMemoScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
-  Y:
-  Integer):
-  Boolean;
-var
-  sRect, gRect, thRect, pbRect, pfRect: TRect;
-begin
-  Result := False;
-  if (Width = 0) or (Height = 0) then
-    Exit;
-  sRect := BackRect;
-  gRect := ForwardRect;
-  pbRect := PageBackRect;
-  pfRect := PageForwardRect;
-  thRect := ThumbRect;
-  case State of
-    sbsBack:
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @sRect, True);
-        FParent.DoScroll(Self, -1);
-        Result := True;
-        Exit;
-      end;
-    sbsForward:
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @gRect, True);
-        FParent.DoScroll(Self, 1);
-        Result := True;
-        Exit;
-      end;
-    sbsPageBack:
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @pbRect, True);
-        FParent.DoScrollPage(Self, -1);
-        Result := True;
-        Exit;
-      end;
-    sbsPageForward:
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @pfRect, True);
-        FParent.DoScrollPage(Self, 1);
-        Result := True;
-        Exit;
-      end;
-    sbsDragging:
-      begin
-        State := sbsWait;
-        Result := True;
-        Exit;
-      end;
-  end;
-end;
-//-------------------- MOUSE MOVE -----------
-
-function TGLSMemoScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer):
-  Boolean;
-var
-  sRect, gRect, thRect, pbRect, pfRect: TRect;
-begin
-  Result := False;
-  if (Width = 0) or (Height = 0) then
-    Exit;
-  sRect := BackRect;
-  gRect := ForwardRect;
-  pbRect := PageBackRect;
-  pfRect := PageForwardRect;
-  thRect := ThumbRect;
-  case State of
-    sbsBack:
-      if not PointInRect(Point(X, Y), sRect) then
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @sRect, True);
-        Result := True;
-        Exit;
-      end;
-    sbsForward:
-      if not PointInRect(Point(X, Y), gRect) then
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @gRect, True);
-        Result := True;
-        Exit;
-      end;
-    sbsPageBack:
-      if not PointInRect(Point(X, Y), pbRect) then
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @pbRect, True);
-        Result := True;
-        Exit;
-      end;
-    sbsPageForward:
-      if not PointInRect(Point(X, Y), pfRect) then
-      begin
-        State := sbsWait;
-        InvalidateRect(Parent.Handle, @pfRect, True);
-        Result := True;
-        Exit;
-      end;
-    sbsDragging:
-      begin
-        MoveThumbTo(X, Y);
-        Result := True;
-        Exit;
-      end;
-  end;
-end;
-//-------------------- MOVE THUMB TO ------------
-
-function TGLSMemoScrollBar.MoveThumbTo(X, Y: Integer): integer;
-var
-  thRect, mRect: TRect;
-  FreeLen, ThumbLen, NewPosition, NewOffset: integer;
-begin
-  thRect := ThumbRect;
-  mRect := MiddleRect;
-  NewOffset := 0;
-  FreeLen := 0;
-  ThumbLen := 0;
-  case Kind of
-    sbVertical:
-      begin
-        FreeLen := mRect.Bottom - mRect.Top;
-        ThumbLen := thRect.Bottom - thRect.Top;
-        NewOffset := Y - FYOffset - (Top + FButtonLength);
-      end;
-    sbHorizontal:
-      begin
-        FreeLen := mRect.Right - mRect.Left;
-        ThumbLen := thRect.Right - thRect.Left;
-        NewOffset := X - FXOffset - (Left + FButtonLength);
-      end
-  end;
-  NewPosition := round(NewOffset * MaxPosition / (FreeLen - ThumbLen));
-  Result := NewPosition - Position;
-  if NewPosition <> Position then
-  begin
-    Parent.DoScroll(Self, NewPosition - Position);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        GUTTER
-//--------------------------------------------------------------
-//-------------------- SET PARAMS -----------------------
-
-procedure TGLSMemoGutter.SetParams(Index: integer; Value: integer);
-begin
-  case Index of
-    0: FLeft := Value;
-    1: FTop := Value;
-    2: FWidth := Value;
-    3: FHeight := Value;
-  end;
-end;
-//-------------------- PAINT TO -----------------------
-
-procedure TGLSMemoGutter.PaintTo(ACanvas: TCanvas);
-var
-  LineNo, T, H: integer;
-begin
-  with ACanvas do
-  begin
-    Pen.Color := clGray;
-    MoveTo(Left + Width - 1, Top);
-    LineTo(Left + Width - 1, Top + Height);
-    Pen.Color := clWhite;
-    MoveTo(Left + Width - 2, Top);
-    LineTo(Left + Width - 2, Top + Height);
-    Brush.Color := Self.FColor;
-    FillRect(Rect(Left, Top, Left + Width - 2, Top + Height));
-    if Assigned(FMemo.OnGutterDraw) then
-    begin
-      T := Top;
-      H := FMemo.FCellSize.H;
-      LineNo := FMemo.FTopLine;
-      while T < Top + Height do
-      begin
-        FMemo.OnGutterDraw(FMemo, ACanvas, LineNo,
-          Rect(Left, T, Left + Width - 2, T + H));
-        T := T + H;
-        Inc(LineNo);
-        if LineNo >= FMemo.Lines.Count then
-          break;
-      end;
-    end;
-  end;
-end;
-
-//-------------------- INVALIDATE -----------------------
-
-procedure TGLSMemoGutter.Invalidate;
-var
-  gRect: TRect;
-begin
-  gRect := Rect(Left, Top, Left + Width, Top + Height);
-  InvalidateRect(FMemo.Handle, @gRect, True);
-end;
-
-//-------------------- GET RECT -----------------------
-
-function TGLSMemoGutter.GetRect: TRect;
-begin
-  Result := Rect(Left, Top, Left + Width, Top + Height);
-end;
-
- 
-
-// ---------------------TStyleList 
-
-procedure TStyleList.CheckRange(Index: integer);
-begin
-  if (Index < 0) or (Index >= Count) then
-    raise EListError.Create('Incorrect list item index ' + IntToStr(Index));
-end;
-//-------------------- DESTROY ---------------------------
-
-destructor TStyleList.Destroy;
-begin
-  Clear;
-  inherited;
-end;
-//-------------------- CHANGE ---------------------------
-
-procedure TStyleList.Change(Index: integer; ATextColor, ABkCOlor: TColor;
-  AStyle: TFontStyles);
-var
-  P: TCharStyle;
-begin
-  CheckRange(Index);
-  P := TCharStyle(Items[Index]);
-  P.TextColor := ATextColor;
-  P.BkColor := ABkColor;
-  P.Style := AStyle;
-end;
-//-------------------- ADD ---------------------------
-
-function TStyleList.Add(ATextColor, ABkColor: TColor; AStyle: TFontStyles):
-  Integer;
-var
-  P: TCharStyle;
-begin
-  P := TCharStyle.Create;
-  with P do
-  begin
-    TextColor := ATextColor;
-    BkColor := ABkColor;
-    Style := AStyle;
-  end;
-  Result := inherited Add(P);
-end;
-//-------------------- CLEAR ---------------------------
-
-procedure TStyleList.Clear;
-begin
-  while Count > 0 do
-    Delete(0);
-end;
-//-------------------- DELETE ---------------------------
-
-procedure TStyleList.Delete(Index: Integer);
-var
-  P: TCharStyle;
-begin
-  CheckRange(Index);
-  P := TCharStyle(Items[Index]);
-  P.Free;
-  inherited;
-end;
-//-------------------- GET/SET TEXT COLOR ---------------------------
-
-function TStyleList.GetTextColor(Index: Integer): TColor;
-begin
-  CheckRange(Index);
-  Result := TCharStyle(Items[Index]).TextColor;
-end;
-
-procedure TStyleList.SetTextColor(Index: Integer; Value: TColor);
-begin
-  CheckRange(Index);
-  TCharStyle(Items[Index]).TextColor := Value;
-end;
-//-------------------- GET/SET BK COLOR ---------------------------
-
-function TStyleList.GetBkColor(Index: Integer): TColor;
-begin
-  CheckRange(Index);
-  Result := TCharStyle(Items[Index]).BkColor;
-end;
-
-procedure TStyleList.SetBkColor(Index: Integer; Value: TColor);
-begin
-  CheckRange(Index);
-  TCharStyle(Items[Index]).BkColor := Value;
-end;
-//-------------------- GET/SET STYLE ---------------------------
-
-function TStyleList.GetStyle(Index: Integer): TFontStyles;
-begin
-  CheckRange(Index);
-  Result := TCharStyle(Items[Index]).Style;
-end;
-
-procedure TStyleList.SetStyle(Index: Integer; Value: TFontStyles);
-begin
-  CheckRange(Index);
-  TCharStyle(Items[Index]).Style := Value;
-end;
-
- 
-
-// ---------------------TGLSMemoStrings 
-
-destructor TGLSMemoStrings.Destroy;
-var
-  P: TObject;
-begin
-  while Count > 0 do
-  begin
-    P := inherited GetObject(0);
-    P.Free;
-    inherited Delete(0);
-  end;
-  inherited;
-end;
-//-------------------- CLEAR ----------------------
-
-procedure TGLSMemoStrings.Clear;
-begin
-  while Count > 0 do
-  begin
-    Delete(0);
-    if (Count = 1) and (Strings[0] = '') then
-      break;
-  end;
-end;
-
-//-------------------- ASSIGN ----------------------
-
-procedure TGLSMemoStrings.Assign(Source: TPersistent);
-var
-  P: TObject;
-begin
-  if Source is TStrings then
-  begin
-    BeginUpdate;
-    try
-      while Count > 0 do
-      begin
-        P := inherited GetObject(0);
-        P.Free;
-        inherited Delete(0);
-      end;
-      //      inherited Clear;
-      AddStrings(TStrings(Source));
-    finally
-      EndUpdate;
-    end;
-    Exit;
-  end;
-  inherited Assign(Source);
-end;
-
-//-------------------- ADD ----------------------
-
-function TGLSMemoStrings.DoAdd(const S: string): Integer;
-begin
-  Result := inherited AddObject(S, nil);
-end;
-//-------------------- ADD ----------------------
-
-function TGLSMemoStrings.Add(const S: string): Integer;
-begin
-  if Assigned(FMemo.Parent) then
-    Result := FMemo.AddString(S)
-  else
-    Result := DoAdd(S);
-end;
-//-------------------- OBJECT ----------------------
-
-function TGLSMemoStrings.AddObject(const S: string; AObject: TObject): Integer;
-begin
-  if AObject <> nil then
-    raise EInvalidOp.Create(SObjectsNotSupported);
-  Result := DoAdd(S);
-end;
-//-------------------- INSERT ----------------------
-
-procedure TGLSMemoStrings.InsertObject(Index: Integer;
-  const S: string; AObject: TObject);
-begin
-  if AObject <> nil then
-    raise EInvalidOp.Create(SObjectsNotSupported);
-  DoInsert(Index, S);
-end;
-//-------------------- DO INSERT ----------------------
-
-procedure TGLSMemoStrings.DoInsert(Index: Integer; const S: string);
-begin
-  InsertItem(Index, S, nil);
-end;
-//-------------------- INSERT ----------------------
-
-procedure TGLSMemoStrings.Insert(Index: Integer; const S: string);
-begin
-  if Assigned(FMemo) then
-    FMemo.InsertString(Index, S)
-  else
-    DoInsert(Index, S);
-end;
-//-------------------- DELETE ----------------------
-
-procedure TGLSMemoStrings.Delete(Index: Integer);
-var
-  P: TObject;
-begin
-  if (Index < 0) or (Index > Count - 1) then
-    Exit;
-  if FDeleting or (not Assigned(FMemo)) then
-  begin
-    P := inherited GetObject(Index);
-    P.Free;
-    inherited;
-  end
-  else
-  begin
-    FMemo.DeleteLine(Index, -1, -1, -1, -1, True);
-  end;
-end;
-//-------------------- LOAD FROM FILE ----------------------
-
-procedure TGLSMemoStrings.LoadFromFile(const FileName: string);
-begin
-  with FMemo do
-  begin
-    ClearSelection;
-    ClearUndoList;
-    CurX := 0;
-    CurY := 0;
-  end;
-  Clear;
-  inherited;
-  FMemo.Invalidate;
-end;
-//-------------------- SET UPDATE STATE ----------------------
-
-procedure TGLSMemoStrings.SetUpdateState(Updating: Boolean);
-begin
-  if Updating then
-    Inc(FLockCount)
-  else if FLockCount > 0 then
-    Dec(FLockCount);
-end;
-//-------------------- CHECK RANGE ---------------------------
-
-procedure TGLSMemoStrings.CheckRange(Index: integer);
-begin
-  if (Index < 0) or (Index >= Count) then
-    raise EListError('Incorrect index of list item ' + IntToStr(Index));
-end;
-//-------------------- GET OBJECT ---------------------------
-
-function TGLSMemoStrings.GetObject(Index: Integer): TObject;
-begin
-  CheckRange(Index);
-  Result := inherited GetObject(Index);
-  if Assigned(Result) and (Result is TLineProp) then
-    Result := TLineProp(Result).FObject;
-end;
-//-------------------- PUT OBJECT ---------------------------
-
-procedure TGLSMemoStrings.PutObject(Index: Integer; AObject: TObject);
-var
-  P: TObject;
-begin
-  CheckRange(Index);
-  P := Objects[Index];
-  if Assigned(P) and (P is TLineProp) then
-    TLineProp(P).FObject := AObject
-  else
-    inherited PutObject(Index, AObject);
-end;
-//-------------------- GET LINE PROP ---------------------------
-
-function TGLSMemoStrings.GetLineProp(Index: integer): TLineProp;
-var
-  P: TObject;
-begin
-  CheckRange(Index);
-  Result := nil;
-  P := inherited GetObject(Index);
-  if Assigned(P) and (P is TLineProp) then
-    Result := TLineProp(P);
-end;
-
-//-------------------- CREATE PROP --------------------------
-
-function TGLSMemoStrings.CreateProp(Index: integer): TLineProp;
-begin
-  Result := TLineProp.Create;
-  with Result do
-  begin
-    FStyleNo := 0;
-    FInComment := False;
-    FInBrackets := -1;
-    FValidAttrs := False;
-    FCharAttrs := '';
-    FObject := Objects[Index];
-  end;
-  inherited PutObject(Index, Result);
-end;
-
-//-------------------- GET LINE STYLE --------------------------
-
-function TGLSMemoStrings.GetLineStyle(Index: integer): integer;
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    Result := 0
-  else
-    Result := P.FStyleNo;
-end;
-
-//-------------------- SET LINE STYLE --------------------------
-
-procedure TGLSMemoStrings.SetLineStyle(Index: integer; Value: integer);
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    P := CreateProp(Index);
-  P.FStyleNo := Value;
-end;
-
-//-------------------- GET/SET IN COMMENT ---------------------------
-
-function TGLSMemoStrings.GetInComment(Index: Integer): Boolean;
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    Result := False
-  else
-    Result := P.FInComment;
-end;
-
-procedure TGLSMemoStrings.SetInComment(Index: Integer; Value: Boolean);
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    P := CreateProp(Index);
-  P.FInComment := Value;
-end;
-
-//-------------------- GET/SET IN BRACKETS ---------------------------
-
-function TGLSMemoStrings.GetInBrackets(Index: Integer): integer;
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    Result := -1
-  else
-    Result := P.FInBrackets;
-end;
-
-procedure TGLSMemoStrings.SetInBrackets(Index: Integer; Value: integer);
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    P := CreateProp(Index);
-  P.FInBrackets := Value;
-end;
-
-//-------------------- GET/SET VALID ATTRS ---------------------------
-
-function TGLSMemoStrings.GetValidAttrs(Index: Integer): Boolean;
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    Result := False
-  else
-    Result := P.FValidAttrs;
-end;
-
-procedure TGLSMemoStrings.SetValidAttrs(Index: Integer; Value: Boolean);
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    P := CreateProp(Index);
-  P.FValidAttrs := Value;
-end;
-//-------------------- GET/SET CHAR ATTRS ---------------------------
-
-function TGLSMemoStrings.GetCharAttrs(Index: Integer): string;
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    Result := ''
-  else
-    Result := P.FCharAttrs;
-end;
-
-procedure TGLSMemoStrings.SetCharAttrs(Index: Integer; const Value: string);
-var
-  P: TLineProp;
-begin
-  P := LineProp[Index];
-  if P = nil then
-    P := CreateProp(Index);
-  P.FCharAttrs := Value;
-end;
-
- 
-
-// ---------------------TGLSMemoUndo 
-
-constructor TGLSMemoUndo.Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
-  string);
-begin
-  inherited Create;
-  FUndoCurX0 := ACurX0;
-  FUndoCurY0 := ACurY0;
-  FUndoCurX := ACurX;
-  FUndoCurY := ACurY;
-  FUndoText := AText;
-end;
-
-procedure TGLSMemoUndo.Undo;
-begin
-  if Assigned(FMemo) then
-    with FMemo do
-    begin
-      CurY := FUndoCurY;
-      CurX := FUndoCurX;
-      PerformUndo;
-      CurY := FUndoCurY0;
-      CurX := FUndoCurX0;
-    end;
-end;
-
-procedure TGLSMemoUndo.Redo;
-begin
-  if Assigned(FMemo) then
-    with FMemo do
-    begin
-      CurY := FUndoCurY0;
-      CurX := FUndoCurX0;
-      PerformRedo;
-      CurY := FUndoCurY;
-      CurX := FUndoCurX;
-    end;
-end;
-
-function TGLSMemoUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
-begin
-  Result := False;
-end;
-
-//----------------  TINSERT CHAR UNDO --------------------------
-
-procedure TGLSMemoInsCharUndo.PerformUndo;
-var
-  i: integer;
-  CurrLine: string;
-begin
-  for i := Length(FUndoText) downto 1 do
-  begin
-    CurrLine := FMemo.Lines[FMemo.CurY];
-    if ((FUndoText[i] = #13) and (FMemo.CurX = 0)) or
-      (FUndoText[i] = CurrLine[FMemo.CurX]) then
-      FMemo.BackSpace;
-  end;
-end;
-
-procedure TGLSMemoInsCharUndo.PerformRedo;
-var
-  i: integer;
-begin
-  with FMemo do
-    for i := 1 to Length(FUndoText) do
-      if FUndoText[i] = #13 then
-        NewLine
-      else
-        InsertChar(FUndoText[i]);
-end;
-
-function TGLSMemoInsCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
-begin
-  Result := False;
-  if not ((NewUndo is TGLSMemoInsCharUndo) and
-    (NewUndo.UndoCurX0 = FUndoCurX) and
-    (NewUndo.UndoCurY0 = FUndoCurY)) then
-    Exit;
-  FUndoText := FUndoText + NewUndo.FUndoText;
-  FUndoCurX := NewUndo.UndoCurX;
-  FUndoCurY := NewUndo.UndoCurY;
-  Result := True;
-end;
-
-//----------------  TDELETE CHAR UNDO --------------------------
-
-procedure TGLSMemoDelCharUndo.PerformUndo;
-var
-  i: integer;
-begin
-  with FMemo do
-    for i := 1 to Length(FUndoText) do
-    begin
-      if not FIsBackspace then
-      begin
-        CurY := FUndoCurY0;
-        CurX := FUndoCurX0;
-      end;
-      if FUndoText[i] = #13 then
-        NewLine
-      else
-        InsertChar(FUndoText[i]);
-    end;
-end;
-
-procedure TGLSMemoDelCharUndo.PerformRedo;
-var
-  i: integer;
-begin
-  with FMemo do
-    for i := 1 to Length(FUndoText) do
-      if FIsBackspace then
-        BackSpace
-      else
-        DeleteChar(-1, -1);
-end;
-
-function TGLSMemoDelCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
-begin
-  Result := False;
-  if not ((NewUndo is TGLSMemoDelCharUndo) and
-    (NewUndo.UndoCurX0 = FUndoCurX) and
-    (NewUndo.UndoCurY0 = FUndoCurY)) then
-    Exit;
-  if TGLSMemoDelCharUndo(NewUndo).FIsBackspace <> FIsBackspace then
-    Exit;
-  FUndoText := NewUndo.FUndoText + FUndoText;
-  FUndoCurX := NewUndo.UndoCurX;
-  FUndoCurY := NewUndo.UndoCurY;
-  Result := True;
-end;
-
-//----------------  TDELETE BUF, LINE UNDO --------------------------
-
-constructor TGLSMemoDelLineUndo.Create(AIndex, ACurX0, ACurY0, ACurX, ACurY:
-  integer; const AText: string);
-begin
-  inherited Create(ACurX0, ACurY0, ACurX, ACurY, AText);
-  FIndex := AIndex;
-end;
-
-procedure TGLSMemoDelLineUndo.PerformUndo;
-var
-  SaveCurX: integer;
-begin
-  with FMemo do
-  begin
-    SaveCurX := CurX;
-    CurX := 0;
-    ClearSelection;
-    SetSelText(PChar(FUndoText + #13#10));
-    CurX := SaveCurX;
-  end;
-end;
-
-procedure TGLSMemoDelLineUndo.PerformRedo;
-begin
-  FMemo.DeleteLine(FIndex, FUndoCurX0, FUndoCurY0, FUndoCurX, FUndoCurY, True);
-end;
-
-procedure TGLSMemoDeleteBufUndo.PerformUndo;
-begin
-  with FMemo do
-  begin
-    ClearSelection;
-    SetSelText(PChar(FUndoText));
-  end;
-end;
-
-procedure TGLSMemoDeleteBufUndo.PerformRedo;
-begin
-  with FMemo do
-  begin
-    FSelStartX := FUndoSelStartX;
-    FSelStartY := FUndoSelStartY;
-    FSelEndX := FUndoSelEndX;
-    FSelEndY := FUndoSelEndY;
-    DeleteSelection(True);
-  end;
-end;
-
-//----------------  TPASTE UNDO --------------------------
-
-procedure TGLSMemoPasteUndo.PerformUndo;
-begin
-  with FMemo do
-  begin
-    FSelStartX := FUndoCurX0;
-    FSelStartY := FUndoCurY0;
-    FSelEndX := FUndoCurX;
-    FSelEndY := FUndoCurY;
-    DeleteSelection(True);
-  end;
-end;
-
-procedure TGLSMemoPasteUndo.PerformRedo;
-begin
-  with FMemo do
-  begin
-    ClearSelection;
-    SetSelText(PChar(FUndoText));
-  end;
-end;
-
-//----------------  TUNDO LIST --------------------------
-
-constructor TGLSMemoUndoList.Create;
-begin
-  inherited;
-  FPos := 0;
-  FIsPerforming := False;
-  FLimit := 100;
-end;
-
-destructor TGLSMemoUndoList.Destroy;
-begin
-  Clear;
-  inherited;
-end;
-
-function TGLSMemoUndoList.Get(Index: Integer): TGLSMemoUndo;
-begin
-  Result := TGLSMemoUndo(inherited Get(Index));
-end;
-
-function TGLSMemoUndoList.Add(Item: Pointer): Integer;
-begin
-  Result := -1;
-  if FIsPerforming then
-  begin
-    TGLSMemoUndo(Item).Free;
-    Exit;
-  end;
-
-  if (Count > 0) and
-    Items[0].Append(TGLSMemoUndo(Item)) then
-  begin
-    TGLSMemoUndo(Item).Free;
-    Exit;
-  end;
-
-  TGLSMemoUndo(Item).FMemo := Self.FMemo;
-  if FPos > 0 then
-    while FPos > 0 do
-    begin
-      Delete(0);
-      Dec(FPos);
-    end;
-  Insert(0, Item);
-  if Count > FLimit then
-    Delete(Count - 1);
-  Memo.UndoChange;
-  Result := 0;
-end;
-
-procedure TGLSMemoUndoList.Clear;
-begin
-  while Count > 0 do
-    Delete(0);
-  FPos := 0;
-  with Memo do
-    if not (csDestroying in ComponentState) then
-      UndoChange;
-end;
-
-procedure TGLSMemoUndoList.Delete(Index: Integer);
-begin
-  TGLSMemoUndo(Items[Index]).Free;
-  inherited;
-end;
-
-procedure TGLSMemoUndoList.Undo;
-var
-  OldAutoIndent: Boolean;
-begin
-  if FPos < Count then
-  begin
-    OldAutoIndent := Memo.AutoIndent;
-    Memo.AutoIndent := False;
-    FIsPerforming := True;
-    Items[FPos].Undo;
-    Inc(FPos);
-    FIsPerforming := False;
-    Memo.AutoIndent := OldAutoIndent;
-    Memo.UndoChange;
-  end;
-end;
-
-procedure TGLSMemoUndoList.Redo;
-var
-  OldAutoIndent: Boolean;
-begin
-  if FPos > 0 then
-  begin
-    OldAutoIndent := Memo.AutoIndent;
-    Memo.AutoIndent := False;
-    FIsPerforming := True;
-    Dec(FPos);
-    Items[FPos].Redo;
-    FIsPerforming := False;
-    Memo.AutoIndent := OldAutoIndent;
-    Memo.UndoChange;
-  end;
-end;
-
-procedure TGLSMemoUndoList.SetLimit(Value: integer);
-begin
-  if FLimit <> Value then
-  begin
-    if Value <= 0 then
-      Value := 10;
-    if Value > 0 then
-      Value := 100;
-    FLimit := Value;
-    Clear;
-  end;
-end;
-
-procedure TGLSSynHiMemo.Paint;
-begin
-  FIsPainting := True;
-  try
-    DelimiterStyle := FDelimiterStyle;
-    CommentStyle := FCommentStyle;
-    NumberStyle := FNumberStyle;
-    inherited;
-  finally
-    FIsPainting := False;
-  end;
-end;
-
- 
-
-// ---------------------TGLSSynHiMemo 
-
-procedure TGLSSynHiMemo.SetStyle(Index: integer; Value: TCharStyle);
-var
-  No: integer;
-  eRect: TRect;
-begin
-  No := -1;
-  case Index of
-    0: No := FDelimiterStyleNo;
-    1: No := FCommentStyleNo;
-    2: No := FNumberStyleNo;
-  end;
-  with Value do
-    Styles.Change(No, TextColor, BkColor, Style);
-  if not FIsPainting then
-  begin
-    eRect := EditorRect;
-    InvalidateRect(Handle, @eRect, True);
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - SET WORD LIST
-//--------------------------------------------------------------
-
-procedure TGLSSynHiMemo.SetWordList(Value: TGLSMemoStringList);
-begin
-  FWordList.Assign(Value);
-end;
-
-procedure TGLSSynHiMemo.SetSpecialList(Value: TGLSMemoStringList);
-begin
-  FSpecialList.Assign(Value);
-end;
-
-procedure TGLSSynHiMemo.SetBracketList(Value: TGLSMemoStringList);
-begin
-  FBracketList.Assign(Value);
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - SET CASE SENSITIVE
-//--------------------------------------------------------------
-
-procedure TGLSSynHiMemo.SetCaseSensitive(Value: Boolean);
-var
-  LineNo: integer;
-begin
-  if Value <> FCaseSensitive then
-  begin
-    FCaseSensitive := Value;
-    for LineNo := 0 to Lines.Count - 1 do
-      ValidAttrs[LineNo] := False;
-    Invalidate;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - GET TOKEN
-//--------------------------------------------------------------
-
-function TGLSSynHiMemo.GetToken(const S: string; var From: integer;
-  out TokenType: TTokenType; out StyleNo: integer): string;
-var
-  i, toStart, toEnd, Len, LenSpec: integer;
-  Done: Boolean;
-  Brackets: string;
-  IntPart: integer;
-  WasPoint: Boolean;
-  //-------------------------------------------------------------
-  function StartsFrom(const S: string; Pos: integer; const S0: string): Boolean;
-  begin
-    Result := (StrLComp(PChar(S) + Pos - 1, PChar(S0), Length(S0)) = 0);
-  end;
-  //-------------------------------------------------------------
-  function Equal(const s1, s2: string): Boolean;
-  begin
-    if FCaseSensitive then
-      Result := s1 = s2
-    else
-      Result := AnsiLowerCase(s1) = AnsiLowerCase(s2);
-  end;
-begin
-  toStart := From;
-  toEnd := From;
-  TokenType := ttOther;
-  StyleNo := 0;
-  Len := Length(S);
-  // End of line
-  if From > Len then
-  begin
-    From := -1;
-    Result := '';
-    TokenType := ttEOL;
-    StyleNo := 0;
-    Exit;
-  end;
-  // Begin of multiline comment
-  if (MultiCommentLeft <> '') and (MultiCommentRight <> '') and
-    StartsFrom(S, From, MultiCommentLeft) then
-  begin
-    Result := MultiCommentLeft;
-    FInComment := True;
-    TokenType := ttComment;
-    StyleNo := FCommentStyleNo;
-    Inc(From, Length(MultiCommentLeft));
-    Exit;
-  end;
-  // Inside multiline comment
-  if FInComment then
-  begin
-    toEnd := toStart;
-    while (toEnd <= Len) and (not StartsFrom(S, toEnd, MultiCommentRight)) do
-      Inc(toEnd);
-    if toEnd > Len then
-    begin
-      Result := Copy(S, From, toEnd - From);
-      From := toEnd;
-    end
-    else
-    begin
-      FInComment := False;
-      toEnd := toEnd + Length(MultiCommentRight);
-      Result := Copy(S, From, toEnd - From);
-      From := toEnd;
-    end;
-    TokenType := ttComment;
-    StyleNo := FCommentStyleNo;
-    Exit;
-  end;
-
-  // Inside brikets
-  if FInBrackets >= 0 then
-  begin
-    Brackets := FBracketList[FInBrackets];
-    toEnd := toStart + 1;
-    while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
-      Inc(toEnd);
-    StyleNo := integer(FBracketList.Objects[FInBrackets]);
-    if toEnd <= Len then
-    begin
-      FInBrackets := -1;
-      From := toEnd + 1;
-    end
-    else
-      From := toEnd;
-    Result := Copy(S, toStart, toEnd - toStart + 1);
-    TokenType := ttBracket;
-    Exit;
-  end;
-  // Spaces
-  while (toStart <= Len) and (S[toStart] = ' ') do
-    Inc(toStart);
-  if toStart > From then
-  begin
-    Result := Copy(S, From, toStart - From);
-    From := toStart;
-    TokenType := ttSpace;
-    StyleNo := 0;
-    Exit;
-  end;
-  // Comment
-  if (FLineComment <> '') and StartsFrom(S, From, FLineComment) then
-  begin
-    Result := Copy(S, From, Len);
-    From := Len + 1;
-    TokenType := ttComment;
-    StyleNo := FCommentStyleNo;
-    Exit;
-  end;
-
-  // Special keyword
-  Done := False;
-  for i := 0 to FSpecialList.Count - 1 do
-  begin
-    LenSpec := Length(FSpecialList[i]);
-    if StrLComp(PChar(S) + toStart - 1,
-      PChar(FSpecialList[i]), LenSpec) = 0 then
-    begin
-      toEnd := toStart + LenSpec - 1;
-      StyleNo := integer(FSpecialList.Objects[i]);
-      TokenType := ttSpecial;
-      From := toEnd + 1;
-      Done := True;
-      break;
-    end;
-  end;
-  // Brickets
-  if not Done then
-  begin
-    for i := 0 to FBracketList.Count - 1 do
-    begin
-      Brackets := FBracketList[i];
-      if S[toStart] = Brackets[1] then
-      begin
-        FInBrackets := i;
-        toEnd := toStart + 1;
-        while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
-          Inc(toEnd);
-        if toEnd <= Len then
-          FInBrackets := -1
-        else
-          Dec(toEnd);
-        StyleNo := integer(FBracketList.Objects[i]);
-        TokenType := ttBracket;
-        Done := True;
-        break;
-      end;
-    end;
-  end;
-  // Delimeters
-  if not Done and CharInSet(S[toStart], Delimiters) then
-  begin
-    toEnd := toStart;
-    StyleNo := FDelimiterStyleNo;
-    TokenType := ttDelimiter;
-    Done := True;
-  end;
-  // --- Integer or float type
-  if not Done and CharInSet(S[toStart], ['0'..'9', '.']) then
-  begin
-    IntPart := 0;
-    WasPoint := False;
-    toEnd := toStart;
-    Done := True;
-    TokenType := ttInteger;
-    StyleNo := FNumberStyleNo;
-    while (toEnd <= Len) and CharInSet(S[toEnd], ['0'..'9', '.']) do
-    begin
-      if S[toEnd] = '.' then
-      begin
-        if not WasPoint then
-        begin
-          WasPoint := True;
-          TokenType := ttFloat;
-        end
-        else
-        begin
-          TokenType := ttWrongNumber;
-          Color := clRed;
-        end;
-      end
-      else if not WasPoint then
-        try
-          IntPart := IntPart * 10 + Ord(S[toEnd]) - Ord('0');
-        except
-          IntPart := MaxInt;
-        end;
-      Inc(toEnd);
-    end;
-    Dec(toEnd);
-  end;
-  // Select word
-  if not Done then
-  begin
-    toEnd := toStart;
-    while (toEnd <= Len) and not CharInSet(S[toEnd], Delimiters) do
-      Inc(toEnd);
-    Dec(toEnd);
-  end;
-  // Find in dictionary
-  Result := Copy(S, toStart, toEnd - toStart + 1);
-  for i := 0 to FWordList.Count - 1 do
-    if Equal(Result, FWordList[i]) then
-    begin
-      StyleNo := integer(FWordList.Objects[i]);
-      TokenType := ttWord;
-      break;
-    end;
-  From := toEnd + 1;
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - FIND LINE ATTRS
-//--------------------------------------------------------------
-
-procedure TGLSSynHiMemo.FindLineAttrs(Sender: TObject; LineNo: integer;
-  var Attrs: string);
-var
-  i, From, TokenLen: integer;
-  S, Token: string;
-  TokenType: TTokenType;
-  StyleNo, OldInBrackets: integer;
-  OldInComment: Boolean;
-begin
-  S := Lines[LineNo];
-  SetLength(Attrs, Length(S));
-  FInComment := InComment[LineNo];
-  FInBrackets := InBrackets[LineNo];
-  From := 1;
-  while True do
-  begin
-    Token := GetToken(S, From, TokenType, StyleNo);
-    if TokenType = ttEOL then
-      break;
-    TokenLen := Length(Token);
-    for i := From - TokenLen to From - 1 do
-      Attrs[i] := Char(StyleNo);
-  end;
-  if LineNo < Lines.Count - 1 then
-  begin
-    OldInComment := InComment[LineNo + 1];
-    OldInBrackets := InBrackets[LineNo + 1];
-    if OldInComment <> FInComment then
-    begin
-      InComment[LineNo + 1] := FInComment;
-      ValidAttrs[LineNo + 1] := False;
-    end;
-    if OldInBrackets <> FInBrackets then
-    begin
-      InBrackets[LineNo + 1] := FInBrackets;
-      ValidAttrs[LineNo + 1] := False;
-    end;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - ADD WORD
-//--------------------------------------------------------------
-
-procedure TGLSSynHiMemo.AddWord(StyleNo: integer; const ArrS: array of string);
-var
-  i: integer;
-begin
-  for i := Low(ArrS) to high(ArrS) do
-    FWordList.AddObject(ArrS[i], TObject(StyleNo));
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - ADD SPECIAL
-//--------------------------------------------------------------
-
-procedure TGLSSynHiMemo.AddSpecial(StyleNo: integer; const ArrS: array of string);
-var
-  i: integer;
-begin
-  for i := Low(ArrS) to high(ArrS) do
-    FSpecialList.AddObject(ArrS[i], TObject(StyleNo));
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - ADD BRACKETS
-//--------------------------------------------------------------
-
-procedure TGLSSynHiMemo.AddBrackets(StyleNo: integer; const ArrS: array of string);
-var
-  i: integer;
-begin
-  for i := Low(ArrS) to high(ArrS) do
-    FBracketList.AddObject(ArrS[i], TObject(StyleNo));
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - CREATE
-//--------------------------------------------------------------
-
-constructor TGLSSynHiMemo.Create(AOwner: TComponent);
-begin
-  inherited;
-  FInBrackets := -1;
-  FIsPainting := False;
-  FInComment := False;
-  FWordList := TGLSMemoStringList.Create;
-  FSpecialList := TGLSMemoStringList.Create;
-  FBracketList := TGLSMemoStringList.Create;
-
-  FDelimiterStyle := TCharStyle.Create;
-  with FDelimiterStyle do
-  begin
-    TextColor := clBlue;
-    BkColor := clWhite;
-    Style := [];
-  end;
-
-  FCommentStyle := TCharStyle.Create;
-  with FCommentStyle do
-  begin
-    TextColor := clYellow;
-    BkColor := clSkyBlue;
-    Style := [fsItalic];
-  end;
-
-  FNumberStyle := TCharStyle.Create;
-  with FNumberStyle do
-  begin
-    TextColor := clNavy;
-    BkColor := clWhite;
-    Style := [fsBold];
-  end;
-
-  FDelimiterStyleNo := Styles.Add(clBlue, clWhite, []);
-  FCommentStyleNo := Styles.Add(clSilver, clWhite, [fsItalic]);
-  FNumberStyleNo := Styles.Add(clNavy, clWhite, [fsBold]);
-
-  OnGetLineAttrs := FindLineAttrs;
-  Delimiters := [' ', ',', ';', ':', '.', '(', ')', '{', '}', '[', ']',
-    '=', '+', '-', '*', '/', '^', '%', '<', '>',
-    '"', '''', #13, #10];
-end;
-
-//--------------------------------------------------------------
-//        SYNTAX MEMO - DESTROY
-//--------------------------------------------------------------
-
-destructor TGLSSynHiMemo.Destroy;
-begin
-  FWordList.Free;
-  FSpecialList.Free;
-  FBracketList.Free;
-  FDelimiterStyle.Free;
-  FCommentStyle.Free;
-  FNumberStyle.Free;
-  inherited;
-end;
-
- 
-
-// ---------------------TGLSMemoStringList 
-
-procedure TGLSMemoStringList.ReadStrings(Reader: TReader);
-var
-  i: Integer;
-begin
-  try
-    Reader.ReadListBegin;
-    Clear;
-    while not Reader.EndOfList do
-    begin
-      i := Add(Reader.ReadString);
-      Objects[i] := TObject(Reader.ReadInteger);
-    end;
-    Reader.ReadListEnd;
-  finally
-  end;
-end;
-
-//--------------------------------------------------------------
-//        STRING LIST - WRITE STRINGS
-//--------------------------------------------------------------
-
-procedure TGLSMemoStringList.WriteStrings(Writer: TWriter);
-var
-  i: Integer;
-begin
-  with Writer do
-  begin
-    WriteListBegin;
-    for i := 0 to Count - 1 do
-    begin
-      WriteString(Strings[i]);
-      WriteInteger(Integer(Objects[i]));
-    end;
-    WriteListEnd;
-  end;
-end;
-
-//--------------------------------------------------------------
-//        STRING LIST - DEFINE PROPERTIES
-//--------------------------------------------------------------
-
-procedure TGLSMemoStringList.DefineProperties(Filer: TFiler);
-begin
-  Filer.DefineProperty('Strings', ReadStrings, WriteStrings, Count > 0);
-end;
-
- 
-
-// ---------------------ScrollBar bitmaps 
-
-procedure CreateScrollBarBitmaps;
-var
-  i, j: integer;
-begin
-  bmScrollBarFill := TBitmap.Create;
-  with bmScrollBarFill, Canvas do
-  begin
-    Width := 8;
-    Height := 8;
-    Transparent := False;
-    for i := 0 to 7 do
-      for j := 0 to 7 do
-        if Odd(i + j) then
-          Pixels[i, j] := clSilver;
-  end;
-
-  bmScrollBarUp := TBitmap.Create;
-  with bmScrollBarUp, Canvas do
-  begin
-    Width := 7;
-    Height := 8;
-    Brush.Color := clSilver;
-    FillRect(Rect(0, 0, Width, Height));
-    Pixels[3, 2] := clBlack;
-    MoveTo(2, 3);
-    LineTo(5, 3);
-    MoveTo(1, 4);
-    LineTo(6, 4);
-    MoveTo(0, 5);
-    LineTo(7, 5);
-  end;
-
-  bmScrollBarDown := TBitmap.Create;
-  with bmScrollBarDown, Canvas do
-  begin
-    Width := 7;
-    Height := 8;
-    Brush.Color := clSilver;
-    FillRect(Rect(0, 0, Width, Height));
-    MoveTo(0, 2);
-    LineTo(7, 2);
-    MoveTo(1, 3);
-    LineTo(6, 3);
-    MoveTo(2, 4);
-    LineTo(5, 4);
-    Pixels[3, 5] := clBlack;
-  end;
-
-  bmScrollBarLeft := TBitmap.Create;
-  with bmScrollBarLeft, Canvas do
-  begin
-    Width := 8;
-    Height := 7;
-    Brush.Color := clSilver;
-    FillRect(Rect(0, 0, Width, Height));
-    Pixels[2, 3] := clBlack;
-    MoveTo(3, 2);
-    LineTo(3, 5);
-    MoveTo(4, 1);
-    LineTo(4, 6);
-    MoveTo(5, 0);
-    LineTo(5, 7);
-  end;
-
-  bmScrollBarRight := TBitmap.Create;
-  with bmScrollBarRight, Canvas do
-  begin
-    Width := 8;
-    Height := 7;
-    Brush.Color := clSilver;
-    FillRect(Rect(0, 0, Width, Height));
-    MoveTo(2, 0);
-    LineTo(2, 7);
-    MoveTo(3, 1);
-    LineTo(3, 6);
-    MoveTo(4, 2);
-    LineTo(4, 5);
-    Pixels[5, 3] := clBlack;
-  end;
-
-end;
-//------------------ FREE SCROLL BAR BITMAPs -------------------
-
-procedure FreeScrollBarBitmaps;
-begin
-  bmScrollBarFill.Free;
-  bmScrollBarUp.Free;
-  bmScrollBarDown.Free;
-  bmScrollBarLeft.Free;
-  bmScrollBarRight.Free;
-end;
-
- 
-
-initialization
-
-  RegisterClasses([TGLSSynHiMemo]);
-  CreateScrollBarBitmaps;
-  IntelliMouseInit;
-
-finalization
-  FreeScrollBarBitmaps;
-
-end.
-
+//
+// This unit is part of the GLScene Engine, http://glscene.org
+//
+
+unit GLS.Memo;
+
+(* Memo for GLScene *)
+
+interface
+
+{$I GLScene.inc}
+
+uses
+  WinApi.Windows,
+  WinApi.Messages,
+  System.SysUtils,
+  System.Classes,
+  System.UITypes,
+  VCL.Graphics,
+  VCL.Controls, 
+  VCL.Forms, 
+  VCL.Dialogs, 
+  VCL.ClipBrd,
+  VCL.StdCtrls, 
+  VCL.ExtCtrls;
+
+
+
+type
+  TBorderType = (btRaised, btLowered, btFlatRaised, btFlatLowered);
+  TCommand = Integer;
+
+  TCellSize = record
+    W, H: integer;
+  end;
+
+  TCellPos = record
+    X, Y: integer;
+  end;
+
+  TFullPos = record
+    LineNo, Pos: integer;
+  end;
+
+  TLineProp = class
+    FObject: TObject;
+    FStyleNo: integer;
+    FInComment: Boolean;
+    FInBrackets: integer;
+    FValidAttrs: Boolean;
+    FCharAttrs: string;
+  end;
+
+  TCharStyle = class(TPersistent)
+  private
+    FTextColor, FBkColor: TColor;
+    FStyle: TFontStyles;
+  published
+
+    property TextColor: TColor read FTextColor write FTextColor;
+    property BkColor: TColor read FBkColor write FBkColor;
+    property Style: TFontStyles read FStyle write FStyle;
+  end;
+
+  TStyleList = class(TList)
+  private
+    procedure CheckRange(Index: integer);
+    function GetTextColor(Index: Integer): TColor;
+    procedure SetTextColor(Index: Integer; Value: TColor);
+    function GetBkColor(Index: Integer): TColor;
+    procedure SetBkColor(Index: Integer; Value: TColor);
+    function GetStyle(Index: Integer): TFontStyles;
+    procedure SetStyle(Index: Integer; Value: TFontStyles);
+  protected
+    
+    property TextColor[Index: Integer]: TColor read GetTextColor write
+    SetTextColor;
+    property BkColor[Index: Integer]: TColor read GetBkColor write SetBkColor;
+    property Style[Index: Integer]: TFontStyles read GetStyle write SetStyle;
+  public
+    
+    destructor Destroy; override;
+    procedure Clear; override;
+    procedure Delete(Index: Integer);
+    function Add(ATextColor, ABkCOlor: TColor; AStyle: TFontStyles): Integer;
+    procedure Change(Index: integer; ATextColor, ABkColor: TColor; AStyle:
+      TFontStyles);
+  end;
+
+  TGLAbstractMemoObject = class(TObject)
+  public
+    function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
+      Boolean; virtual; abstract;
+    function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
+      Boolean; virtual; abstract;
+    function MouseMove(Shift: TShiftState; X, Y: Integer):
+      Boolean; virtual; abstract;
+  end;
+
+  TGLSMemoScrollBar = class;
+
+  TGLSMemoAbstractScrollableObject = class(TCustomControl)
+  protected
+    procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
+      virtual; abstract;
+    procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer);
+      virtual; abstract;
+  end;
+
+  TGLSCustomMemo = class;
+
+  TsbState =
+    (
+    sbsWait,
+    sbsBack,
+    sbsForward,
+    sbsPageBack,
+    sbsPageForward,
+    sbsDragging
+    );
+
+  TGLSMemoScrollBar = class(TGLAbstractMemoObject)
+  private
+    FKind: TScrollBarKind;
+    FParent: TGLSMemoAbstractScrollableObject;
+    FLeft, FTop, FWidth, FHeight: integer;
+    FTotal, FMaxPosition, FPosition: integer;
+    FButtonLength: integer;
+    FState: TsbState;
+    FXOffset, FYOffset: integer;
+    procedure SetParams(Index: integer; Value: integer);
+    procedure SetState(Value: TsbState);
+    function GetRect: TRect;
+    function GetThumbRect: TRect;
+    function GetBackRect: TRect;
+    function GetMiddleRect: TRect;
+    function GetForwardRect: TRect;
+    function GetPgBackRect: TRect;
+    function GetPgForwardRect: TRect;
+  public
+    constructor Create(AParent: TGLSMemoAbstractScrollableObject;
+      AKind: TScrollBarKind);
+    procedure PaintTo(ACanvas: TCanvas);
+    function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
+      Boolean; override;
+    function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
+      Boolean; override;
+    function MouseMove(Shift: TShiftState; X, Y: Integer):
+      Boolean; override;
+    function MoveThumbTo(X, Y: Integer): integer;
+    property Parent: TGLSMemoAbstractScrollableObject read FParent;
+    property Kind: TScrollBarKind read FKind write FKind;
+    property State: TsbState read FState write SetState;
+    property Left: integer index 0 read FLeft write SetParams;
+    property Top: integer index 1 read FTop write SetParams;
+    property Width: integer index 2 read FWidth write SetParams;
+    property Height: integer index 3 read FHeight write SetParams;
+    property Total: integer index 4 read FTotal write SetParams;
+    property MaxPosition: integer index 5 read FMaxPosition write SetParams;
+    property Position: integer index 6 read FPosition write SetParams;
+    property FullRect: TRect read GetRect;
+    property ThumbRect: TRect read GetThumbRect;
+    property BackRect: TRect read GetBackRect;
+    property MiddleRect: TRect read GetMiddleRect;
+    property ForwardRect: TRect read GetForwardRect;
+    property PageForwardRect: TRect read GetPgForwardRect;
+    property PageBackRect: TRect read GetPgBackRect;
+  end;
+
+  TGLSMemoStrings = class(TStringList)
+  private
+    FMemo: TGLSCustomMemo;
+    FLockCount: integer;
+    FDeleting: Boolean;
+    procedure CheckRange(Index: integer);
+    function GetLineProp(Index: integer): TLineProp;
+    procedure SetLineStyle(Index: integer; Value: integer);
+    function GetLineStyle(Index: integer): integer;
+    function GetInComment(Index: Integer): Boolean;
+    procedure SetInComment(Index: Integer; Value: Boolean);
+    function GetInBrackets(Index: Integer): integer;
+    procedure SetInBrackets(Index: Integer; Value: integer);
+    function GetValidAttrs(Index: Integer): Boolean;
+    procedure SetValidAttrs(Index: Integer; Value: Boolean);
+    function GetCharAttrs(Index: Integer): string;
+    procedure SetCharAttrs(Index: Integer; const Value: string);
+  protected
+    function GetObject(Index: Integer): TObject; override;
+    procedure PutObject(Index: Integer; AObject: TObject); override;
+    procedure SetUpdateState(Updating: Boolean); override;
+    function CreateProp(Index: integer): TLineProp;
+    property LineProp[Index: integer]: TLineProp read GetLineProp; //PALOFF
+    property Style[Index: integer]: integer read GetLineStyle write
+    SetLineStyle;
+    property InComment[Index: integer]: Boolean read GetInComment write
+    SetInComment;
+    property InBrackets[Index: integer]: integer read GetInBrackets write
+    SetInBrackets;
+    property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write
+    SetValidAttrs;
+    property CharAttrs[Index: integer]: string read GetCharAttrs write
+    SetCharAttrs;
+  public
+    destructor Destroy; override;
+    procedure Clear; override;
+    function DoAdd(const S: string): Integer;
+    function Add(const S: string): Integer; override;
+    function AddObject(const S: string; AObject: TObject): Integer; override;
+    procedure Assign(Source: TPersistent); override;
+    procedure Insert(Index: Integer; const S: string); override;
+    procedure DoInsert(Index: Integer; const S: string);
+    procedure InsertObject(Index: Integer; const S: string; AObject: TObject);
+      override;
+    procedure Delete(Index: Integer); override;
+    procedure LoadFromFile(const FileName: string); override;
+  end;
+
+  TGLSMemoGutter = class(TObject)
+  private
+    FMemo: TGLSCustomMemo;
+    FLeft, FTop, FWidth, FHeight: integer;
+    FColor: TColor;
+    procedure SetParams(Index: integer; Value: integer);
+    function GetRect: TRect;
+  protected
+    procedure PaintTo(ACanvas: TCanvas);
+    procedure Invalidate;
+  public
+    property Left: integer index 0 read FLeft write SetParams;
+    property Top: integer index 1 read FTop write SetParams;
+    property Width: integer index 2 read FWidth write SetParams;
+    property Height: integer index 3 read FHeight write SetParams;
+    property FullRect: TRect read GetRect;
+  end;
+
+  TGLSMemoUndo = class
+  private
+    FMemo: TGLSCustomMemo;
+    FUndoCurX0, FUndoCurY0: integer;
+    FUndoCurX, FUndoCurY: integer;
+    FUndoText: string;
+  public
+    constructor Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText: string);
+    function Append(NewUndo: TGLSMemoUndo): Boolean; virtual;
+    procedure Undo;
+    procedure Redo;
+    procedure PerformUndo; virtual; abstract;
+    procedure PerformRedo; virtual; abstract;
+    property UndoCurX0: integer read FUndoCurX0 write FUndoCurX0;
+    property UndoCurY0: integer read FUndoCurY0 write FUndoCurY0;
+    property UndoCurX: integer read FUndoCurX write FUndoCurX;
+    property UndoCurY: integer read FUndoCurY write FUndoCurY;
+  end;
+
+  TGLSMemoInsCharUndo = class(TGLSMemoUndo)
+  public
+    function Append(NewUndo: TGLSMemoUndo): Boolean; override;
+    procedure PerformUndo; override;
+    procedure PerformRedo; override;
+  end;
+
+  TGLSMemoDelCharUndo = class(TGLSMemoUndo)
+  private
+    FIsBackspace: Boolean;
+  public
+    function Append(NewUndo: TGLSMemoUndo): Boolean; override;
+    procedure PerformUndo; override;
+    procedure PerformRedo; override;
+    property IsBackspace: Boolean read FIsBackspace write FIsBackspace;
+  end;
+
+  TGLSMEmoDelLineUndo = class(TGLSMemoUndo)
+  private
+    FIndex: integer;
+  public
+    constructor Create(AIndex, ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
+      string);
+    procedure PerformUndo; override;
+    procedure PerformRedo; override;
+  end;
+
+  TGLSMemoSelUndo = class(TGLSMemoUndo)
+  private
+    FUndoSelStartX, FUndoSelStartY,
+      FUndoSelEndX, FUndoSelEndY: integer;
+  public
+    property UndoSelStartX: integer read FUndoSelStartX write FUndoSelStartX;
+    property UndoSelStartY: integer read FUndoSelStartY write FUndoSelStartY;
+    property UndoSelEndX: integer read FUndoSelEndX write FUndoSelEndX;
+    property UndoSelEndY: integer read FUndoSelEndY write FUndoSelEndY;
+  end;
+
+  TGLSMemoDeleteBufUndo = class(TGLSMemoSelUndo)
+  public
+    procedure PerformUndo; override;
+    procedure PerformRedo; override;
+  end;
+
+  TGLSMemoPasteUndo = class(TGLSMemoUndo)
+  public
+    procedure PerformUndo; override;
+    procedure PerformRedo; override;
+  end;
+
+  TGLSMemoUndoList = class(TList)
+  private
+    FPos: integer;
+    FMemo: TGLSCustomMemo;
+    FIsPerforming: Boolean;
+    FLimit: integer;
+  protected
+    function Get(Index: Integer): TGLSMemoUndo;
+    procedure SetLimit(Value: integer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Add(Item: Pointer): Integer;
+    procedure Clear; override;
+    procedure Delete(Index: Integer);
+    procedure Undo;
+    procedure Redo;
+    property Items[Index: Integer]: TGLSMemoUndo read Get; default;
+    property IsPerforming: Boolean read FIsPerforming write FIsPerforming;
+    property Memo: TGLSCustomMemo read FMemo write FMemo;
+    property Pos: integer read FPos write FPos;
+    property Limit: integer read FLimit write SetLimit;
+  end;
+
+  //--------------------------------------------------------------
+
+  TGutterClickEvent = procedure(Sender: TObject; LineNo: integer) of object;
+  TGutterDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+    LineNo: integer; rct: TRect) of object;
+  TGetLineAttrsEvent = procedure(Sender: TObject; LineNo: integer;
+    var Attrs: string) of object;
+  TUndoChangeEvent = procedure(Sender: TObject;
+    CanUndo, CanRedo: Boolean) of object;
+  TScrollMode = (smAuto, smStrict);
+
+  TGLSCustomMemo = class(TGLSMemoAbstractScrollableObject)
+  private
+    FAutoIndent: Boolean;
+    FMargin: integer;
+    FHiddenCaret, FCaretVisible: Boolean;
+    FCellSize: TCellSize;
+    FCurX, FCurY: integer;
+    FLeftCol, FTopLine: integer;
+    FTabSize: integer;
+    FFont: TFont;
+    FBkColor: TColor;
+    FSelColor: TColor;
+    FSelBkColor: TColor;
+    FReadOnly: Boolean;
+    FDelErase: Boolean;
+    FLines: TStrings;
+    FSelStartX, FSelStartY,
+      FSelEndX, FSelEndY,
+      FPrevSelX, FPrevSelY: integer;
+    FScrollBars: System.UITypes.TScrollStyle;
+    FScrollBarWidth: integer;
+    FGutter: TGLSMemoGutter;
+    FGutterWidth: integer;
+    sbVert, sbHorz: TGLSMemoScrollBar;
+    FStyles: TStyleList;
+    FLineBitmap: TBitmap;
+    FSelCharPos: TFullPos;
+    FSelCharStyle: integer;
+    FLeftButtonDown: Boolean;
+    FScrollMode: TScrollMode;
+    FUndoList: TGLSMemoUndoList;
+    FFirstUndoList: TGLSMemoUndoList;
+    FUndoLimit: integer;
+    FLastMouseUpX,
+      FLastMouseUpY: integer;
+    FAfterDoubleClick: Boolean;
+    // events
+    FOnMoveCursor: TNotifyEvent;
+    FOnChange: TNotifyEvent;
+    FOnAttrChange: TNotifyEvent;
+    FOnStatusChange: TNotifyEvent;
+    FOnSelectionChange: TNotifyEvent;
+    FOnGutterDraw: TGutterDrawEvent;
+    FOnGutterClick: TGutterClickEvent;
+    FOnGetLineAttrs: TGetLineAttrsEvent;
+    FOnUndoChange: TUndoChangeEvent;
+    FHideCursor: Boolean;
+    procedure SetHiddenCaret(Value: Boolean);
+    procedure SetScrollBars(Value: System.UITypes.TScrollStyle);
+    procedure SetGutterWidth(Value: integer);
+    procedure SetGutterColor(Value: TColor);
+    function GetGutterColor: TColor;
+    procedure SetCurX(Value: integer);
+    procedure SetCurY(Value: integer);
+    procedure SetFont(Value: TFont);
+    procedure SetColor(Index: integer; Value: TColor);
+    function GetSelStart: TPoint;
+    function GetSelEnd: TPoint;
+    procedure SetLines(ALines: TStrings);
+    procedure SetLineStyle(Index: integer; Value: integer);
+    function GetLineStyle(Index: integer): integer;
+    function GetInComment(Index: integer): Boolean;
+    procedure SetInComment(Index: integer; Value: Boolean);
+    function GetInBrackets(Index: Integer): integer;
+    procedure SetInBrackets(Index: Integer; Value: integer);
+    function GetValidAttrs(Index: integer): Boolean;
+    procedure SetValidAttrs(Index: integer; Value: Boolean);
+    function GetCharAttrs(Index: integer): string;
+    procedure SetCharAttrs(Index: integer; const Value: string);
+    procedure ExpandSelection;
+    function GetSelText: string;
+    procedure SetSelText(const AValue: string);
+    function GetSelLength: integer;
+    procedure MovePage(dP: integer; Shift: TShiftState);
+    procedure ShowCaret(State: Boolean);
+    procedure MakeVisible;
+    function GetVisible(Index: integer): integer;
+    function MaxLength: integer;
+    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
+    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
+    procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
+    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
+    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
+    procedure WMKillFocus(var Msg: TWMSetFocus); message WM_KILLFOCUS;
+    procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
+    procedure MoveCursor(dX, dY: integer; Shift: TShiftState);
+    procedure ResizeEditor;
+    procedure ResizeScrollBars;
+    procedure ResizeGutter;
+    procedure DoCommand(cmd: TCommand; const AShift: TShiftState);
+    procedure DrawLine(LineNo: integer);
+    function IsLineVisible(LineNo: integer): Boolean;
+    procedure FreshLineBitmap;
+    procedure SetUndoLimit(Value: integer);
+  protected
+    procedure WndProc(var Message: TMessage); override;
+    function EditorRect: TRect;
+    function LineRangeRect(FromLine, ToLine: integer): TRect;
+    function ColRangeRect(FromCol, ToCol: integer): TRect;
+    procedure InvalidateLineRange(FromLine, ToLine: integer);
+    function AddString(const S: string): integer;
+    procedure InsertString(Index: integer; S: string);
+    procedure GoHome(Shift: TShiftState);
+    procedure GoEnd(Shift: TShiftState);
+    procedure InsertChar(C: Char);
+    procedure DeleteChar(OldX, OldY: integer);
+    procedure DeleteLine(Index, OldX, OldY, NewX, NewY: integer; FixUndo: Boolean);
+    procedure BackSpace;
+    procedure BackSpaceWord;
+    function IndentCurrLine: string;
+    procedure NewLine;
+    procedure CreateParams(var Params: TCreateParams); override;
+    procedure Paint; override;
+    procedure DrawMargin;
+    procedure DrawGutter;
+    procedure DrawScrollBars;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure KeyPress(var Key: Char); override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure DblClick; override;
+    procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer); override;
+    procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer); override;
+    property VisiblePosCount: integer index 0 read GetVisible;
+    property VisibleLineCount: integer index 1 read GetVisible;
+    property LastVisiblePos: integer index 2 read GetVisible;
+    property LastVisibleLine: integer index 3 read GetVisible;
+    procedure DeleteSelection(bRepaint: Boolean);
+    procedure Changed(FromLine, ToLine: integer); virtual;
+    procedure AttrChanged(LineNo: integer); virtual;
+    procedure SelectionChanged; virtual;
+    procedure StatusChanged; virtual;
+    procedure ClearUndoList;
+    procedure UndoChange;
+    property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
+    property GutterWidth: integer read FGutterWidth write SetGutterWidth;
+    property GutterColor: TColor read GetGutterColor write SetGutterColor;
+    property ScrollBars: System.UITypes.TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
+    property Font: TFont read FFont write SetFont;
+    property ReadOnly: Boolean read FReadOnly write FReadOnly;
+    property Lines: TStrings read FLines write SetLines;
+    property BkColor: TColor index 0 read FBkColor write SetColor;
+    property SelColor: TColor index 1 read FSelColor write SetColor;
+    property SelBkColor: TColor index 2 read FSelBkColor write SetColor;
+    property HiddenCaret: Boolean read FHiddenCaret write SetHiddenCaret;
+    property TabSize: integer read FTabSize write FTabSize;
+    property ScrollMode: TScrollMode read FScrollMode write FScrollMode default smAuto;
+    property UndoLimit: integer read FUndoLimit write SetUndoLimit;
+    property HideCursor: Boolean read FHideCursor write FHideCursor;
+    property InComment[Index: integer]: Boolean read GetInComment write SetInComment;
+    property InBrackets[Index: integer]: integer read GetInBrackets write SetInBrackets;
+    property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write SetValidAttrs;
+    property CharAttrs[Index: integer]: string read GetCharAttrs write SetCharAttrs;
+    {events}
+    property OnGutterClick: TGutterClickEvent read FOnGutterClick write FOnGutterClick;
+    property OnGutterDraw: TGutterDrawEvent read FOnGutterDraw write FOnGutterDraw;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnMoveCursor: TNotifyEvent read FOnMoveCursor write FOnMoveCursor;
+    property OnAttrChange: TNotifyEvent read FOnAttrChange write FOnAttrChange;
+    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
+    property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
+    property OnGetLineAttrs: TGetLineAttrsEvent read FOnGetLineAttrs write FOnGetLineAttrs;
+    property OnUndoChange: TUndoChangeEvent read FOnUndoChange write FOnUndoChange;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure CopyToClipBoard;
+    procedure PasteFromClipBoard;
+    procedure CutToClipBoard;
+    procedure SelectLines(StartLine, EndLine: Integer);
+    procedure SelectAll;
+    property SelStart: TPoint read GetSelStart;
+    property SelEnd: TPoint read GetSelEnd;
+    property Selection: string read GetSelText write SetSelText;
+    property SelLength: integer read GetSelLength;
+    procedure ClearSelection;
+    procedure Clear;
+    procedure SetCursor(ACurX, ACurY: Integer);
+    function SelectLine(LineNo, StyleNo: Integer): integer;
+    procedure SelectChar(LineNo, Pos, StyleNo: Integer);
+    function CellFromPos(X, Y: integer): TCellPos;
+    function CharFromPos(X, Y: integer): TFullPos;
+    function CellRect(ACol, ARow: integer): TRect;
+    function LineRect(ARow: integer): TRect;
+    function ColRect(ACol: integer): TRect;
+    function CharStyleNo(LineNo, Pos: integer): integer;
+    procedure InsertTemplate(AText: string);
+    procedure UnSelectChar;
+    procedure Undo;
+    procedure Redo;
+    function CanUndo: Boolean;
+    function CanRedo: Boolean;
+    function FindText(Text: string; Options: TFindOptions; Select: Boolean): Boolean;
+    property CurX: integer read FCurX write SetCurX;
+    property CurY: integer read FCurY write SetCurY;
+    property DelErase: Boolean read FDelErase write FDelErase;
+    property LineStyle[Index: integer]: integer read GetLineStyle write
+    SetLineStyle;
+    property Styles: TStyleList read FStyles;
+    property UndoList: TGLSMemoUndoList read FUndoList write FUndoList;
+  end;
+
+  TGLSMemo = class(TGLSCustomMemo)
+  published
+    {TControl }
+    property PopupMenu;
+    {TCustomControl }
+    property Align;
+    property Enabled;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    property ReadOnly;
+    {TGLSCustomMemo }
+    property AutoIndent;
+    property GutterColor;
+    property GutterWidth;
+    property ScrollBars;
+    property Font;
+    property BkColor;
+    property Selection;
+    property SelColor;
+    property SelBkColor;
+    property Lines;
+    property HiddenCaret;
+    property TabSize;
+    property ScrollMode;
+    property UndoLimit;
+    property DelErase;
+    {Inherited events }
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnStartDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    {Events }
+    property OnGutterDraw;
+    property OnGutterClick;
+    property OnChange;
+    property OnMoveCursor;
+    property OnAttrChange;
+    property OnSelectionChange;
+    property OnStatusChange;
+    property OnGetLineAttrs;
+    property OnUndoChange;
+  end;
+
+  TGLSMemoStringList = class(TStringList)
+  private
+    procedure ReadStrings(Reader: TReader);
+    procedure WriteStrings(Writer: TWriter);
+  protected
+    procedure DefineProperties(Filer: TFiler); override;
+  end;
+
+  TDelimiters = TSysCharSet;
+  TTokenType =
+    (
+    ttWord,
+    ttBracket,
+    ttSpecial,
+    ttDelimiter,
+    ttSpace,
+    ttEOL,
+    ttInteger,
+    ttFloat,
+    ttComment,
+    ttOther,
+    ttWrongNumber);
+
+  //--------------------------------------------------------------
+  //        SYNTAX MEMO - declaration
+  //--------------------------------------------------------------
+  TGLSSynHiMemo = class(TGLSCustomMemo)
+  private
+
+    FIsPainting: Boolean;
+    FInComment: Boolean;
+
+    FWordList: TGLSMemoStringList;
+    FSpecialList: TGLSMemoStringList;
+    FBracketList: TGLSMemoStringList;
+    FDelimiters: TDelimiters;
+    FInBrackets: integer;
+    FLineComment: string;
+    FMultiCommentLeft: string;
+    FMultiCommentRight: string;
+    FDelimiterStyle: TCharStyle;
+    FCommentStyle: TCharStyle;
+    FNumberStyle: TCharStyle;
+    FDelimiterStyleNo,
+      FCommentStyleNo,
+      FNumberStyleNo: integer;
+    FCaseSensitive: Boolean;
+    function GetToken(const S: string; var From: integer;
+      out TokenType: TTokenType; out StyleNo: integer): string;
+    procedure SetWordList(Value: TGLSMemoStringList);
+    procedure SetSpecialList(Value: TGLSMemoStringList);
+    procedure SetBracketList(Value: TGLSMemoStringList);
+    procedure FindLineAttrs(Sender: TObject; LineNo: integer; var Attrs:
+      string);
+    procedure SetStyle(Index: integer; Value: TCharStyle);
+    procedure SetCaseSensitive(Value: Boolean);
+  protected
+    procedure Paint; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure AddWord(StyleNo: integer; const ArrS: array of string);
+    procedure AddSpecial(StyleNo: integer; const ArrS: array of string);
+    procedure AddBrackets(StyleNo: integer; const ArrS: array of string);
+    property Delimiters: TDelimiters read FDelimiters write FDelimiters;
+  published
+    {TControl}
+    property PopupMenu;
+    {TCustomControl}
+    property Align;
+    property Enabled;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    property ReadOnly;
+    {TGLSCustomMemo}
+    property AutoIndent;
+    property GutterColor;
+    property GutterWidth;
+    property ScrollBars;
+    property Font;
+    property BkColor;
+    property SelColor;
+    property SelBkColor;
+    property Lines;
+    property HiddenCaret;
+    property TabSize;
+    property ScrollMode;
+    property UndoLimit;
+    property DelErase;
+    {Inherited events }
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnStartDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    {Events }
+    property OnGutterClick;
+    property OnGutterDraw;
+    property OnChange;
+    property OnMoveCursor;
+    property OnSelectionChange;
+    property OnStatusChange;
+    property OnUndoChange;
+    {TGLSSyntaxMemo }
+    property LineComment: string read FLineComment write FLineComment;
+    property MultiCommentLeft: string read FMultiCommentLeft write FMultiCommentLeft;
+    property MultiCommentRight: string read FMultiCommentRight write FMultiCommentRight;
+    property WordList: TGLSMemoStringList read FWordList write SetWordList;
+    property SpecialList: TGLSMemoStringList read FSpecialList write SetSpecialList;
+    property BracketList: TGLSMemoStringList read FBracketList write SetBracketList;
+    property DelimiterStyle: TCharStyle index 0 read FDelimiterStyle write SetStyle;
+    property CommentStyle: TCharStyle index 1 read FCommentStyle write SetStyle;
+    property NumberStyle: TCharStyle index 2 read FNumberStyle write SetStyle;
+    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
+  end;
+
+procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
+
+//==========================================================
+implementation
+//==========================================================
+
+const
+  cmDelete = VK_DELETE;
+  cmBackSpace = VK_BACK;
+  cmWordBackSpace = 127; // Ctrl-BackSpace
+  cmNewLine = VK_RETURN;
+  cmHome = VK_HOME;
+  cmEnd = VK_END;
+  cmPageUp = VK_PRIOR;
+  cmPageDown = VK_NEXT;
+  cmInsert = VK_INSERT;
+  cmDelLine = 25; // Ctrl-Y
+  cmCopy = 3; // Ctrl-C
+  cmCut = 24; // Ctrl-X
+  cmPaste = 22; // Ctrl-V
+
+resourcestring
+  SObjectsNotSupported = 'Linked object not supported';
+
+var
+  bmScrollBarFill: TBitmap;
+  bmScrollBarUp: TBitmap;
+  bmScrollBarDown: TBitmap;
+  bmScrollBarLeft: TBitmap;
+  bmScrollBarRight: TBitmap;
+
+  fIntelliWheelSupport: Boolean; // True if IntelliMouse + wheel enabled
+  fIntelliMessage: UINT; // message sent from mouse on wheel roll
+  fIntelliScrollLines: Integer; // number of lines to scroll per wheel roll
+
+// ---------------------Helper functions 
+
+function PointInRect(const P: TPoint; const rct: TRect): Boolean; inline;
+begin
+  with rct do
+    Result := (Left <= P.X) and (Top <= P.Y) and
+      (Right >= P.X) and (Bottom >= P.Y);
+end;
+
+procedure Swap(var I1, I2: integer); inline;
+var
+  temp: integer;
+begin
+  temp := I1;
+  I1 := I2;
+  I2 := temp;
+end;
+
+procedure OrderPos(var StartX, StartY, EndX, EndY: integer); inline;
+begin
+  if (EndY < StartY) or
+    ((EndY = StartY) and (EndX < StartX)) then
+  begin
+    Swap(StartX, EndX);
+    Swap(StartY, EndY);
+  end;
+end;
+
+function TotalRect(const rct1, rct2: TRect): TRect; inline;
+begin
+  Result := rct1;
+  with Result do
+  begin
+    if rct2.Left < Left then
+      Left := rct2.Left;
+    if rct2.Top < Top then
+      Top := rct2.Top;
+    if rct2.Right > Right then
+      Right := rct2.Right;
+    if rct2.Bottom > Bottom then
+      Bottom := rct2.Bottom;
+  end;
+end;
+
+
+
+// ---------------------TGLSCustomMemo functions
+
+procedure TGLSCustomMemo.WndProc(var Message: TMessage);
+  function GetShiftState: Integer;
+  begin
+    Result := 0;
+    if GetAsyncKeyState(vk_Shift) < 0 then
+      Result := Result or mk_Shift;
+    if GetAsyncKeyState(vk_Control) < 0 then
+      Result := Result or mk_Control;
+    if GetAsyncKeyState(vk_LButton) < 0 then
+      Result := Result or mk_LButton;
+    if GetAsyncKeyState(vk_RButton) < 0 then
+      Result := Result or mk_RButton;
+    if GetAsyncKeyState(vk_MButton) < 0 then
+      Result := Result or mk_MButton;
+  end;
+  //---------------------------------------------------
+begin
+  if (Message.Msg = fIntelliMessage) and (fIntelliMessage <> wm_MouseWheel) then
+  begin
+    PostMessage(Handle, wm_MouseWheel, MakeLong(GetShiftState, Message.wParam),
+      Message.lParam);
+  end
+  else
+    inherited;
+end;
+
+//------------------------------------------------
+//    INTELLIMOUSE INIT
+//------------------------------------------------
+
+procedure IntelliMouseInit;
+var
+  hWndMouse: hWnd;
+  mQueryScrollLines: UINT;
+  //--------------------------------------------
+  function NativeMouseWheelSupport: Boolean;
+  var
+    ver: TOSVersionInfo;
+  begin
+    Result := False;
+    ver.dwOSVersionInfoSize := sizeof(ver);
+    // For Windows 98, assume dwMajorVersion = 5 (It's 4 for W95)
+    // For NT, we need 4.0 or better.
+    if GetVersionEx(ver) then
+      case ver.dwPlatformID of
+        ver_Platform_Win32_Windows: Result := ver.dwMajorVersion >= 5;
+        ver_Platform_Win32_NT: Result := ver.dwMajorVersion >= 4;
+      end;
+    { Quick and dirty temporary hack for Windows 98 beta 3 }
+    if (not Result) and (ver.szCSDVersion = ' Beta 3') then
+      Result := True;
+  end;
+  //--------------------------------------------
+begin
+  if NativeMouseWheelSupport then
+  begin
+    fIntelliWheelSupport := Boolean(GetSystemMetrics(sm_MouseWheelPresent));
+    SystemParametersInfo(spi_GetWheelScrollLines, 0, @fIntelliScrollLines, 0);
+    fIntelliMessage := wm_MouseWheel;
+  end
+  else
+  begin
+    { Look for hidden mouse window }
+    hWndMouse := FindWindow('MouseZ', 'Magellan MSWHEEL');
+    if hWndMouse <> 0 then
+    begin
+      { We're in business - get the scroll line info }
+      fIntelliWheelSupport := True;
+      mQueryScrollLines := RegisterWindowMessage('MSH_SCROLL_LINES_MSG');
+      fIntelliScrollLines := SendMessage(hWndMouse, mQueryScrollLines, 0, 0);
+      { Finally, get the custom mouse message as well }
+      fIntelliMessage := RegisterWindowMessage('MSWHEEL_ROLLMSG');
+    end;
+  end;
+  if (fIntelliScrollLines < 0) or (fIntelliScrollLines > 100) then
+    fIntelliScrollLines := 3;
+end;
+
+//------------------------------------------------
+//    WM MOUSE WHEEL
+//------------------------------------------------
+
+procedure TGLSCustomMemo.WMMouseWheel(var Message: TMessage);
+{$J+}
+{$IFOPT R+} {$DEFINE StoreRangeCheck} {$ENDIF} {$R-}
+const
+  Delta: SmallInt = 0;
+begin
+  Delta := Delta + SmallInt(HiWord(Message.wParam));
+  while Abs(Delta) >= 120 do
+  begin
+    if Delta < 0 then
+    begin
+      DoScroll(sbVert, fIntelliScrollLines);
+      Delta := Delta + 120;
+    end
+    else
+    begin
+      DoScroll(sbVert, -fIntelliScrollLines);
+      Delta := Delta - 120;
+    end;
+  end;
+end;
+{$J-}
+{$IFDEF StoreRangeCheck} {$R+} {$UNDEF StoreRangeCheck} {$ENDIF}
+
+//--------------------------------------------------------------
+//        SET CURSOR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetCursor(ACurX, ACurY: Integer);
+begin
+  ClearSelection;
+  CurX := 0;
+  CurY := ACurY;
+  CurX := ACurX;
+end;
+
+//--------------------------------------------------------------
+//        SELECT LINE, CHAR
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.SelectLine(LineNo, StyleNo: Integer): integer;
+var
+  rct: TRect;
+begin
+  Result := LineStyle[LineNo];
+  LineStyle[LineNo] := StyleNo;
+  rct := LineRect(LineNo);
+  InvalidateRect(Handle, @rct, True);
+end;
+
+procedure TGLSCustomMemo.SelectLines(StartLine, EndLine: Integer);
+var
+  rct: TRect;
+begin
+  FSelStartX := 0;
+  FSelStartY := StartLine;
+  FSelEndX := Length(Lines[EndLine]);
+  FSelEndY := EndLine;
+  rct := LineRangeRect(FSelStartY, FSelEndY);
+  SelectionChanged;
+  InvalidateRect(Handle, @rct, true);
+end;
+
+procedure TGLSCustomMemo.SelectChar(LineNo, Pos, StyleNo: Integer);
+var
+  rct: TRect;
+begin
+  UnselectChar;
+  FSelCharPos.LineNo := LineNo;
+  FSelCharPos.Pos := Pos;
+  FSelCharStyle := StyleNo;
+  rct := LineRect(LineNo);
+  InvalidateRect(Handle, @rct, True);
+end;
+
+procedure TGLSCustomMemo.UnSelectChar;
+var
+  rct: TRect;
+begin
+  with FSelCharPos do
+  begin
+    if LineNo < 0 then
+      Exit;
+    rct := LineRect(LineNo);
+    LineNo := -1;
+    Pos := -1;
+  end;
+  FSelCharStyle := -1;
+  InvalidateRect(Handle, @rct, True);
+end;
+
+//--------------------------------------------------------------
+//        CLEAR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.Clear;
+begin
+  CurY := 0;
+  CurX := 0;
+  FLeftCol := 0;
+  FTopLine := 0;
+  Lines.Clear;
+  TGLSMemoStrings(Lines).DoAdd('');
+  ClearUndoList;
+  Invalidate;
+end;
+
+//--------------------------------------------------------------
+//        SELECT ALL
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SelectAll;
+begin
+  FSelStartY := 0;
+  FSelStartX := 0;
+  FSelEndY := Lines.Count - 1;
+  FSelEndX := Length(Lines[Lines.Count - 1]);
+  Invalidate;
+end;
+
+//-----------------------------------------------------------
+//   SET CLIPBOARD CODE PAGE
+//-----------------------------------------------------------
+
+procedure SetClipboardCodePage(const CodePage: longint);
+var
+  Data: THandle;
+  DataPtr: Pointer;
+begin
+  // Define new code page for clipboard
+  Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, 4);
+  try
+    DataPtr := GlobalLock(Data);
+    try
+      Move(CodePage, DataPtr^, 4);
+      SetClipboardData(CF_LOCALE, Data);
+    finally
+      GlobalUnlock(Data);
+    end;
+  except
+    GlobalFree(Data);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        COPY TO CLIPBOARD
+//--------------------------------------------------------------
+
+procedure CopyStringToClipboard(const Value: string);
+const
+  RusLocale = (SUBLANG_DEFAULT shl $A) or LANG_RUSSIAN;
+begin
+  Clipboard.Open;
+  SetClipboardCodePage(RusLocale);
+  try
+    Clipboard.AsText := Value;
+  finally
+    SetClipboardCodePage(RusLocale);
+    Clipboard.Close;
+  end;
+end;
+
+procedure TGLSCustomMemo.CopyToClipBoard;
+begin
+  CopyStringToClipboard(GetSelText);
+end;
+//--------------------------------------------------------------
+//        PASTE FROM CLIPBOARD
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.PasteFromClipBoard;
+var
+  H, len: integer;
+  Buff: string;
+begin
+  H := ClipBoard.GetAsHandle(CF_TEXT);
+  len := GlobalSize(H);
+  if len = 0 then
+    Exit;
+
+  SetLength(Buff, len);
+  SetLength(Buff, ClipBoard.GetTextBuf(PChar(Buff), len));
+  AdjustLineBreaks(Buff);
+
+  SetSelText(Buff);
+end;
+
+//--------------------------------------------------------------
+//        DELETE SELECTION
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DeleteSelection(bRepaint: Boolean);
+var
+  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
+  i, len: integer;
+  OldX, OldY: integer;
+  S1, S2, S, AddSpaces: string;
+  Undo: TGLSMemoDeleteBufUndo;
+begin
+  if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
+    Exit;
+
+  OldX := CurX;
+  OldY := CurY;
+  xSelStartX := FSelStartX;
+  xSelStartY := FSelStartY;
+  xSelEndX := FSelEndX;
+  xSelEndY := FSelEndY;
+  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
+
+  if xSelStartY = xSelEndY then
+  begin
+    S1 := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX);
+    S2 := '';
+    AddSpaces := '';
+  end
+  else
+  begin
+    len := Length(Lines[xSelStartY]);
+    S1 := Copy(Lines[xSelStartY], xSelStartX + 1, len);
+    AddSpaces := StringOfChar(' ', xSelStartX - len);
+    S2 := Copy(Lines[xSelEndY], 1, xSelEndX);
+  end;
+  Lines[xSelStartY] := Copy(Lines[xSelStartY], 1, xSelStartX) + AddSpaces +
+    Copy(Lines[xSelEndY], xSelEndX + 1, Length(Lines[xSelEndY]));
+  S := S1;
+  for i := xSelStartY + 1 to xSelEndY do
+  begin
+    S := S + #13#10;
+    if i <> xSelEndY then
+      S := S + Lines[xSelStartY + 1];
+    DeleteLine(xSelStartY + 1, -1, -1, -1, -1, False);
+  end;
+  S := S + S2;
+
+  CurY := xSelStartY;
+  CurX := xSelStartX;
+  ClearSelection;
+
+  Changed(xSelStartY, -1);
+  SelectionChanged;
+  if bRepaint then
+    Invalidate;
+
+  Undo := TGLSMemoDeleteBufUndo.Create(OldX, OldY, CurX, CurY, S);
+  Undo.UndoSelStartX := xSelStartX;
+  Undo.UndoSelStartY := xSelStartY;
+  Undo.UndoSelEndX := xSelEndX;
+  Undo.UndoSelEndY := xSelEndY;
+  if Assigned(FUndoList) then
+    FUndoList.Add(Undo);
+end;
+
+//--------------------------------------------------------------
+//        CUT TO CLIPBOARD
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.CutToClipBoard;
+begin
+  ClipBoard.SetTextBuf(PChar(GetSelText));
+  DeleteSelection(True);
+end;
+
+//--------------------------------------------------------------
+//        GET SEL TEXT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetSelText: string;
+var
+  i: integer;
+  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
+begin
+  Result := '';
+  if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
+    Exit;
+
+  xSelStartX := FSelStartX;
+  xSelStartY := FSelStartY;
+  xSelEndX := FSelEndX;
+  xSelEndY := FSelEndY;
+  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
+
+  if xSelStartY = xSelEndY then
+    Result := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX)
+  else
+  begin
+    Result := Copy(Lines[xSelStartY], xSelStartX + 1,
+      Length(Lines[xSelStartY]));
+    for i := xSelStartY + 1 to xSelEndY - 1 do
+      Result := Result + #13#10 + Lines[i];
+    Result := Result + #13#10 + Copy(Lines[xSelEndY], 1, xSelEndX);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        GET SEL START
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetSelStart: TPoint;
+var
+  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
+begin
+  xSelStartX := FSelStartX;
+  xSelStartY := FSelStartY;
+  xSelEndX := FSelEndX;
+  xSelEndY := FSelEndY;
+  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
+  Result := Point(xSelStartX, xSelStartY);
+end;
+
+//--------------------------------------------------------------
+//        GET SEL END
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetSelEnd: TPoint;
+var
+  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
+begin
+  xSelStartX := FSelStartX;
+  xSelStartY := FSelStartY;
+  xSelEndX := FSelEndX;
+  xSelEndY := FSelEndY;
+  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
+  Result := Point(xSelEndX, xSelEndY);
+end;
+
+//--------------------------------------------------------------
+//        SET SEL TEXT
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetSelText(const AValue: string);
+var
+  i, k: integer;
+  xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
+  Buff, S: string;
+  OldX, OldY: integer;
+begin
+  Buff := AValue;
+  xSelStartX := FSelStartX;
+  xSelStartY := FSelStartY;
+  xSelEndX := FSelEndX;
+  xSelEndY := FSelEndY;
+  OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
+
+  DeleteSelection(False);
+
+  OldX := CurX;
+  OldY := CurY;
+  i := Pos(#13#10, Buff);
+  S := Lines[xSelStartY];
+  if i = 0 then
+  begin
+    Lines[xSelStartY] := Copy(S, 1, xSelStartX) + Buff
+      + Copy(S, xSelStartX + 1, Length(S));
+    CurX := xSelStartX;
+    if Buff <> '' then
+      CurX := CurX + Length(Buff);
+  end
+  else
+  begin
+    k := xSelStartY;
+    Lines[k] := Copy(S, 1, xSelStartX) + Copy(Buff, 1, i - 1);
+    TGLSMemoStrings(Lines).DoInsert(k + 1, Copy(S, xSelStartX + 1, Length(S)));
+    while True do
+    begin
+      Buff := Copy(Buff, i + 2, Length(Buff));
+      i := Pos(#13#10, Buff);
+      k := k + 1;
+      if i = 0 then
+        break;
+      TGLSMemoStrings(Lines).DoInsert(k, Copy(Buff, 1, i - 1));
+    end;
+    Lines[k] := Buff + Lines[k];
+    CurY := k;
+    CurX := Length(Buff);
+  end;
+
+  ClearSelection;
+  Changed(xSelStartY, -1);
+  if Assigned(FUndoList) then
+    FUndoList.Add(TGLSMemoPasteUndo.Create(OldX, OldY, CurX, CurY, AValue));
+  Invalidate;
+end;
+
+//--------------------------------------------------------------
+//        GET SEL LENGTH
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetSelLength: integer;
+begin
+  Result := Length(GetSelText);
+end;
+
+//--------------------------------------------------------------
+//        CHANGED
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.Changed(FromLine, ToLine: integer);
+var
+  i: integer;
+begin
+  if ToLine < FromLine then
+    ToLine := Lines.Count - 1;
+  for i := FromLine to ToLine do
+    ValidAttrs[i] := False;
+  InvalidateLineRange(FromLine, ToLine);
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+//--------------------------------------------------------------
+//        ATTR CHANGED
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.AttrChanged(LineNo: integer);
+begin
+  ValidAttrs[LineNo] := False;
+  InvalidateLineRange(LineNo, LineNo);
+  if Assigned(FOnAttrChange) then
+    FOnAttrChange(Self);
+end;
+
+//--------------------------------------------------------------
+//        SELECTION CHANGED
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SelectionChanged;
+begin
+  if Assigned(FOnSelectionChange) then
+    FOnSelectionChange(Self);
+end;
+
+//--------------------------------------------------------------
+//        STATUS CHANGED
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.StatusChanged;
+begin
+  if Assigned(FOnStatusChange) then
+    FOnStatusChange(Self);
+end;
+
+//--------------------------------------------------------------
+//        CLEAR SELECTION
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ClearSelection;
+var
+  rct: TRect;
+  Changed: Boolean;
+begin
+  Changed := not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY));
+  rct := LineRangeRect(FSelStartY, FSelEndY);
+  FSelStartX := CurX;
+  FSelStartY := CurY;
+  FSelEndX := CurX;
+  FSelEndY := CurY;
+  FPrevSelX := CurX;
+  FPrevSelY := CurY;
+  if Changed then
+  begin
+    SelectionChanged;
+    InvalidateRect(Handle, @rct, true);
+  end;
+  if Assigned(FOnMoveCursor) then
+    FOnMoveCursor(Self);
+end;
+
+//--------------------------------------------------------------
+//        EXPAND SELECTION
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ExpandSelection;
+var
+  rct: TRect;
+begin
+  rct := LineRangeRect(FPrevSelY, CurY);
+  FSelEndX := CurX;
+  FSelEndY := CurY;
+  FPrevSelX := CurX;
+  FPrevSelY := CurY;
+  SelectionChanged;
+  InvalidateRect(Handle, @rct, true);
+  if Assigned(FOnMoveCursor) then
+    FOnMoveCursor(Self);
+end;
+
+//--------------------------------------------------------------
+//        MAX LENGTH
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.MaxLength: integer;
+var
+  i, len: integer;
+begin
+  Result := 0;
+  for i := 0 to Lines.Count - 1 do
+  begin
+    len := Length(Lines[i]);
+    if len > Result then
+      Result := len;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        DO SCROLL
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
+var
+  eRect, scrRect, sbRect: TRect;
+  Old: integer;
+begin
+  eRect := EditorRect;
+  case Sender.Kind of
+    sbVertical:
+      begin
+        Old := FTopLine;
+        FTopLine := FTopLine + ByValue;
+        if FTopLine > Sender.MaxPosition then
+          FTopLine := Sender.MaxPosition;
+        if FTopLine < 0 then
+          FTopLine := 0;
+        if Old <> FTopLine then
+        begin
+          ShowCaret(False);
+          if CurY < FTopLine then
+            CurY := FTopLine;
+          if CurY > LastVisibleLine then
+            CurY := LastVisibleLine;
+
+          ScrollDC(Canvas.Handle, 0, (Old - FTopLine) * FCellSize.H,
+            eRect, eRect, 0, @scrRect);
+          InvalidateRect(Handle, @scrRect, True);
+          sbRect := Sender.FullRect;
+          InvalidateRect(Handle, @sbRect, True);
+          FGutter.Invalidate;
+          ShowCaret(True);
+        end;
+      end;
+    sbHorizontal:
+      begin
+        Old := FLeftCol;
+        FLeftCol := FLeftCol + ByValue;
+        if FLeftCol > Sender.MaxPosition then
+          FLeftCol := Sender.MaxPosition;
+        if FLeftCol < 0 then
+          FLeftCol := 0;
+        if Old <> FLeftCol then
+        begin
+          ShowCaret(False);
+          if CurX < FLeftCol then
+            CurX := FLeftCol;
+          if CurX > LastVisiblePos then
+            CurX := LastVisiblePos;
+          ScrollDC(Canvas.Handle, (Old - FLeftCol) * FCellSize.W, 0,
+            eRect, eRect, 0, @scrRect);
+          InvalidateRect(Handle, @scrRect, True);
+          sbRect := Sender.FullRect;
+          InvalidateRect(Handle, @sbRect, True);
+          ShowCaret(True);
+        end;
+      end;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        DO SCROLL PAGE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DoScrollPage(Sender: TGLSMemoScrollBar; ByValue:
+  integer);
+begin
+  case Sender.Kind of
+    sbVertical: DoScroll(Sender, ByValue * VisibleLineCount);
+    sbHorizontal: DoScroll(Sender, ByValue * VisiblePosCount);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SET LINES
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetLines(ALines: TStrings);
+begin
+  if ALines <> nil then
+  begin
+    FLines.Assign(ALines);
+    Changed(0, -1);
+    SelectionChanged;
+    Invalidate;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SET/GET LINE STYLE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetLineStyle(Index: integer; Value: integer);
+begin
+  TGLSMemoStrings(FLines).Style[Index] := Value;
+  if IsLineVisible(Index) then
+    AttrChanged(Index);
+end;
+
+function TGLSCustomMemo.GetLineStyle(Index: integer): integer;
+begin
+  Result := TGLSMemoStrings(FLines).Style[Index];
+end;
+
+//--------------------------------------------------------------
+//        GET/SET IN COMMENT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetInComment(Index: integer): Boolean;
+begin
+  Result := TGLSMemoStrings(FLines).InComment[Index];
+end;
+
+procedure TGLSCustomMemo.SetInComment(Index: integer; Value: Boolean);
+begin
+  TGLSMemoStrings(FLines).InComment[Index] := Value;
+end;
+
+//--------------------------------------------------------------
+//        GET/SET IN BRACKETS
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetInBrackets(Index: integer): integer;
+begin
+  Result := TGLSMemoStrings(FLines).InBrackets[Index];
+end;
+
+procedure TGLSCustomMemo.SetInBrackets(Index: integer; Value: integer);
+begin
+  TGLSMemoStrings(FLines).InBrackets[Index] := Value;
+end;
+
+//--------------------------------------------------------------
+//        GET/SET VALID ATTRS
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetValidAttrs(Index: integer): Boolean;
+begin
+  Result := TGLSMemoStrings(FLines).ValidAttrs[Index];
+end;
+
+procedure TGLSCustomMemo.SetValidAttrs(Index: integer; Value: Boolean);
+begin
+  TGLSMemoStrings(FLines).ValidAttrs[Index] := Value;
+end;
+
+//--------------------------------------------------------------
+//        GET/SET CHAR ATTRS
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetCharAttrs(Index: integer): string;
+begin
+  Result := TGLSMemoStrings(FLines).CharAttrs[Index];
+end;
+
+procedure TGLSCustomMemo.SetCharAttrs(Index: integer; const Value: string);
+begin
+  TGLSMemoStrings(FLines).CharAttrs[Index] := Value;
+  if IsLineVisible(Index) then
+    AttrChanged(Index);
+end;
+
+//--------------------------------------------------------------
+//        SET CUR X
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetCurX(Value: integer);
+var
+  len: integer;
+  WasVisible: Boolean;
+begin
+  if Value < 0 then
+    if CurY = 0 then
+      Value := 0
+    else
+    begin
+      CurY := CurY - 1;
+      Value := Length(Lines[CurY]);
+    end;
+
+  if (CurY >= 0) and (CurY < Lines.Count) then
+  begin
+    len := Length(Lines[CurY]);
+    if Value > len then
+    begin
+      Lines[CurY] := Lines[CurY] + StringOfChar(' ', Value - len);
+      // Value := len;
+      ValidAttrs[CurY] := False;
+      InvalidateLineRange(CurY, CurY);
+    end;
+  end;
+
+  FCurX := Value;
+
+  WasVisible := FCaretVisible;
+  if WasVisible then
+    ShowCaret(False);
+  MakeVisible;
+  ResizeScrollBars;
+  StatusChanged;
+  if WasVisible then
+    ShowCaret(True);
+end;
+
+//--------------------------------------------------------------
+//        SET CUR Y
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetCurY(Value: integer);
+var
+  Old: integer;
+  WasVisible: Boolean;
+begin
+  WasVisible := FCaretVisible;
+  if WasVisible then
+    ShowCaret(False);
+  Old := CurY;
+
+  if Value < 0 then
+    Value := 0;
+  if Value >= Lines.Count then
+    Value := Lines.Count - 1;
+
+  FCurY := Value;
+  if (CurY <> Old) and (Old >= 0) and (Old < Lines.Count) then
+    Lines[Old] := TrimRight(Lines[Old]);
+  CurX := CurX;
+
+  MakeVisible;
+  ResizeScrollBars;
+  StatusChanged;
+  if WasVisible then
+    ShowCaret(True);
+end;
+
+//--------------------------------------------------------------
+//        MOVE CURSOR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.MoveCursor(dX, dY: integer; Shift: TShiftState);
+var
+  Selecting: Boolean;
+  //------------------------------------------------------------
+  function IsDelimiter(c: char): Boolean;
+  begin
+    Result := Pos(c, ' .,;:/?!@#$%^&*(){}[]<>-+=|\') > 0;
+  end;
+  //------------------------------------------------------------
+  function IsStopChar(c, cThis: char): Boolean;
+  begin
+    Result := IsDelimiter(c) <> IsDelimiter(cThis);
+  end;
+  //------------------------------------------------------------
+  procedure MoveWordLeft;
+  var
+    S: string;
+  begin
+    CurX := CurX - 1;
+    S := TrimRight(Lines[CurY]);
+    while CurX > 0 do
+    begin
+      if IsStopChar(S[CurX], S[CurX + 1]) then
+        break;
+      CurX := CurX - 1;
+    end;
+    if (CurX < 0) then
+      if CurY > 0 then
+      begin
+        CurY := CurY - 1;
+        CurX := Length(Lines[CurY]);
+      end;
+  end;
+  //------------------------------------------------------------
+  procedure MoveWordRight;
+  var
+    Len: integer;
+    S: string;
+  begin
+    S := TrimRight(Lines[CurY]);
+    Len := Length(S);
+    CurX := CurX + 1;
+    while CurX < Len do
+    begin
+      if IsStopChar(S[CurX + 1], S[CurX]) then
+        break;
+      CurX := CurX + 1;
+    end;
+    if CurX > Len then
+      if CurY < Lines.Count - 1 then
+      begin
+        CurY := CurY + 1;
+        CurX := 0;
+      end;
+  end;
+  //------------------------------------------------------------
+begin
+  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
+    and (CurY = FPrevSelY);
+  if ssCtrl in Shift then
+  begin
+    if dX > 0 then
+      MoveWordRight;
+    if dX < 0 then
+      MoveWordLeft;
+  end
+  else
+  begin
+    CurY := CurY + dY;
+    CurX := CurX + dX;
+  end;
+  if Selecting then
+    ExpandSelection
+  else
+    ClearSelection;
+end;
+
+//--------------------------------------------------------------
+//        MOVE PAGE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.MovePage(dP: integer; Shift: TShiftState);
+var
+  eRect: TRect;
+  LinesPerPage: integer;
+  Selecting: Boolean;
+begin
+  if FCellSize.H = 0 then
+    Exit;
+  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
+    and (CurY = FPrevSelY);
+  eRect := EditorRect;
+  LinesPerPage := (eRect.Bottom - eRect.Top) div FCellSize.H - 1;
+  CurY := CurY + dP * LinesPerPage;
+  if ssCtrl in Shift then
+    if dP > 0 then
+    begin
+      CurY := Lines.Count - 1;
+      CurX := Length(Lines[Lines.Count - 1]);
+    end
+    else
+    begin
+      CurY := 0;
+      CurX := 0;
+    end;
+  if Selecting then
+    ExpandSelection
+  else
+    ClearSelection;
+end;
+
+//--------------------------------------------------------------
+//        GO HOME
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.GoHome(Shift: TShiftState);
+var
+  Selecting: Boolean;
+begin
+  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
+    and (CurY = FPrevSelY);
+  CurX := 0;
+  FLeftCol := 0;
+  if Selecting then
+    ExpandSelection
+  else
+    ClearSelection;
+end;
+
+//--------------------------------------------------------------
+//        GO END
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.GoEnd(Shift: TShiftState);
+var
+  Selecting: Boolean;
+  S, S1: string;
+begin
+  Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
+    and (CurY = FPrevSelY);
+
+  S := Lines[CurY];
+  if not Selecting then
+    S := TrimRight(S);
+  S1 := TrimRight(Copy(S, CurX + 1, Length(S)));
+  S := Copy(S, 1, CurX);
+  Lines[CurY] := S + S1;
+
+  CurX := Length(Lines[CurY]);
+  if Selecting then
+    ExpandSelection
+  else
+    ClearSelection;
+end;
+
+//--------------------------------------------------------------
+//        INSERT CHAR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.InsertChar(C: Char);
+var
+  S, S1: string;
+  NewPlace: integer;
+  rct: TRect;
+  CurX0, CurY0: integer;
+begin
+  CurX0 := CurX;
+  CurY0 := CurY;
+  S := Lines[CurY];
+  NewPlace := CurX + 1;
+  if C = #9 then
+  begin
+    while (NewPlace mod TabSize) <> 0 do
+      Inc(NewPlace);
+    S1 := StringOfChar(' ', NewPlace - CurX);
+  end
+  else
+    S1 := C;
+  Insert(S1, S, CurX + 1);
+  Lines[CurY] := S;
+  CurX := NewPlace;
+  ClearSelection;
+  rct := LineRect(CurY);
+  Changed(CurY, CurY);
+
+  if Assigned(FUndoList) then
+    FUndoList.Add(TGLSMemoInsCharUndo.Create(CurX0, CurY0, CurX, CurY, S1));
+
+  InvalidateRect(Handle, @rct, True);
+end;
+
+//--------------------------------------------------------------
+//        INSERT TEMPLATE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.InsertTemplate(AText: string);
+var
+  i, NewCurX, NewCurY: integer;
+  Indent: string;
+  FoundCursor: Boolean;
+begin
+  Indent := IndentCurrLine;
+
+  DeleteSelection(False);
+  ClearSelection;
+
+  NewCurX := CurX;
+  NewCurY := CurY;
+  FoundCursor := False;
+  i := 1;
+  while i <= Length(AText) do
+  begin
+    if AText[i] = #13 then
+    begin
+      if (i = Length(AText)) or (AText[i + 1] <> #10) then
+        Insert(#10 + Indent, AText, i + 1);
+      if not FoundCursor then
+      begin
+        Inc(NewCurY);
+        NewCurX := Length(Indent);
+      end;
+      Inc(i, 1 + Length(Indent));
+    end
+    else if AText[i] = #7 then
+    begin
+      FoundCursor := True;
+      Delete(AText, i, 1);
+      Dec(i);
+    end
+    else if Ord(AText[i]) < Ord(' ') then
+    begin
+      Delete(AText, i, 1);
+      Dec(i);
+    end
+    else if not FoundCursor then
+      Inc(NewCurX);
+    Inc(i);
+  end;
+
+  SetSelText(AText);
+  SetCursor(NewCurX, NewCurY);
+  ClearSelection;
+  try
+    SetFocus;
+  except
+  end;
+
+end;
+
+//--------------------------------------------------------------
+//        DELETE CHAR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DeleteChar(OldX, OldY: integer);
+var
+  S, S1: string;
+  rct: TRect;
+  C: char;
+  Undo: TGLSMemoDelCharUndo;
+  IsBackspace: Boolean;
+begin
+  if FReadOnly then
+    Exit;
+  if OldX < 0 then
+  begin
+    OldX := CurX;
+    OldY := CurY;
+    IsBackspace := False;
+  end
+  else
+    IsBackspace := True;
+
+  ClearSelection;
+
+  S := Lines[CurY];
+  S1 := Copy(S, CurX + 1, Length(S));
+  if not IsBackspace then
+    S1 := TrimRight(S1);
+  S := Copy(S, 1, CurX);
+  Lines[CurY] := S + S1;
+
+  if CurX < Length(Lines[CurY]) then
+  begin
+    S := Lines[CurY];
+    C := S[CurX + 1];
+    Delete(S, CurX + 1, 1);
+    Lines[CurY] := S;
+    Changed(CurY, CurY);
+    rct := LineRect(CurY);
+    Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, C);
+    Undo.IsBackSpace := IsBackSpace;
+    if Assigned(FUndoList) then
+      FUndoList.Add(Undo);
+  end
+  else if CurY < Lines.Count - 1 then
+  begin
+    S := Lines[CurY] + Lines[CurY + 1];
+    Lines[CurY] := S;
+    DeleteLine(CurY + 1, OldX, OldY, CurX, CurY, False);
+    Changed(CurY, -1);
+    rct := EditorRect;
+    Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, #13);
+    Undo.IsBackSpace := IsBackSpace;
+    if Assigned(FUndoList) then
+      FUndoList.Add(Undo);
+  end;
+  ClearSelection;
+  InvalidateRect(Handle, @rct, True);
+end;
+
+//--------------------------------------------------------------
+//        DELETE LINE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DeleteLine(Index, OldX, OldY, NewX, NewY: integer;
+  FixUndo: Boolean);
+var
+  rct: TRect;
+  s: string;
+begin
+  if Index < 0 then
+    Index := CurY;
+  if OldX < 0 then
+  begin
+    OldX := CurX;
+    OldY := CurY;
+  end;
+
+  s := Lines[Index];
+
+  TGLSMemoStrings(Lines).FDeleting := True;
+  if Lines.Count = 1 then
+    TGLSMemoStrings(Lines)[0] := ''
+  else
+    Lines.Delete(Index);
+  TGLSMemoStrings(Lines).FDeleting := False;
+
+  ClearSelection;
+  if Index >= Lines.Count then
+    Changed(Index - 1, -1)
+  else
+    Changed(Index, -1);
+  rct := EditorRect;
+  InvalidateRect(Handle, @rct, True);
+
+  if NewX < 0 then
+  begin
+    if Length(Lines[0]) < CurX then
+      CurX := Length(Lines[0]);
+    if Index >= Lines.Count then
+      CurY := Index - 1
+    else
+      CurY := Index;
+    NewX := CurX;
+    NewY := CurY;
+  end
+  else
+  begin
+    CurX := NewX;
+    CurY := NewY;
+  end;
+  if Assigned(FUndoList) and FixUndo then
+    FUndoList.Add(TGLSMEmoDelLineUndo.Create(Index, OldX, OldY, NewX, NewY, s));
+end;
+
+//--------------------------------------------------------------
+//        BACK SPACE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.BackSpace;
+var
+  OldX, OldY: integer;
+begin
+  OldX := CurX;
+  OldY := CurY;
+  MoveCursor(-1, 0, []);
+  if (OldX = CurX) and (OldY = CurY) then
+    Exit;
+  DeleteChar(OldX, OldY);
+end;
+
+//--------------------------------------------------------------
+//        BACK SPACE WORD
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.BackSpaceWord;
+begin
+  ClearSelection;
+  MoveCursor(-1, 0, [ssShift, ssCtrl]);
+  DeleteSelection(True);
+end;
+
+//--------------------------------------------------------------
+//        INDENT CURR LINE
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.IndentCurrLine: string;
+var
+  Len, Count: integer;
+  CurS: string;
+begin
+  Result := '';
+  if not AutoIndent then
+    Exit;
+  CurS := Lines[CurY];
+  Len := Length(CurS);
+  Count := 0;
+  while (Count < CurX) and (Count < Len) do
+  begin
+    if CurS[Count + 1] <> ' ' then
+      break;
+    Inc(Count);
+  end;
+  Result := StringOfChar(' ', Count);
+end;
+
+//--------------------------------------------------------------
+//        NEW LINE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.NewLine;
+var
+  S, sIndent: string;
+  OldX, OldY: integer;
+begin
+  OldX := CurX;
+  OldY := CurY;
+  S := Lines[CurY];
+  sIndent := IndentCurrLine;
+  Lines[CurY] := Copy(S, 1, CurX);
+
+  S := TrimRight(Copy(S, CurX + 1, Length(S)));
+  if AutoIndent then
+    while (Length(S) > 0) and (S[1] = ' ') do
+      Delete(S, 1, 1);
+
+  TGLSMemoStrings(Lines).DoInsert(CurY + 1, sIndent + S);
+  GoHome([]);
+  MoveCursor(0, 1, []);
+  CurX := Length(sIndent);
+  ClearSelection;
+  if Assigned(FUndoList) then
+    FUndoList.Add(TGLSMemoInsCharUndo.Create(OldX, OldY, CurX, CurY, #13 +
+      sIndent));
+  Invalidate;
+  Changed(CurY - 1, -1);
+end;
+
+//--------------------------------------------------------------
+//        ADD STRING
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.AddString(const S: string): integer;
+begin
+  if Lines.Count = 0 then
+    TGLSMemoStrings(Lines).DoAdd('');
+  MovePage(1, [ssCtrl]); // end of text
+  if not ((Lines.Count = 1) and (Lines[0] = '')) then
+  begin
+    TGLSMemoStrings(Lines).DoAdd('');
+    CurX := 0;
+    CurY := Lines.Count;
+    ClearSelection;
+    // S := #13#10 + S;
+  end;
+  SetSelText(S);
+  Result := Lines.Count - 1;
+end;
+
+//--------------------------------------------------------------
+//        INSERT STRING
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.InsertString(Index: integer; S: string);
+begin
+  CurY := Index;
+  CurX := 0;
+  ClearSelection;
+  if not ((Lines.Count = 1) and (Lines[0] = '')) then
+    S := S + #13#10;
+  SetSelText(S);
+end;
+
+//--------------------------------------------------------------
+//        DO COMMAND
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DoCommand(cmd: TCommand; const AShift: TShiftState);
+begin
+  case cmd of
+    cmDelete: if not FReadOnly then
+      begin
+        if ssShift in AShift then
+          CutToClipboard
+        else if FDelErase and
+          (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY))) then
+          DeleteSelection(True)
+        else
+          DeleteChar(-1, -1);
+      end;
+    cmBackSpace: BackSpace;
+    cmWordBackSpace: BackSpaceWord;
+    cmNewLine: NewLine;
+    cmDelLine: DeleteLine(-1, -1, -1, -1, -1, True);
+    cmCopy: CopyToClipboard;
+    cmCut: CutToClipboard;
+    cmPaste: PasteFromClipboard;
+    cmHome: GoHome(AShift);
+    cmEnd: GoEnd(AShift);
+    cmPageDown: MovePage(1, AShift);
+    cmPageUp: MovePage(-1, AShift);
+    cmInsert:
+      begin
+        if ssShift in AShift then
+          PasteFromClipboard;
+        if ssCtrl in AShift then
+          CopyToClipboard;
+      end;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        KEY DOWN
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  ShowCaret(False);
+  inherited;
+  case Key of
+    VK_LEFT: MoveCursor(-1, 0, Shift);
+    VK_RIGHT: MoveCursor(1, 0, Shift);
+    VK_UP: MoveCursor(0, -1, Shift);
+    VK_DOWN: MoveCursor(0, 1, Shift);
+    VK_HOME, VK_END,
+      VK_DELETE: DoCommand(Key, Shift);
+    VK_PRIOR, VK_NEXT:
+      DoCommand(Key, Shift);
+    VK_INSERT: DoCommand(Key, Shift);
+  end;
+  ShowCaret(True);
+end;
+
+//--------------------------------------------------------------
+//        KEY PRESS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.KeyPress(var Key: Char);
+begin
+  if FReadOnly then
+    Exit;
+  ShowCaret(False);
+  inherited;
+  if (ord(Key) in [9, 32..255]) and (ord(Key) <> 127) then
+  begin
+    if FDelErase and (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY)))
+      then
+      DeleteSelection(True);
+    InsertChar(Key);
+  end
+  else
+    DoCommand(Ord(Key), []);
+  ShowCaret(True);
+end;
+
+//--------------------------------------------------------------
+//        MOUSE DOWN
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+var
+  newPos: TCellPos;
+  charPos: TFullPos;
+  Selecting: Boolean;
+begin
+  inherited;
+  if not Focused then
+  begin
+    SetFocus;
+    //     Exit;
+  end;
+
+  if FAfterDoubleClick then
+  begin
+    FAfterDoubleClick := False;
+    Exit;
+  end;
+
+  if Button <>mbLeft then
+    Exit;
+
+
+  if sbVert.MouseDown(Button, Shift, X, Y) then
+    Exit;
+  if sbHorz.MouseDown(Button, Shift, X, Y) then
+    Exit;
+
+  if PointInRect(Point(X, Y), EditorRect) then
+  begin
+    ShowCaret(False);
+    newPos := CellFromPos(X, Y);
+    CurY := newPos.Y + FTopLine;
+    CurX := newPos.X + FLeftCol;
+    if Assigned(FOnMoveCursor) then
+      FOnMoveCursor(Self);
+
+    Selecting := ssShift in Shift;
+    if Button = mbLeft then
+    begin
+      if Selecting then
+        ExpandSelection
+      else
+        ClearSelection;
+      FLeftButtonDown := True;
+    end
+    else
+      ShowCaret(True);
+  end;
+
+  if Assigned(FOnGutterClick) then
+    if PointInRect(Point(X, Y), FGutter.FullRect) then
+    begin
+      charPos := CharFromPos(X, Y);
+      if charPos.LineNo < Lines.Count then
+        FOnGutterClick(Self, charPos.LineNo);
+    end;
+end;
+
+//--------------------------------------------------------------
+//        MOUSE MOVE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+  newPos: TCellPos;
+begin
+  inherited;
+  if sbVert.MouseMove(Shift, X, Y) then
+    Exit;
+  if sbHorz.MouseMove(Shift, X, Y) then
+    Exit;
+  if PointInRect(Point(X, Y), EditorRect) then
+  begin
+    if (ssLeft in Shift) and FLeftButtonDown then
+    begin
+      newPos := CellFromPos(X, Y);
+      CurY := newPos.Y + FTopLine;
+      CurX := newPos.X + FLeftCol;
+      ExpandSelection;
+    end;
+  end
+end;
+
+//--------------------------------------------------------------
+//        MOUSE UP
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
+  Integer);
+begin
+  inherited;
+  if sbVert.MouseUp(Button, Shift, X, Y) then
+    Exit;
+  if sbHorz.MouseUp(Button, Shift, X, Y) then
+    Exit;
+  if Button = mbLeft then
+    ShowCaret(True);
+  FLeftButtonDown := False;
+  FLastMouseUpX := X;
+  FLastMouseUpY := Y;
+end;
+
+//--------------------------------------------------------------
+//        DBL CLICK
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DblClick;
+var
+  clickPos: TCellPos;
+  clickX, clickY: integer;
+  //------------------------------------------------------------
+  //   SELECT WORD
+  //------------------------------------------------------------
+  procedure SelectWord;
+  const
+    stopChars: TSysCharSet = [' ', ';', '.', ',', ':', '?', '!', '''', '"',
+      '<', '>', '/', '*', '+', '-', '=', '(', ')',
+      '[', ']', '{', '}', '@', '#', '$', '%', '^',
+      '&', '|', '\'];
+  var
+    s: string;
+    i: integer;
+    rct: TRect;
+  begin
+    CurX := clickX;
+    CurY := clickY;
+    if (CurX = clickX) and (CurY = clickY) then
+    begin
+      s := Lines[clickY];
+      if s[clickX + 1] = ' ' then
+        Exit;
+
+      i := clickX;
+      while (i >= 0) and not CharInSet(s[i + 1], stopChars) do
+        Dec(i);
+      FSelStartY := clickY;
+      FSelStartX := i + 1;
+
+      i := clickX;
+      while (i < Length(s)) and not CharInSet(s[i + 1], stopChars) do
+        Inc(i);
+      FSelEndY := clickY;
+      FSelEndX := i;
+
+      if FSelEndX <> FSelStartX then
+      begin
+        FAfterDoubleClick := True;
+        rct := LineRangeRect(CurY, CurY);
+        SelectionChanged;
+        InvalidateRect(Handle, @rct, true);
+      end;
+    end;
+  end;
+  //------------------------------------------------------------
+begin
+
+  if PointInRect(Point(FLastMouseUpX, FLastMouseUpY), EditorRect) then
+  begin
+    clickPos := CellFromPos(FLastMouseUpX, FLastMouseUpY);
+    clickX := clickPos.X + FLeftCol;
+    clickY := clickPos.Y + FTopLine;
+    SelectWord;
+  end;
+  inherited;
+end;
+
+//--------------------------------------------------------------
+//        WM_GETDLGCODE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.WMGetDlgCode(var Msg: TWMGetDlgCode);
+begin
+  Msg.Result := DLGC_WANTARROWS or DLGC_WANTTAB;
+end;
+
+//--------------------------------------------------------------
+//        WM_ERASEBKGND
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
+begin
+  Msg.Result := 1;
+end;
+
+//--------------------------------------------------------------
+//        WM_SIZE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.WMSize(var Msg: TWMSize);
+begin
+  if not (csLoading in ComponentState) then
+    try
+      ResizeEditor;
+    except
+    end;
+end;
+
+//--------------------------------------------------------------
+//        WM_SETCURSOR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.WMSetCursor(var Msg: TWMSetCursor);
+var
+  P: TPoint;
+begin
+  Msg.Result := 1;
+  GetCursorPos(P);
+  P := ScreenToClient(P);
+  if PointInRect(P, EditorRect) then
+    Winapi.Windows.SetCursor(Screen.Cursors[crIBeam])
+  else
+    Winapi.Windows.SetCursor(Screen.Cursors[crArrow]);
+end;
+
+//--------------------------------------------------------------
+//        WM_SETFOCUS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.WMSetFocus(var Msg: TWMSetFocus);
+begin
+  if FCellSize.H = 0 then
+    SetFont(FFont);
+  CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
+  ShowCaret(true);
+end;
+
+//--------------------------------------------------------------
+//        WM_KILLFOCUS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.WMKillFocus(var Msg: TWMSetFocus);
+begin
+  DestroyCaret;
+  FCaretVisible := False;
+  inherited;
+end;
+
+//--------------------------------------------------------------
+//        SHOW CARET
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ShowCaret(State: Boolean);
+var
+  rct: TRect;
+begin
+  FCaretVisible := False;
+  if not State then
+    HideCaret(Handle)
+  else if Focused and not HiddenCaret then
+  begin
+    rct := CellRect(CurX - FLeftCol, CurY - FTopLine);
+    SetCaretPos(rct.Left, rct.Top + 1);
+    Winapi.Windows.ShowCaret(Handle);
+    FCaretVisible := True;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        CELL RECT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.CellRect(ACol, ARow: integer): TRect;
+var
+  rct: TRect;
+begin
+  rct := EditorRect;
+  with FCellSize do
+    Result := Rect(rct.Left + W * ACol, rct.Top + H * ARow,
+      rct.Left + W * (ACol + 1), rct.Top + H * (ARow + 1));
+end;
+
+//--------------------------------------------------------------
+//        LINE RECT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.LineRect(ARow: integer): TRect;
+var
+  rct: TRect;
+begin
+  rct := EditorRect;
+  ARow := ARow - FTopLine;
+  with FCellSize do
+    Result := Rect(rct.Left, rct.Top + H * ARow, rct.Right, rct.Top + H * (ARow
+      + 1));
+end;
+
+//--------------------------------------------------------------
+//        COL RECT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.ColRect(ACol: integer): TRect;
+var
+  rct: TRect;
+begin
+  rct := EditorRect;
+  ACol := ACol - FLeftCol;
+  with FCellSize do
+    Result := Rect(rct.Left + W * ACol, rct.Top, rct.Left + W * (ACol + 1),
+      rct.Bottom);
+end;
+
+//--------------------------------------------------------------
+//        LINE RANGE RECT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.LineRangeRect(FromLine, ToLine: integer): TRect;
+var
+  rct1, rct2: TRect;
+begin
+  rct1 := LineRect(FromLine);
+  rct2 := LineRect(ToLine);
+  Result := TotalRect(rct1, rct2);
+end;
+
+//--------------------------------------------------------------
+//        INVALIDATE LINE RANGE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.InvalidateLineRange(FromLine, ToLine: integer);
+var
+  rct: TRect;
+begin
+  if ToLine < FromLine then
+    ToLine := Lines.Count - 1;
+  rct := LineRangeRect(FromLine, ToLine);
+  if GutterWidth > 2 then
+    rct.Left := FGutter.Left;
+  InvalidateRect(Handle, @rct, True);
+end;
+
+//--------------------------------------------------------------
+//        COL RANGE RECT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.ColRangeRect(FromCol, ToCol: integer): TRect;
+var
+  rct1, rct2: TRect;
+begin
+  rct1 := ColRect(FromCol);
+  rct2 := ColRect(ToCol);
+  Result := TotalRect(rct1, rct2);
+end;
+
+//--------------------------------------------------------------
+//        CELL and CHAR FROM POS
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.CellFromPos(X, Y: integer): TCellPos;
+var
+  rct: TRect;
+begin
+  rct := EditorRect;
+  if (FCellSize.H = 0) and Assigned(FFont) then
+    SetFont(FFont);
+  if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
+  begin
+    Result.X := (X - rct.Left) div FCellSize.W;
+    Result.Y := (Y - rct.Top) div FCellSize.H;
+  end
+  else
+  begin
+    Result.X := 0;
+    Result.Y := 0;
+  end;
+end;
+
+function TGLSCustomMemo.CharFromPos(X, Y: integer): TFullPos;
+var
+  rct: TRect;
+begin
+  rct := EditorRect;
+  if (FCellSize.H = 0) and Assigned(FFont) then
+    SetFont(FFont);
+  if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
+  begin
+    Result.Pos := (X - rct.Left) div FCellSize.W + FLeftCol;
+    Result.LineNo := (Y - rct.Top) div FCellSize.H + FTopLine;
+  end
+  else
+  begin
+    Result.Pos := 1;
+    Result.LineNo := 1;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SET COLOR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetColor(Index: integer; Value: TColor);
+var
+  eRect: TRect;
+  Changed: Boolean;
+begin
+  Changed := False;
+  case Index of
+    0: if FBkColor <> Value then
+      begin
+        FBkColor := Value;
+        FStyles.BkColor[0] := Value;
+        Changed := True;
+      end;
+    1: if FSelColor <> Value then
+      begin
+        FSelColor := Value;
+        Changed := True;
+      end;
+    2: if FSelBkColor <> Value then
+      begin
+        FSelBkColor := Value;
+        Changed := True;
+      end;
+  end;
+  if Changed then
+  begin
+    eRect := EditorRect;
+    InvalidateRect(Handle, @eRect, True);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SET FONT
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetFont(Value: TFont);
+var
+  wW, wi: integer;
+  OldFontName: string;
+  eRect: TRect;
+begin
+  OldFontName := Canvas.Font.Name;
+  Canvas.Font.Name := Value.Name;
+  wW := Canvas.TextWidth('W');
+  wi := Canvas.TextWidth('i');
+  Canvas.Font.Name := OldFontName;
+
+  if wW <> wi then
+    raise EAbort.Create('Monospace font required');
+
+  FFont.Assign(Value);
+  Canvas.Font.Assign(Value);
+  FCellSize.W := Canvas.TextWidth('W');
+  FCellSize.H := Canvas.TextHeight('W') + 1;
+
+  if FCaretVisible then
+  begin
+    ShowCaret(False);
+    DestroyCaret;
+    CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
+    ShowCaret(true);
+  end;
+
+  FStyles.TextColor[0] := FFont.Color;
+  FStyles.Style[0] := FFont.Style;
+
+  eRect := EditorRect;
+  InvalidateRect(Handle, @eRect, True);
+end;
+
+//--------------------------------------------------------------
+//        SET GUTTER WIDTH
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetGutterWidth(Value: integer);
+begin
+  FGutterWidth := Value;
+  FGutter.FWidth := Value;
+  if not (csLoading in ComponentState) then
+    ResizeEditor;
+end;
+
+//--------------------------------------------------------------
+//        SET GUTTER COLOR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetGutterColor(Value: TColor);
+begin
+  if FGutter.FColor <> Value then
+  begin
+    FGutter.FColor := Value;
+    FGutter.Invalidate;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        GET GUTTER COLOR
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetGutterColor: TColor;
+begin
+  Result := FGutter.FColor;
+end;
+
+//--------------------------------------------------------------
+//        CHAR STYLE NO
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.CharStyleNo(LineNo, Pos: integer): integer;
+var
+  ChStyle: string;
+begin
+  Result := 0;
+  if (LineNo < 0) or (LineNo >= Lines.Count) then
+    Exit;
+
+  ChStyle := CharAttrs[LineNo];
+  if (Pos <= 0) or (Pos > Length(ChStyle)) then
+    Exit;
+
+  Result := integer(ChStyle[Pos]);
+end;
+
+//--------------------------------------------------------------
+//        DRAW LINE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DrawLine(LineNo: integer);
+var
+  eRect, rct0, rct1, rct, lineRct: TRect;
+  LineSelStart, LineSelEnd, LineStyleNo, pos: integer;
+  S, S1, S2, S3, ChStyle: string;
+  //--------- FIND LINE SELECTION -------------
+  procedure FindLineSelection;
+  var
+    len: integer;
+    xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
+  begin
+    xSelStartX := FSelStartX;
+    xSelStartY := FSelStartY;
+    xSelEndX := FSelEndX;
+    xSelEndY := FSelEndY;
+    OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
+    len := Length(Lines[LineNo]);
+    LineSelStart := 0;
+    LineSelEnd := 0;
+    if xSelStartY = Lineno then
+    begin
+      LineSelStart := xSelStartX - FLeftCol;
+      LineSelEnd := len - FLeftCol;
+    end
+    else if (xSelStartY < LineNo) and (LineNo < xSelEndY) then
+    begin
+      LineSelStart := 0;
+      LineSelEnd := len - FLeftCol;
+    end;
+
+    if xSelEndY = LineNo then
+      LineSelEnd := xSelEndX - FLeftCol;
+
+    if LineSelEnd < LineSelStart then
+      Swap(LineSelEnd, LineSelStart);
+
+    if LineSelStart < 0 then
+      LineSelStart := 0;
+    S := Copy(Lines[LineNo], FLeftCol + 1, len);
+    S1 := Copy(S, 1, LineSelStart);
+    S2 := Copy(S, LineSelStart + 1, LineSelEnd - LineSelStart);
+    S3 := Copy(S, LineSelEnd + 1, len);
+  end;
+  //------------- DRAW PART ---------------------
+  procedure DrawPart(const Part: string; PartStyle, StartPos: integer;
+    var rct: TRect; IsSelection: Boolean);
+  var
+    len, w: integer;
+    rctInternal: TRect;
+  begin
+    len := Length(Part);
+    if len > 0 then
+      with FLineBitmap.Canvas do
+      begin
+        w := FCellSize.W * len;
+        Font.Style := FStyles.Style[PartStyle];
+        if IsSelection then
+        begin
+          Font.Color := SelColor;
+          Brush.Color := SelBkColor;
+        end
+        else
+        begin
+          if LineStyleNo = 0 then
+          begin
+            Font.Color := FStyles.TextColor[PartStyle];
+            Brush.Color := FStyles.BkColor[PartStyle];
+          end
+          else
+          begin
+            if (LineNo = FSelCharPos.LineNo) and
+              (StartPos = FSelCharPos.Pos + 1) and (Length(Part) = 1) then
+            begin
+              Font.Color := FStyles.TextColor[PartStyle];
+              Brush.Color := FStyles.BkColor[PartStyle];
+            end
+            else
+            begin
+              Font.Color := FStyles.TextColor[LineStyleNo];
+              Brush.Color := FStyles.BkColor[LineStyleNo];
+              Font.Style := FStyles.Style[LineStyleNo];
+            end;
+          end;
+        end;
+        rct.Right := rct.Left + w;
+        rctInternal := rct;
+        rctInternal.Left := rctInternal.Left - eRect.Left;
+        rctInternal.Right := rctInternal.Right - eRect.Left;
+        rctInternal.Top := rctInternal.Top - rct.Top;
+        rctInternal.Bottom := rctInternal.Bottom - rct.Top;
+        FillRect(rctInternal);
+        DrawText(Handle, PChar(Part), len, rctInternal, DT_LEFT
+          or DT_SINGLELINE or DT_NOPREFIX);
+        rct0.Left := rct.Left + w;
+        rct := rct0;
+      end;
+  end;
+  //------------- DRAW SEGMENTS ---------------------
+  procedure DrawSegments(S: string; WorkPos: integer;
+    var rct: TRect; IsSelection: Boolean);
+  var
+    i, len, ThisStyle: integer;
+  begin
+    while True do
+    begin
+      Len := Length(S);
+      if Len = 0 then
+        Exit;
+      ThisStyle := Ord(ChStyle[WorkPos]);
+      i := 1;
+      while (i <= Len) and
+        (ThisStyle = Ord(ChStyle[WorkPos + i - 1])) do
+        Inc(i);
+      DrawPart(Copy(S, 1, i - 1), ThisStyle, WorkPos, rct, IsSelection);
+      Inc(WorkPos, i - 1);
+      s := Copy(s, i, Len);
+    end;
+  end;
+  //---------------------------------------------
+begin
+  eRect := EditorRect;
+  rct := CellRect(0, LineNo - FTopLine);
+  rct0 := Rect(eRect.Left, rct.Top, eRect.Right, rct.Bottom);
+  lineRct := rct0;
+
+  if LineNo < Lines.Count then
+  begin
+
+    rct := rct0;
+    S := Lines[LineNo];
+    LineStyleNo := LineStyle[LineNo];
+    ChStyle := CharAttrs[LineNo];
+    FindLineSelection;
+
+    if not Assigned(FOnGetLineAttrs) then
+      ChStyle := StringOfChar(#0, Length(Lines[LineNo]));
+
+    if Length(S) > 0 then
+      if (FSelCharStyle >= 0) and (LineNo = FSelCharPos.LineNo) then
+        ChStyle[FSelCharPos.Pos + 1] := Char(FSelCharStyle);
+
+    pos := FLeftCol + 1; // 1
+    DrawSegments(S1, pos, rct, False);
+    Inc(pos, Length(S1));
+    DrawSegments(S2, pos, rct, True);
+    Inc(pos, Length(S2));
+    DrawSegments(S3, pos, rct, False);
+
+    //       else begin
+    //            DrawPart(S1,StyleNo,rct,False);
+    //            DrawPart(S2,StyleNo,rct,True);
+    //            DrawPart(S3,StyleNo,rct,False);
+    //       end;
+
+    rct1 := rct;
+    rct1.Left := rct1.Left - eRect.Left;
+    rct1.Right := rct1.Right - eRect.Left;
+    rct1.Top := rct1.Top - rct.Top;
+    rct1.Bottom := rct1.Bottom - rct.Top;
+    with FLineBitmap.Canvas do
+    begin
+      Brush.Color := FStyles.BkColor[LineStyleNo];
+      FillRect(rct1);
+    end;
+
+    with LineRct do
+      BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
+        FLineBitmap.Canvas.Handle, 0, 0, SRCCOPY);
+  end
+  else
+    with Canvas do
+    begin
+      Brush.Color := BkColor;
+      FillRect(rct0);
+    end;
+end;
+
+//--------------------------------------------------------------
+//        SET HIDDEN CARET
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetHiddenCaret(Value: Boolean);
+begin
+  if Value <> FHiddenCaret then
+  begin
+    FHiddenCaret := Value;
+    if Focused then
+      if FHiddenCaret = FCaretVisible then
+        ShowCaret(not FHiddenCaret);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        BORDER
+//--------------------------------------------------------------
+
+procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
+const
+  Colors: array[TBorderType] of array[1..4] of TColor
+    = (($D0D0D0, clWhite, clGray, clBlack),
+    (clGray, clBlack, $D0D0D0, clWhite),
+    (clWhite, clWhite, clWhite, clGray),
+    (clGray, clWhite, clWhite, clGray));
+begin
+  with Canvas do
+  begin
+    Pen.Color := Colors[BorderType][1];
+    MoveTo(rct.Left, rct.Bottom - 1);
+    LineTo(rct.Left, rct.Top);
+    LineTo(rct.Right, rct.Top);
+    if BorderType in [btRaised, btLowered] then
+    begin
+      Pen.Color := Colors[BorderType][2];
+      MoveTo(rct.Left + 1, rct.Bottom);
+      LineTo(rct.Left + 1, rct.Top + 1);
+      LineTo(rct.Right, rct.Top + 1);
+      Pen.Color := Colors[BorderType][3];
+      MoveTo(rct.Left + 1, rct.Bottom - 2);
+      LineTo(rct.Right - 2, rct.Bottom - 2);
+      LineTo(rct.Right - 2, rct.Top + 1);
+    end;
+    Pen.Color := Colors[BorderType][4];
+    MoveTo(rct.Left, rct.Bottom - 1);
+    LineTo(rct.Right - 1, rct.Bottom - 1);
+    LineTo(rct.Right - 1, rct.Top);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        EDITOR RECT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.EditorRect: TRect;
+var
+  l, t, r, b: integer;
+begin
+  l := 2;
+  r := Width - 2;
+  t := 2;
+  b := Height - 2;
+  if GutterWidth > 2 then
+    l := l + GutterWidth;
+  if FScrollBars in [ssBoth, ssVertical] then
+    r := r - FScrollBarWidth;
+  if FScrollBars in [ssBoth, ssHorizontal] then
+    b := b - FScrollBarWidth;
+  Result := Rect(l + FMargin, t, r, b);
+end;
+
+//--------------------------------------------------------------
+//        DRAW MARGIN
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DrawMargin;
+var
+  eRect: TRect;
+  i: integer;
+begin
+  eRect := EditorRect;
+  with Canvas do
+  begin
+    Pen.Color := clWhite;
+    for i := 1 to FMargin do
+    begin
+      MoveTo(eRect.Left - i, eRect.Top);
+      LineTo(eRect.Left - i, eRect.Bottom + 1);
+    end;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        DRAW GUTTER
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DrawGutter;
+begin
+  if GutterWidth < 2 then
+    Exit;
+  ResizeGutter;
+  FGutter.PaintTo(Canvas);
+end;
+
+//--------------------------------------------------------------
+//        DRAW SCROLLBARS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.DrawScrollBars;
+begin
+  ResizeScrollBars;
+  if FScrollBars in [ssBoth, ssVertical] then
+    sbVert.PaintTo(Canvas);
+  if FScrollBars in [ssBoth, ssHorizontal] then
+    sbHorz.PaintTo(Canvas);
+  if FScrollBars = ssBoth then
+    with Canvas do
+    begin
+      Brush.Color := clSilver;
+      FillRect(Rect(sbVert.Left, sbHorz.Top + 1,
+        sbVert.Left + sbVert.Width, sbHorz.Top + sbHorz.Height));
+    end;
+end;
+
+//--------------------------------------------------------------
+//        FRESH LINE BITMAP
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.FreshLineBitmap;
+var
+  eRect: TRect;
+begin
+  eRect := EditorRect;
+  with FLineBitmap do
+  begin
+    Width := eRect.Right - eRect.Left;
+    Height := FCellSize.H;
+    FLineBitmap.Canvas.Font.Assign(Self.Canvas.Font);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        PAINT
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.Paint;
+var
+  pTop, pBottom: TFullPos;
+  rct, eRect: TRect;
+  i: integer;
+  clipRgn: HRGN;
+  Attrs: string;
+begin
+  if TGLSMemoStrings(Lines).FLockCount > 0 then
+    Exit;
+  with Canvas do
+  begin
+    if FCellSize.H = 0 then
+      SetFont(FFont);
+    FreshLineBitmap;
+
+    Border(Canvas, Rect(0, 0, Width, Height), btLowered);
+    DrawMargin;
+    DrawGutter;
+    DrawScrollBars;
+
+    eRect := EditorRect;
+    clipRgn := CreateRectRgn(eRect.Left, eRect.Top, eRect.Right, eRect.Bottom);
+    ExtSelectClipRgn(Canvas.Handle, clipRgn, RGN_AND);
+    DeleteObject(clipRgn);
+
+    rct := Canvas.ClipRect;
+    pTop := CharFromPos(rct.Left, rct.Top);
+    pBottom := CharFromPos(rct.Left, rct.Bottom);
+
+    if Assigned(FOnGetLineAttrs) then
+      for i := 0 to Lines.Count - 1 do
+        if not ValidAttrs[i] then
+        begin
+          FOnGetLineAttrs(Self, i, Attrs);
+          CharAttrs[i] := Attrs;
+          ValidAttrs[i] := True;
+        end;
+
+    for i := pTop.LineNo to pBottom.LineNo do
+      DrawLine(i);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        GET VISIBLE
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.GetVisible(Index: integer): integer;
+var
+  Coord: TFullPos;
+  Cell: TCellPos;
+  eRect: TRect;
+begin
+  eRect := EditorRect;
+  Coord := CharFromPos(eRect.Right - 1, eRect.Bottom - 1);
+  Cell := CellFromPos(eRect.Right - 1, eRect.Bottom - 1);
+  case Index of
+    0: Result := Cell.X;
+    1: Result := Cell.Y;
+    2: Result := Coord.Pos - 1;
+    3: Result := Coord.LineNo - 1;
+  else
+    Result := 0;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        IS LINE VISIBLE
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.IsLineVisible(LineNo: integer): Boolean;
+begin
+  if FCellSize.H = 0 then
+    SetFont(FFont);
+  Result := (FTopLine <= LineNo) and (LineNo <= LastVisibleLine + 1);
+end;
+
+//--------------------------------------------------------------
+//        MAKE VISIBLE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.MakeVisible;
+var
+  Modified: Boolean;
+begin
+  Modified := False;
+  if CurX < FLeftCol then
+  begin
+    FLeftCol := CurX - 2;
+    if FLeftCol < 0 then
+      FLeftCol := 0;
+    Modified := True;
+  end;
+  if CurX > LastVisiblePos then
+  begin
+    if (FScrollBars in [ssBoth, ssHorizontal]) or
+      (ScrollMode = smAuto) then
+    begin
+      FLeftCol := FLeftCol + CurX - LastVisiblePos + 2;
+    end
+    else
+      CurX := LastVisiblePos;
+    Modified := True;
+  end;
+  if CurY < FTopLine then
+  begin
+    FTopLine := CurY;
+    if FTopLine < 0 then
+      FTopLine := 0;
+    Modified := True;
+  end;
+  if CurY > LastVisibleLine then
+  begin
+    if (FScrollBars in [ssBoth, ssVertical]) or
+      (ScrollMode = smAuto) then
+    begin
+      FTopLine := FTopLine + CurY - LastVisibleLine;
+    end
+    else
+      CurY := LastVisibleLine;
+    Modified := True;
+  end;
+  if Modified then
+    Invalidate;
+end;
+
+//--------------------------------------------------------------
+//        RESIZE EDITOR
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ResizeEditor;
+begin
+  ResizeScrollBars;
+  ResizeGutter;
+  MakeVisible;
+  Invalidate;
+end;
+
+//--------------------------------------------------------------
+//        FIND TEXT
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.FindText(Text: string; Options: TFindOptions; Select:
+  Boolean): Boolean;
+var
+  i, p: integer;
+  s1, s0, s: string;
+  //-----------------------------------------------------------
+  function LastPos(const Substr, s: string): integer;
+  var
+    i, j, lenSub: integer;
+  begin
+    Result := 0;
+    lenSub := Length(Substr);
+    i := Length(s) - lenSub + 1;
+    while i > 0 do
+    begin
+      if s[i] = Substr[1] then
+      begin
+        Result := i;
+        for j := i + 1 to i + lenSub - 1 do
+          if s[j] <> Substr[j - i + 1] then
+          begin
+            Result := 0;
+            break;
+          end;
+      end;
+      if Result <> 0 then
+        break;
+      Dec(i);
+    end;
+  end;
+  //-----------------------------------------------------------
+begin
+  Result := False;
+  if not (frMatchCase in Options) then
+    Text := AnsiLowerCase(Text);
+
+  if SelLength > 0 then
+    ClearSelection;
+  s := Lines[CurY];
+  s0 := Copy(s, 1, CurX);
+  s1 := Copy(s, CurX + 1, Length(s));
+  i := CurY;
+
+  while True do
+  begin
+
+    if not (frMatchCase in Options) then
+    begin
+      s0 := AnsiLowerCase(s0);
+      s1 := AnsiLowerCase(s1);
+    end;
+
+    if frDown in Options then
+      p := Pos(Text, s1)
+    else
+      p := LastPos(Text, s0);
+
+    if p > 0 then
+    begin
+      Result := True;
+      CurY := i;
+      if frDown in Options then
+        CurX := Length(s0) + p - 1
+      else
+        CurX := p - 1;
+      if Select then
+      begin
+        if not (frDown in Options) then
+          CurX := CurX + Length(Text);
+        ClearSelection;
+        if frDown in Options then
+          CurX := CurX + Length(Text)
+        else
+          CurX := CurX - Length(Text);
+        ExpandSelection;
+      end;
+      break;
+    end;
+
+    if frDown in Options then
+      Inc(i)
+    else
+      Dec(i);
+    if (i < 0) or (i > Lines.Count - 1) then
+      break;
+    if frDown in Options then
+    begin
+      s0 := '';
+      s1 := Lines[i];
+    end
+    else
+    begin
+      s0 := Lines[i];
+      s1 := '';
+    end;
+
+  end;
+
+end;
+
+//--------------------------------------------------------------
+//        RESIZE SCROLLBARS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ResizeScrollBars;
+var
+  eRect, sbRect: TRect;
+  MaxLen, OldMax, NewTop, Margin: integer;
+begin
+  eRect := EditorRect;
+  if FScrollBars in [ssBoth, ssVertical] then
+  begin
+    with sbVert do
+    begin
+      Width := 16;
+      Height := eRect.Bottom - eRect.Top + 1;
+      Left := eRect.Right;
+      Top := eRect.Top;
+      OldMax := MaxPosition;
+      MaxPosition := (Lines.Count - 1) - (LastVisibleLine - FTopLine);
+      NewTop := FTopLine;
+      if (FTopLine > 0) and (LastVisibleLine > Lines.Count - 1) then
+      begin
+        Dec(NewTop, LastVisibleLine - (Lines.Count - 1));
+        if NewTop < 0 then
+          NewTop := 0;
+        MaxPosition := NewTop;
+      end;
+      if MaxPosition < 0 then
+        MaxPosition := 0;
+      Position := NewTop;
+      Total := Lines.Count;
+      if OldMax <> MaxPosition then
+      begin
+        if NewTop <> FTopLine then
+        begin
+          DoScroll(sbVert, NewTop - FTopLine);
+          FGutter.Invalidate;
+        end;
+        sbRect := sbVert.FullRect;
+        InvalidateRect(Handle, @sbRect, True);
+      end;
+    end;
+  end;
+  if FScrollBars in [ssBoth, ssHorizontal] then
+  begin
+    MaxLen := MaxLength;
+    with sbHorz do
+    begin
+      Width := Self.Width - 4;
+      if FScrollBars = ssBoth then
+        Width := Width - sbVert.Width;
+      Height := 16;
+      Left := 2;
+      Top := eRect.Bottom;
+      OldMax := MaxPosition;
+
+      Margin := LastVisiblePos - MaxLen;
+      if Margin < 2 then
+        Margin := 2;
+      MaxPosition := MaxLen - (LastVisiblePos - FLeftCol) + Margin;
+
+      if MaxPosition < 0 then
+        MaxPosition := 0;
+      Position := FLeftCol;
+      Total := MaxLen;
+      if OldMax <> MaxPosition then
+      begin
+        if MaxPosition = 0 then
+        begin
+          FLeftCol := 0;
+          InvalidateRect(Handle, @eRect, True);
+          ;
+          FGutter.Invalidate;
+        end;
+        sbRect := sbHorz.FullRect;
+        InvalidateRect(Handle, @sbRect, True);
+      end;
+    end;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        RESIZE GUTTER
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ResizeGutter;
+var
+  eRect: TRect;
+begin
+  eRect := EditorRect;
+  with FGutter do
+  begin
+    Height := eRect.Bottom - eRect.Top;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        CREATE PARAMS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.CreateParams(var Params: TCreateParams);
+begin
+  inherited;
+end;
+
+//--------------------------------------------------------------
+//        UNDO, REDO
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.Undo;
+begin
+  FUndoList.Undo;
+end;
+
+procedure TGLSCustomMemo.Redo;
+begin
+  FUndoList.Redo;
+end;
+
+//--------------------------------------------------------------
+//        SET UNDO LIMIT
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetUndoLimit(Value: integer);
+begin
+  if (FUndoLimit <> Value) then
+  begin
+    if Value <= 0 then
+      Value := 1;
+    if Value > 100 then
+      Value := 100;
+    FUndoLimit := Value;
+    FUndoList.Limit := Value;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        UNDO (REDO) CHANGE
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.UndoChange;
+begin
+  if Assigned(FOnUndoChange) then
+    FOnUndoChange(Self, FUndoList.Pos < FUndoList.Count,
+      FUndoList.Pos > 0);
+end;
+
+//--------------------------------------------------------------
+//        CAN UNDO
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.CanUndo: boolean;
+begin
+  Result := FUndoList.FPos < FUndoList.Count;
+end;
+
+//--------------------------------------------------------------
+//        CAN REDO
+//--------------------------------------------------------------
+
+function TGLSCustomMemo.CanRedo: Boolean;
+begin
+  Result := FUndoList.FPos > 0;
+end;
+
+//--------------------------------------------------------------
+//        CLEAR UNDO LIST
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.ClearUndoList;
+begin
+  if Assigned(FUndoList) then
+    FUndoList.Clear;
+end;
+
+//--------------------------------------------------------------
+//        SET SCROLL BARS
+//--------------------------------------------------------------
+
+procedure TGLSCustomMemo.SetScrollBars(Value: System.UITypes.TScrollStyle);
+begin
+  if FScrollBars <> Value then
+  begin
+    FScrollBars := Value;
+    if not (csLoading in ComponentState) then
+      ResizeEditor;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        CREATE
+//--------------------------------------------------------------
+
+constructor TGLSCustomMemo.Create(AOwner: TComponent);
+begin
+  inherited;
+
+  ControlStyle := [csCaptureMouse, csClickEvents,
+    csDoubleClicks, csReplicatable];
+  Width := 100;
+  Height := 40;
+  TabStop := True;
+  Cursor := crIBeam;
+
+  FFont := TFont.Create;
+  FFont.Name := 'Courier New';
+  FFont.Size := 10;
+  Canvas.Font.Assign(FFont);
+
+  FHiddenCaret := False;
+  FCaretVisible := False;
+
+  FCurX := 0;
+  FCurY := 0;
+  FLeftCol := 0;
+  FTopLine := 0;
+  FTabSize := 4;
+  FMargin := 2;
+  FAutoIndent := True;
+  FLines := TGLSMemoStrings.Create;
+  TGLSMemoStrings(FLines).FMemo := Self;
+
+  FScrollBars := ssBoth;
+  FScrollBarWidth := 16;
+  sbVert := TGLSMemoScrollBar.Create(Self, sbVertical);
+  sbVert.Width := FScrollBarWidth;
+  sbHorz := TGLSMemoScrollBar.Create(Self, sbHorizontal);
+  sbHorz.Height := FScrollBarWidth;
+
+  FGutter := TGLSMemoGutter.Create;
+  with FGutter do
+  begin
+    FLeft := 2;
+    FTop := 2;
+    FWidth := 0;
+    FHeight := 0;
+    FColor := clBtnFace;
+    FMemo := Self;
+  end;
+
+  FSelStartX := 0;
+  FSelStartY := 0;
+  FSelEndX := 0;
+  FSelEndY := 0;
+
+  FBkColor := clWhite;
+  FSelColor := clWhite;
+  FSelBkColor := clNavy;
+
+  FStyles := TStyleList.Create;
+  FStyles.Add(clBlack, clWhite, []);
+
+  FSelCharPos.LineNo := -1;
+  FSelCharPos.Pos := -1;
+  FSelCharStyle := -1;
+
+  FLineBitmap := TBitmap.Create;
+
+  FLeftButtonDown := False;
+  FScrollMode := smAuto;
+
+  FUndoList := TGLSMemoUndoList.Create;
+  FFirstUndoList := FUndoList;
+  FUndoList.Memo := Self;
+
+  FUndoLimit := 100;
+
+  TGLSMemoStrings(FLines).DoAdd('');
+
+  FAfterDoubleClick := False;
+
+end;
+
+//--------------------------------------------------------------
+//        DESTROY
+//--------------------------------------------------------------
+
+destructor TGLSCustomMemo.Destroy;
+begin
+  FFont.Free;
+  FLines.Free;
+  FGutter.Free;
+  sbVert.Free;
+  sbHorz.Free;
+  FStyles.Free;
+  FLineBitmap.Free;
+  FFirstUndoList.Free;
+  inherited;
+end;
+
+ 
+
+// ---------------------TGLSMemoScrollBar functions 
+
+procedure TGLSMemoScrollBar.SetParams(Index: integer; Value: integer);
+begin
+  case Index of
+    0: if Left <> Value then
+        FLeft := Value;
+    1: if Top <> Value then
+        FTop := Value;
+    2: if Width <> Value then
+        FWidth := Value;
+    3: if Height <> Value then
+        FHeight := Value;
+    4: if Total <> Value then
+        FTotal := Value;
+    5: if MaxPosition <> Value then
+        FMaxPosition := Value;
+    6: if Position <> Value then
+        FPosition := Value;
+  end;
+end;
+//-------------------- CREATE ------------------------------
+
+constructor TGLSMemoScrollBar.Create(AParent: TGLSMemoAbstractScrollableObject;
+  AKind: TScrollBarKind);
+begin
+  FParent := AParent;
+  FButtonLength := 16;
+  FKind := AKind;
+  FState := sbsWait;
+end;
+//-------------------- RECT -----------------------
+
+function TGLSMemoScrollBar.GetRect: TRect;
+begin
+  Result := Rect(Left, Top, Left + Width, Top + Height);
+end;
+//-------------------- GET THUMB RECT -----------------------
+
+function TGLSMemoScrollBar.GetThumbRect: TRect;
+var
+  TotalLen, FreeLen, ThumbLen, ThumbOffset, ThumbCoord: integer;
+  K: double;
+begin
+  if MaxPosition <= 0 then
+  begin
+    Result := Rect(0, 0, 0, 0);
+    Exit;
+  end;
+  if Kind = sbVertical then
+    TotalLen := Height
+  else
+    TotalLen := Width;
+  FreeLen := TotalLen - 2 * FButtonLength;
+
+  K := (Total - MaxPosition) / MaxPosition;
+  if K > 0 then
+  begin
+    ThumbLen := round(FreeLen * K / (1 + K));
+    if ThumbLen < 8 then
+      ThumbLen := 8;
+  end
+  else
+    ThumbLen := 8;
+
+  if ThumbLen >= FreeLen then
+    Result := Rect(0, 0, 0, 0)
+  else
+  begin
+    ThumbOffset := round((FreeLen - ThumbLen) * Position / MaxPosition);
+    ThumbCoord := FButtonLength + ThumbOffset;
+    if Kind = sbVertical then
+      Result := Rect(Left + 1, Top + ThumbCoord, Left + Width, Top + ThumbCoord
+        + ThumbLen)
+    else
+      Result := Rect(Left + ThumbCoord, Top + 1, Left + ThumbCoord + ThumbLen,
+        Top + Height);
+  end;
+end;
+//-------------------- GET Back RECT -----------------------
+
+function TGLSMemoScrollBar.GetBackRect: TRect;
+begin
+  if Kind = sbVertical then
+    Result := Rect(Left + 1, Top, Left + Width, Top + FButtonLength)
+  else
+    Result := Rect(Left, Top + 1, Left + FButtonLength, Top + Height);
+end;
+//-------------------- GET MIDDLE RECT -----------------------
+
+function TGLSMemoScrollBar.GetMiddleRect: TRect;
+var
+  bRect, fRect: TRect;
+begin
+  bRect := BackRect;
+  fRect := ForwardRect;
+  if Kind = sbVertical then
+    Result := Rect(Left + 1, bRect.Bottom, Left + Width, fRect.Top)
+  else
+    Result := Rect(bRect.Right, Top + 1, fRect.Left, Top + Height);
+end;
+//-------------------- GET Forward RECT -----------------------
+
+function TGLSMemoScrollBar.GetForwardRect: TRect;
+begin
+  if Kind = sbVertical then
+    Result := Rect(Left + 1, Top + Height - FButtonLength, Left + Width, Top +
+      Height)
+  else
+    Result := Rect(Left + Width - FButtonLength, Top + 1, Left + Width, Top +
+      Height);
+end;
+//-------------------- GET PAGE BACK RECT -----------------------
+
+function TGLSMemoScrollBar.GetPgBackRect: TRect;
+var
+  thRect: TRect;
+begin
+  thRect := GetThumbRect;
+  if thRect.Bottom = 0 then
+  begin
+    Result := Rect(0, 0, 0, 0);
+    Exit;
+  end;
+  if Kind = sbVertical then
+    Result := Rect(Left + 1, Top + FButtonLength, Left + Width, thRect.Top - 1)
+  else
+    Result := Rect(Left + FButtonLength, Top + 1, thRect.Left - 1, Top +
+      Height);
+end;
+//-------------------- GET PG FORWARD RECT -----------------------
+
+function TGLSMemoScrollBar.GetPgForwardRect: TRect;
+var
+  thRect: TRect;
+begin
+  thRect := GetThumbRect;
+  if thRect.Bottom = 0 then
+  begin
+    Result := Rect(0, 0, 0, 0);
+    Exit;
+  end;
+  if Kind = sbVertical then
+    Result := Rect(Left + 1, thRect.Bottom, Left + Width, Top + Height -
+      FButtonLength)
+  else
+    Result := Rect(thRect.Right, Top + 1, Left + Width - FButtonLength, Top +
+      Height);
+end;
+//-------------------- PAINT TO -----------------------
+
+procedure TGLSMemoScrollBar.PaintTo(ACanvas: TCanvas);
+var
+  sRect, mRect, gRect, thRect: TRect;
+  iconX, iconY, shift: integer;
+begin
+  with ACanvas do
+  begin
+    if Kind = sbVertical then
+    begin
+      Pen.Color := clSilver;
+      MoveTo(Left, Top);
+      LineTo(Left, Top + Height);
+
+      sRect := BackRect;
+      Brush.Color := clSilver;
+      FillRect(sRect);
+      if State = sbsBack then
+      begin
+        shift := 1;
+        Pen.Color := clGray;
+        with sRect do
+          Rectangle(Left, Top, Right, Bottom);
+      end
+      else
+      begin
+        shift := 0;
+        Border(ACanvas, sRect, btFlatRaised);
+      end;
+      iconX := sRect.Left + (Width - 1 - 7) div 2;
+      iconY := sRect.Top + (FButtonLength - 8) div 2;
+      Draw(iconX + shift, iconY + shift, bmScrollBarUp);
+
+      gRect := ForwardRect;
+      Brush.Color := clSilver;
+      FillRect(gRect);
+      if State = sbsForward then
+      begin
+        shift := 1;
+        Pen.Color := clGray;
+        with gRect do
+          Rectangle(Left, Top, Right, Bottom);
+      end
+      else
+      begin
+        shift := 0;
+        Border(ACanvas, gRect, btFlatRaised);
+      end;
+      iconX := gRect.Left + (Width - 1 - 7) div 2;
+      iconY := gRect.Top + (FButtonLength - 8) div 2;
+      Draw(iconX + shift, iconY + shift, bmScrollBarDown);
+
+      mRect := Rect(sRect.Left, sRect.Bottom, gRect.Right, gRect.Top);
+    end
+    else
+    begin
+      Pen.Color := clSilver;
+      MoveTo(Left, Top);
+      LineTo(Left + Width, Top);
+
+      sRect := BackRect;
+      Brush.Color := clSilver;
+      FillRect(sRect);
+      if State = sbsBack then
+      begin
+        shift := 1;
+        Pen.Color := clGray;
+        with sRect do
+          Rectangle(Left, Top, Right, Bottom);
+      end
+      else
+      begin
+        shift := 0;
+        Border(ACanvas, sRect, btFlatRaised);
+      end;
+      iconX := sRect.Left + shift + (FButtonLength - 8) div 2;
+      iconY := sRect.Top + shift + (Height - 1 - 7) div 2;
+      Draw(iconX + shift, iconY + shift, bmScrollBarLeft);
+
+      gRect := ForwardRect;
+      Brush.Color := clSilver;
+      FillRect(gRect);
+      if State = sbsForward then
+      begin
+        shift := 1;
+        Pen.Color := clGray;
+        with gRect do
+          Rectangle(Left, Top, Right, Bottom);
+      end
+      else
+      begin
+        shift := 0;
+        Border(ACanvas, gRect, btFlatRaised);
+      end;
+      iconX := gRect.Left + (FButtonLength - 8) div 2;
+      iconY := gRect.Top + (Height - 1 - 7) div 2;
+      Draw(iconX + shift, iconY + shift, bmScrollBarRight);
+
+      mRect := Rect(sRect.Right, sRect.Top, gRect.Left, gRect.Bottom);
+    end;
+
+    Brush.Bitmap := bmScrollBarFill;
+    FillRect(mRect);
+    Brush.Bitmap := nil;
+    if State = sbsPageBack then
+    begin
+      Brush.Color := clGray;
+      FillRect(PageBackRect);
+    end;
+    if State = sbsPageForward then
+    begin
+      Brush.Color := clGray;
+      FillRect(PageForwardRect);
+    end;
+
+    thRect := ThumbRect;
+    Brush.Color := clSilver;
+    FillRect(thRect);
+    Border(ACanvas, thRect, btFlatRaised);
+  end;
+end;
+//-------------------- SET STATE ----------
+
+procedure TGLSMemoScrollBar.SetState(Value: TsbState);
+begin
+  if FState <> Value then
+  begin
+    FState := Value;
+  end;
+end;
+//-------------------- MOUSE DOWN ------------
+
+function TGLSMemoScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X,
+  Y: Integer):
+  Boolean;
+var
+  sRect, gRect, thRect, pbRect, pfRect: TRect;
+begin
+  Result := False;
+  if (Width = 0) or (Height = 0) then
+    Exit;
+  sRect := BackRect;
+  gRect := ForwardRect;
+  pbRect := PageBackRect;
+  pfRect := PageForwardRect;
+  thRect := ThumbRect;
+  if PointInRect(Point(X, Y), sRect) then
+  begin
+    State := sbsBack;
+    InvalidateRect(Parent.Handle, @sRect, True);
+    Result := True;
+    Exit;
+  end;
+  if PointInRect(Point(X, Y), gRect) then
+  begin
+    State := sbsForward;
+    InvalidateRect(Parent.Handle, @gRect, True);
+    Result := True;
+    Exit;
+  end;
+  if PointInRect(Point(X, Y), pbRect) then
+  begin
+    State := sbsPageBack;
+    InvalidateRect(Parent.Handle, @pbRect, True);
+    Result := True;
+    Exit;
+  end;
+  if PointInRect(Point(X, Y), pfRect) then
+  begin
+    State := sbsPageForward;
+    InvalidateRect(Parent.Handle, @pfRect, True);
+    Result := True;
+    Exit;
+  end;
+  if PointInRect(Point(X, Y), thRect) then
+  begin
+    State := sbsDragging;
+    FXOffset := X - thRect.Left;
+    FYOffset := Y - thRect.Top;
+    Result := True;
+    Exit;
+  end;
+
+end;
+//-------------------- MOUSE UP ----------
+
+function TGLSMemoScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
+  Y:
+  Integer):
+  Boolean;
+var
+  sRect, gRect, thRect, pbRect, pfRect: TRect;
+begin
+  Result := False;
+  if (Width = 0) or (Height = 0) then
+    Exit;
+  sRect := BackRect;
+  gRect := ForwardRect;
+  pbRect := PageBackRect;
+  pfRect := PageForwardRect;
+  thRect := ThumbRect;
+  case State of
+    sbsBack:
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @sRect, True);
+        FParent.DoScroll(Self, -1);
+        Result := True;
+        Exit;
+      end;
+    sbsForward:
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @gRect, True);
+        FParent.DoScroll(Self, 1);
+        Result := True;
+        Exit;
+      end;
+    sbsPageBack:
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @pbRect, True);
+        FParent.DoScrollPage(Self, -1);
+        Result := True;
+        Exit;
+      end;
+    sbsPageForward:
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @pfRect, True);
+        FParent.DoScrollPage(Self, 1);
+        Result := True;
+        Exit;
+      end;
+    sbsDragging:
+      begin
+        State := sbsWait;
+        Result := True;
+        Exit;
+      end;
+  end;
+end;
+//-------------------- MOUSE MOVE -----------
+
+function TGLSMemoScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer):
+  Boolean;
+var
+  sRect, gRect, thRect, pbRect, pfRect: TRect;
+begin
+  Result := False;
+  if (Width = 0) or (Height = 0) then
+    Exit;
+  sRect := BackRect;
+  gRect := ForwardRect;
+  pbRect := PageBackRect;
+  pfRect := PageForwardRect;
+  thRect := ThumbRect;
+  case State of
+    sbsBack:
+      if not PointInRect(Point(X, Y), sRect) then
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @sRect, True);
+        Result := True;
+        Exit;
+      end;
+    sbsForward:
+      if not PointInRect(Point(X, Y), gRect) then
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @gRect, True);
+        Result := True;
+        Exit;
+      end;
+    sbsPageBack:
+      if not PointInRect(Point(X, Y), pbRect) then
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @pbRect, True);
+        Result := True;
+        Exit;
+      end;
+    sbsPageForward:
+      if not PointInRect(Point(X, Y), pfRect) then
+      begin
+        State := sbsWait;
+        InvalidateRect(Parent.Handle, @pfRect, True);
+        Result := True;
+        Exit;
+      end;
+    sbsDragging:
+      begin
+        MoveThumbTo(X, Y);
+        Result := True;
+        Exit;
+      end;
+  end;
+end;
+//-------------------- MOVE THUMB TO ------------
+
+function TGLSMemoScrollBar.MoveThumbTo(X, Y: Integer): integer;
+var
+  thRect, mRect: TRect;
+  FreeLen, ThumbLen, NewPosition, NewOffset: integer;
+begin
+  thRect := ThumbRect;
+  mRect := MiddleRect;
+  NewOffset := 0;
+  FreeLen := 0;
+  ThumbLen := 0;
+  case Kind of
+    sbVertical:
+      begin
+        FreeLen := mRect.Bottom - mRect.Top;
+        ThumbLen := thRect.Bottom - thRect.Top;
+        NewOffset := Y - FYOffset - (Top + FButtonLength);
+      end;
+    sbHorizontal:
+      begin
+        FreeLen := mRect.Right - mRect.Left;
+        ThumbLen := thRect.Right - thRect.Left;
+        NewOffset := X - FXOffset - (Left + FButtonLength);
+      end
+  end;
+  NewPosition := round(NewOffset * MaxPosition / (FreeLen - ThumbLen));
+  Result := NewPosition - Position;
+  if NewPosition <> Position then
+  begin
+    Parent.DoScroll(Self, NewPosition - Position);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        GUTTER
+//--------------------------------------------------------------
+//-------------------- SET PARAMS -----------------------
+
+procedure TGLSMemoGutter.SetParams(Index: integer; Value: integer);
+begin
+  case Index of
+    0: FLeft := Value;
+    1: FTop := Value;
+    2: FWidth := Value;
+    3: FHeight := Value;
+  end;
+end;
+//-------------------- PAINT TO -----------------------
+
+procedure TGLSMemoGutter.PaintTo(ACanvas: TCanvas);
+var
+  LineNo, T, H: integer;
+begin
+  with ACanvas do
+  begin
+    Pen.Color := clGray;
+    MoveTo(Left + Width - 1, Top);
+    LineTo(Left + Width - 1, Top + Height);
+    Pen.Color := clWhite;
+    MoveTo(Left + Width - 2, Top);
+    LineTo(Left + Width - 2, Top + Height);
+    Brush.Color := Self.FColor;
+    FillRect(Rect(Left, Top, Left + Width - 2, Top + Height));
+    if Assigned(FMemo.OnGutterDraw) then
+    begin
+      T := Top;
+      H := FMemo.FCellSize.H;
+      LineNo := FMemo.FTopLine;
+      while T < Top + Height do
+      begin
+        FMemo.OnGutterDraw(FMemo, ACanvas, LineNo,
+          Rect(Left, T, Left + Width - 2, T + H));
+        T := T + H;
+        Inc(LineNo);
+        if LineNo >= FMemo.Lines.Count then
+          break;
+      end;
+    end;
+  end;
+end;
+
+//-------------------- INVALIDATE -----------------------
+
+procedure TGLSMemoGutter.Invalidate;
+var
+  gRect: TRect;
+begin
+  gRect := Rect(Left, Top, Left + Width, Top + Height);
+  InvalidateRect(FMemo.Handle, @gRect, True);
+end;
+
+//-------------------- GET RECT -----------------------
+
+function TGLSMemoGutter.GetRect: TRect;
+begin
+  Result := Rect(Left, Top, Left + Width, Top + Height);
+end;
+
+ 
+
+// ---------------------TStyleList 
+
+procedure TStyleList.CheckRange(Index: integer);
+begin
+  if (Index < 0) or (Index >= Count) then
+    raise EListError.Create('Incorrect list item index ' + IntToStr(Index));
+end;
+//-------------------- DESTROY ---------------------------
+
+destructor TStyleList.Destroy;
+begin
+  Clear;
+  inherited;
+end;
+//-------------------- CHANGE ---------------------------
+
+procedure TStyleList.Change(Index: integer; ATextColor, ABkCOlor: TColor;
+  AStyle: TFontStyles);
+var
+  P: TCharStyle;
+begin
+  CheckRange(Index);
+  P := TCharStyle(Items[Index]);
+  P.TextColor := ATextColor;
+  P.BkColor := ABkColor;
+  P.Style := AStyle;
+end;
+//-------------------- ADD ---------------------------
+
+function TStyleList.Add(ATextColor, ABkColor: TColor; AStyle: TFontStyles):
+  Integer;
+var
+  P: TCharStyle;
+begin
+  P := TCharStyle.Create;
+  with P do
+  begin
+    TextColor := ATextColor;
+    BkColor := ABkColor;
+    Style := AStyle;
+  end;
+  Result := inherited Add(P);
+end;
+//-------------------- CLEAR ---------------------------
+
+procedure TStyleList.Clear;
+begin
+  while Count > 0 do
+    Delete(0);
+end;
+//-------------------- DELETE ---------------------------
+
+procedure TStyleList.Delete(Index: Integer);
+var
+  P: TCharStyle;
+begin
+  CheckRange(Index);
+  P := TCharStyle(Items[Index]);
+  P.Free;
+  inherited;
+end;
+//-------------------- GET/SET TEXT COLOR ---------------------------
+
+function TStyleList.GetTextColor(Index: Integer): TColor;
+begin
+  CheckRange(Index);
+  Result := TCharStyle(Items[Index]).TextColor;
+end;
+
+procedure TStyleList.SetTextColor(Index: Integer; Value: TColor);
+begin
+  CheckRange(Index);
+  TCharStyle(Items[Index]).TextColor := Value;
+end;
+//-------------------- GET/SET BK COLOR ---------------------------
+
+function TStyleList.GetBkColor(Index: Integer): TColor;
+begin
+  CheckRange(Index);
+  Result := TCharStyle(Items[Index]).BkColor;
+end;
+
+procedure TStyleList.SetBkColor(Index: Integer; Value: TColor);
+begin
+  CheckRange(Index);
+  TCharStyle(Items[Index]).BkColor := Value;
+end;
+//-------------------- GET/SET STYLE ---------------------------
+
+function TStyleList.GetStyle(Index: Integer): TFontStyles;
+begin
+  CheckRange(Index);
+  Result := TCharStyle(Items[Index]).Style;
+end;
+
+procedure TStyleList.SetStyle(Index: Integer; Value: TFontStyles);
+begin
+  CheckRange(Index);
+  TCharStyle(Items[Index]).Style := Value;
+end;
+
+ 
+
+// ---------------------TGLSMemoStrings 
+
+destructor TGLSMemoStrings.Destroy;
+var
+  P: TObject;
+begin
+  while Count > 0 do
+  begin
+    P := inherited GetObject(0);
+    P.Free;
+    inherited Delete(0);
+  end;
+  inherited;
+end;
+//-------------------- CLEAR ----------------------
+
+procedure TGLSMemoStrings.Clear;
+begin
+  while Count > 0 do
+  begin
+    Delete(0);
+    if (Count = 1) and (Strings[0] = '') then
+      break;
+  end;
+end;
+
+//-------------------- ASSIGN ----------------------
+
+procedure TGLSMemoStrings.Assign(Source: TPersistent);
+var
+  P: TObject;
+begin
+  if Source is TStrings then
+  begin
+    BeginUpdate;
+    try
+      while Count > 0 do
+      begin
+        P := inherited GetObject(0);
+        P.Free;
+        inherited Delete(0);
+      end;
+      //      inherited Clear;
+      AddStrings(TStrings(Source));
+    finally
+      EndUpdate;
+    end;
+    Exit;
+  end;
+  inherited Assign(Source);
+end;
+
+//-------------------- ADD ----------------------
+
+function TGLSMemoStrings.DoAdd(const S: string): Integer;
+begin
+  Result := inherited AddObject(S, nil);
+end;
+//-------------------- ADD ----------------------
+
+function TGLSMemoStrings.Add(const S: string): Integer;
+begin
+  if Assigned(FMemo.Parent) then
+    Result := FMemo.AddString(S)
+  else
+    Result := DoAdd(S);
+end;
+//-------------------- OBJECT ----------------------
+
+function TGLSMemoStrings.AddObject(const S: string; AObject: TObject): Integer;
+begin
+  if AObject <> nil then
+    raise EInvalidOp.Create(SObjectsNotSupported);
+  Result := DoAdd(S);
+end;
+//-------------------- INSERT ----------------------
+
+procedure TGLSMemoStrings.InsertObject(Index: Integer;
+  const S: string; AObject: TObject);
+begin
+  if AObject <> nil then
+    raise EInvalidOp.Create(SObjectsNotSupported);
+  DoInsert(Index, S);
+end;
+//-------------------- DO INSERT ----------------------
+
+procedure TGLSMemoStrings.DoInsert(Index: Integer; const S: string);
+begin
+  InsertItem(Index, S, nil);
+end;
+//-------------------- INSERT ----------------------
+
+procedure TGLSMemoStrings.Insert(Index: Integer; const S: string);
+begin
+  if Assigned(FMemo) then
+    FMemo.InsertString(Index, S)
+  else
+    DoInsert(Index, S);
+end;
+//-------------------- DELETE ----------------------
+
+procedure TGLSMemoStrings.Delete(Index: Integer);
+var
+  P: TObject;
+begin
+  if (Index < 0) or (Index > Count - 1) then
+    Exit;
+  if FDeleting or (not Assigned(FMemo)) then
+  begin
+    P := inherited GetObject(Index);
+    P.Free;
+    inherited;
+  end
+  else
+  begin
+    FMemo.DeleteLine(Index, -1, -1, -1, -1, True);
+  end;
+end;
+//-------------------- LOAD FROM FILE ----------------------
+
+procedure TGLSMemoStrings.LoadFromFile(const FileName: string);
+begin
+  with FMemo do
+  begin
+    ClearSelection;
+    ClearUndoList;
+    CurX := 0;
+    CurY := 0;
+  end;
+  Clear;
+  inherited;
+  FMemo.Invalidate;
+end;
+//-------------------- SET UPDATE STATE ----------------------
+
+procedure TGLSMemoStrings.SetUpdateState(Updating: Boolean);
+begin
+  if Updating then
+    Inc(FLockCount)
+  else if FLockCount > 0 then
+    Dec(FLockCount);
+end;
+//-------------------- CHECK RANGE ---------------------------
+
+procedure TGLSMemoStrings.CheckRange(Index: integer);
+begin
+  if (Index < 0) or (Index >= Count) then
+    raise EListError('Incorrect index of list item ' + IntToStr(Index));
+end;
+//-------------------- GET OBJECT ---------------------------
+
+function TGLSMemoStrings.GetObject(Index: Integer): TObject;
+begin
+  CheckRange(Index);
+  Result := inherited GetObject(Index);
+  if Assigned(Result) and (Result is TLineProp) then
+    Result := TLineProp(Result).FObject;
+end;
+//-------------------- PUT OBJECT ---------------------------
+
+procedure TGLSMemoStrings.PutObject(Index: Integer; AObject: TObject);
+var
+  P: TObject;
+begin
+  CheckRange(Index);
+  P := Objects[Index];
+  if Assigned(P) and (P is TLineProp) then
+    TLineProp(P).FObject := AObject
+  else
+    inherited PutObject(Index, AObject);
+end;
+//-------------------- GET LINE PROP ---------------------------
+
+function TGLSMemoStrings.GetLineProp(Index: integer): TLineProp;
+var
+  P: TObject;
+begin
+  CheckRange(Index);
+  Result := nil;
+  P := inherited GetObject(Index);
+  if Assigned(P) and (P is TLineProp) then
+    Result := TLineProp(P);
+end;
+
+//-------------------- CREATE PROP --------------------------
+
+function TGLSMemoStrings.CreateProp(Index: integer): TLineProp;
+begin
+  Result := TLineProp.Create;
+  with Result do
+  begin
+    FStyleNo := 0;
+    FInComment := False;
+    FInBrackets := -1;
+    FValidAttrs := False;
+    FCharAttrs := '';
+    FObject := Objects[Index];
+  end;
+  inherited PutObject(Index, Result);
+end;
+
+//-------------------- GET LINE STYLE --------------------------
+
+function TGLSMemoStrings.GetLineStyle(Index: integer): integer;
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    Result := 0
+  else
+    Result := P.FStyleNo;
+end;
+
+//-------------------- SET LINE STYLE --------------------------
+
+procedure TGLSMemoStrings.SetLineStyle(Index: integer; Value: integer);
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    P := CreateProp(Index);
+  P.FStyleNo := Value;
+end;
+
+//-------------------- GET/SET IN COMMENT ---------------------------
+
+function TGLSMemoStrings.GetInComment(Index: Integer): Boolean;
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    Result := False
+  else
+    Result := P.FInComment;
+end;
+
+procedure TGLSMemoStrings.SetInComment(Index: Integer; Value: Boolean);
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    P := CreateProp(Index);
+  P.FInComment := Value;
+end;
+
+//-------------------- GET/SET IN BRACKETS ---------------------------
+
+function TGLSMemoStrings.GetInBrackets(Index: Integer): integer;
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    Result := -1
+  else
+    Result := P.FInBrackets;
+end;
+
+procedure TGLSMemoStrings.SetInBrackets(Index: Integer; Value: integer);
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    P := CreateProp(Index);
+  P.FInBrackets := Value;
+end;
+
+//-------------------- GET/SET VALID ATTRS ---------------------------
+
+function TGLSMemoStrings.GetValidAttrs(Index: Integer): Boolean;
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    Result := False
+  else
+    Result := P.FValidAttrs;
+end;
+
+procedure TGLSMemoStrings.SetValidAttrs(Index: Integer; Value: Boolean);
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    P := CreateProp(Index);
+  P.FValidAttrs := Value;
+end;
+//-------------------- GET/SET CHAR ATTRS ---------------------------
+
+function TGLSMemoStrings.GetCharAttrs(Index: Integer): string;
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    Result := ''
+  else
+    Result := P.FCharAttrs;
+end;
+
+procedure TGLSMemoStrings.SetCharAttrs(Index: Integer; const Value: string);
+var
+  P: TLineProp;
+begin
+  P := LineProp[Index];
+  if P = nil then
+    P := CreateProp(Index);
+  P.FCharAttrs := Value;
+end;
+
+ 
+
+// ---------------------TGLSMemoUndo 
+
+constructor TGLSMemoUndo.Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
+  string);
+begin
+  inherited Create;
+  FUndoCurX0 := ACurX0;
+  FUndoCurY0 := ACurY0;
+  FUndoCurX := ACurX;
+  FUndoCurY := ACurY;
+  FUndoText := AText;
+end;
+
+procedure TGLSMemoUndo.Undo;
+begin
+  if Assigned(FMemo) then
+    with FMemo do
+    begin
+      CurY := FUndoCurY;
+      CurX := FUndoCurX;
+      PerformUndo;
+      CurY := FUndoCurY0;
+      CurX := FUndoCurX0;
+    end;
+end;
+
+procedure TGLSMemoUndo.Redo;
+begin
+  if Assigned(FMemo) then
+    with FMemo do
+    begin
+      CurY := FUndoCurY0;
+      CurX := FUndoCurX0;
+      PerformRedo;
+      CurY := FUndoCurY;
+      CurX := FUndoCurX;
+    end;
+end;
+
+function TGLSMemoUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
+begin
+  Result := False;
+end;
+
+//----------------  TINSERT CHAR UNDO --------------------------
+
+procedure TGLSMemoInsCharUndo.PerformUndo;
+var
+  i: integer;
+  CurrLine: string;
+begin
+  for i := Length(FUndoText) downto 1 do
+  begin
+    CurrLine := FMemo.Lines[FMemo.CurY];
+    if ((FUndoText[i] = #13) and (FMemo.CurX = 0)) or
+      (FUndoText[i] = CurrLine[FMemo.CurX]) then
+      FMemo.BackSpace;
+  end;
+end;
+
+procedure TGLSMemoInsCharUndo.PerformRedo;
+var
+  i: integer;
+begin
+  with FMemo do
+    for i := 1 to Length(FUndoText) do
+      if FUndoText[i] = #13 then
+        NewLine
+      else
+        InsertChar(FUndoText[i]);
+end;
+
+function TGLSMemoInsCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
+begin
+  Result := False;
+  if not ((NewUndo is TGLSMemoInsCharUndo) and
+    (NewUndo.UndoCurX0 = FUndoCurX) and
+    (NewUndo.UndoCurY0 = FUndoCurY)) then
+    Exit;
+  FUndoText := FUndoText + NewUndo.FUndoText;
+  FUndoCurX := NewUndo.UndoCurX;
+  FUndoCurY := NewUndo.UndoCurY;
+  Result := True;
+end;
+
+//----------------  TDELETE CHAR UNDO --------------------------
+
+procedure TGLSMemoDelCharUndo.PerformUndo;
+var
+  i: integer;
+begin
+  with FMemo do
+    for i := 1 to Length(FUndoText) do
+    begin
+      if not FIsBackspace then
+      begin
+        CurY := FUndoCurY0;
+        CurX := FUndoCurX0;
+      end;
+      if FUndoText[i] = #13 then
+        NewLine
+      else
+        InsertChar(FUndoText[i]);
+    end;
+end;
+
+procedure TGLSMemoDelCharUndo.PerformRedo;
+var
+  i: integer;
+begin
+  with FMemo do
+    for i := 1 to Length(FUndoText) do
+      if FIsBackspace then
+        BackSpace
+      else
+        DeleteChar(-1, -1);
+end;
+
+function TGLSMemoDelCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
+begin
+  Result := False;
+  if not ((NewUndo is TGLSMemoDelCharUndo) and
+    (NewUndo.UndoCurX0 = FUndoCurX) and
+    (NewUndo.UndoCurY0 = FUndoCurY)) then
+    Exit;
+  if TGLSMemoDelCharUndo(NewUndo).FIsBackspace <> FIsBackspace then
+    Exit;
+  FUndoText := NewUndo.FUndoText + FUndoText;
+  FUndoCurX := NewUndo.UndoCurX;
+  FUndoCurY := NewUndo.UndoCurY;
+  Result := True;
+end;
+
+//----------------  TDELETE BUF, LINE UNDO --------------------------
+
+constructor TGLSMemoDelLineUndo.Create(AIndex, ACurX0, ACurY0, ACurX, ACurY:
+  integer; const AText: string);
+begin
+  inherited Create(ACurX0, ACurY0, ACurX, ACurY, AText);
+  FIndex := AIndex;
+end;
+
+procedure TGLSMemoDelLineUndo.PerformUndo;
+var
+  SaveCurX: integer;
+begin
+  with FMemo do
+  begin
+    SaveCurX := CurX;
+    CurX := 0;
+    ClearSelection;
+    SetSelText(PChar(FUndoText + #13#10));
+    CurX := SaveCurX;
+  end;
+end;
+
+procedure TGLSMemoDelLineUndo.PerformRedo;
+begin
+  FMemo.DeleteLine(FIndex, FUndoCurX0, FUndoCurY0, FUndoCurX, FUndoCurY, True);
+end;
+
+procedure TGLSMemoDeleteBufUndo.PerformUndo;
+begin
+  with FMemo do
+  begin
+    ClearSelection;
+    SetSelText(PChar(FUndoText));
+  end;
+end;
+
+procedure TGLSMemoDeleteBufUndo.PerformRedo;
+begin
+  with FMemo do
+  begin
+    FSelStartX := FUndoSelStartX;
+    FSelStartY := FUndoSelStartY;
+    FSelEndX := FUndoSelEndX;
+    FSelEndY := FUndoSelEndY;
+    DeleteSelection(True);
+  end;
+end;
+
+//----------------  TPASTE UNDO --------------------------
+
+procedure TGLSMemoPasteUndo.PerformUndo;
+begin
+  with FMemo do
+  begin
+    FSelStartX := FUndoCurX0;
+    FSelStartY := FUndoCurY0;
+    FSelEndX := FUndoCurX;
+    FSelEndY := FUndoCurY;
+    DeleteSelection(True);
+  end;
+end;
+
+procedure TGLSMemoPasteUndo.PerformRedo;
+begin
+  with FMemo do
+  begin
+    ClearSelection;
+    SetSelText(PChar(FUndoText));
+  end;
+end;
+
+//----------------  TUNDO LIST --------------------------
+
+constructor TGLSMemoUndoList.Create;
+begin
+  inherited;
+  FPos := 0;
+  FIsPerforming := False;
+  FLimit := 100;
+end;
+
+destructor TGLSMemoUndoList.Destroy;
+begin
+  Clear;
+  inherited;
+end;
+
+function TGLSMemoUndoList.Get(Index: Integer): TGLSMemoUndo;
+begin
+  Result := TGLSMemoUndo(inherited Get(Index));
+end;
+
+function TGLSMemoUndoList.Add(Item: Pointer): Integer;
+begin
+  Result := -1;
+  if FIsPerforming then
+  begin
+    TGLSMemoUndo(Item).Free;
+    Exit;
+  end;
+
+  if (Count > 0) and
+    Items[0].Append(TGLSMemoUndo(Item)) then
+  begin
+    TGLSMemoUndo(Item).Free;
+    Exit;
+  end;
+
+  TGLSMemoUndo(Item).FMemo := Self.FMemo;
+  if FPos > 0 then
+    while FPos > 0 do
+    begin
+      Delete(0);
+      Dec(FPos);
+    end;
+  Insert(0, Item);
+  if Count > FLimit then
+    Delete(Count - 1);
+  Memo.UndoChange;
+  Result := 0;
+end;
+
+procedure TGLSMemoUndoList.Clear;
+begin
+  while Count > 0 do
+    Delete(0);
+  FPos := 0;
+  with Memo do
+    if not (csDestroying in ComponentState) then
+      UndoChange;
+end;
+
+procedure TGLSMemoUndoList.Delete(Index: Integer);
+begin
+  TGLSMemoUndo(Items[Index]).Free;
+  inherited;
+end;
+
+procedure TGLSMemoUndoList.Undo;
+var
+  OldAutoIndent: Boolean;
+begin
+  if FPos < Count then
+  begin
+    OldAutoIndent := Memo.AutoIndent;
+    Memo.AutoIndent := False;
+    FIsPerforming := True;
+    Items[FPos].Undo;
+    Inc(FPos);
+    FIsPerforming := False;
+    Memo.AutoIndent := OldAutoIndent;
+    Memo.UndoChange;
+  end;
+end;
+
+procedure TGLSMemoUndoList.Redo;
+var
+  OldAutoIndent: Boolean;
+begin
+  if FPos > 0 then
+  begin
+    OldAutoIndent := Memo.AutoIndent;
+    Memo.AutoIndent := False;
+    FIsPerforming := True;
+    Dec(FPos);
+    Items[FPos].Redo;
+    FIsPerforming := False;
+    Memo.AutoIndent := OldAutoIndent;
+    Memo.UndoChange;
+  end;
+end;
+
+procedure TGLSMemoUndoList.SetLimit(Value: integer);
+begin
+  if FLimit <> Value then
+  begin
+    if Value <= 0 then
+      Value := 10;
+    if Value > 0 then
+      Value := 100;
+    FLimit := Value;
+    Clear;
+  end;
+end;
+
+procedure TGLSSynHiMemo.Paint;
+begin
+  FIsPainting := True;
+  try
+    DelimiterStyle := FDelimiterStyle;
+    CommentStyle := FCommentStyle;
+    NumberStyle := FNumberStyle;
+    inherited;
+  finally
+    FIsPainting := False;
+  end;
+end;
+
+ 
+
+// ---------------------TGLSSynHiMemo 
+
+procedure TGLSSynHiMemo.SetStyle(Index: integer; Value: TCharStyle);
+var
+  No: integer;
+  eRect: TRect;
+begin
+  No := -1;
+  case Index of
+    0: No := FDelimiterStyleNo;
+    1: No := FCommentStyleNo;
+    2: No := FNumberStyleNo;
+  end;
+  with Value do
+    Styles.Change(No, TextColor, BkColor, Style);
+  if not FIsPainting then
+  begin
+    eRect := EditorRect;
+    InvalidateRect(Handle, @eRect, True);
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - SET WORD LIST
+//--------------------------------------------------------------
+
+procedure TGLSSynHiMemo.SetWordList(Value: TGLSMemoStringList);
+begin
+  FWordList.Assign(Value);
+end;
+
+procedure TGLSSynHiMemo.SetSpecialList(Value: TGLSMemoStringList);
+begin
+  FSpecialList.Assign(Value);
+end;
+
+procedure TGLSSynHiMemo.SetBracketList(Value: TGLSMemoStringList);
+begin
+  FBracketList.Assign(Value);
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - SET CASE SENSITIVE
+//--------------------------------------------------------------
+
+procedure TGLSSynHiMemo.SetCaseSensitive(Value: Boolean);
+var
+  LineNo: integer;
+begin
+  if Value <> FCaseSensitive then
+  begin
+    FCaseSensitive := Value;
+    for LineNo := 0 to Lines.Count - 1 do
+      ValidAttrs[LineNo] := False;
+    Invalidate;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - GET TOKEN
+//--------------------------------------------------------------
+
+function TGLSSynHiMemo.GetToken(const S: string; var From: integer;
+  out TokenType: TTokenType; out StyleNo: integer): string;
+var
+  i, toStart, toEnd, Len, LenSpec: integer;
+  Done: Boolean;
+  Brackets: string;
+  IntPart: integer;
+  WasPoint: Boolean;
+  //-------------------------------------------------------------
+  function StartsFrom(const S: string; Pos: integer; const S0: string): Boolean;
+  begin
+    Result := (StrLComp(PChar(S) + Pos - 1, PChar(S0), Length(S0)) = 0);
+  end;
+  //-------------------------------------------------------------
+  function Equal(const s1, s2: string): Boolean;
+  begin
+    if FCaseSensitive then
+      Result := s1 = s2
+    else
+      Result := AnsiLowerCase(s1) = AnsiLowerCase(s2);
+  end;
+begin
+  toStart := From;
+  toEnd := From;
+  TokenType := ttOther;
+  StyleNo := 0;
+  Len := Length(S);
+  // End of line
+  if From > Len then
+  begin
+    From := -1;
+    Result := '';
+    TokenType := ttEOL;
+    StyleNo := 0;
+    Exit;
+  end;
+  // Begin of multiline comment
+  if (MultiCommentLeft <> '') and (MultiCommentRight <> '') and
+    StartsFrom(S, From, MultiCommentLeft) then
+  begin
+    Result := MultiCommentLeft;
+    FInComment := True;
+    TokenType := ttComment;
+    StyleNo := FCommentStyleNo;
+    Inc(From, Length(MultiCommentLeft));
+    Exit;
+  end;
+  // Inside multiline comment
+  if FInComment then
+  begin
+    toEnd := toStart;
+    while (toEnd <= Len) and (not StartsFrom(S, toEnd, MultiCommentRight)) do
+      Inc(toEnd);
+    if toEnd > Len then
+    begin
+      Result := Copy(S, From, toEnd - From);
+      From := toEnd;
+    end
+    else
+    begin
+      FInComment := False;
+      toEnd := toEnd + Length(MultiCommentRight);
+      Result := Copy(S, From, toEnd - From);
+      From := toEnd;
+    end;
+    TokenType := ttComment;
+    StyleNo := FCommentStyleNo;
+    Exit;
+  end;
+
+  // Inside brikets
+  if FInBrackets >= 0 then
+  begin
+    Brackets := FBracketList[FInBrackets];
+    toEnd := toStart + 1;
+    while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
+      Inc(toEnd);
+    StyleNo := integer(FBracketList.Objects[FInBrackets]);
+    if toEnd <= Len then
+    begin
+      FInBrackets := -1;
+      From := toEnd + 1;
+    end
+    else
+      From := toEnd;
+    Result := Copy(S, toStart, toEnd - toStart + 1);
+    TokenType := ttBracket;
+    Exit;
+  end;
+  // Spaces
+  while (toStart <= Len) and (S[toStart] = ' ') do
+    Inc(toStart);
+  if toStart > From then
+  begin
+    Result := Copy(S, From, toStart - From);
+    From := toStart;
+    TokenType := ttSpace;
+    StyleNo := 0;
+    Exit;
+  end;
+  // Comment
+  if (FLineComment <> '') and StartsFrom(S, From, FLineComment) then
+  begin
+    Result := Copy(S, From, Len);
+    From := Len + 1;
+    TokenType := ttComment;
+    StyleNo := FCommentStyleNo;
+    Exit;
+  end;
+
+  // Special keyword
+  Done := False;
+  for i := 0 to FSpecialList.Count - 1 do
+  begin
+    LenSpec := Length(FSpecialList[i]);
+    if StrLComp(PChar(S) + toStart - 1,
+      PChar(FSpecialList[i]), LenSpec) = 0 then
+    begin
+      toEnd := toStart + LenSpec - 1;
+      StyleNo := integer(FSpecialList.Objects[i]);
+      TokenType := ttSpecial;
+      From := toEnd + 1;
+      Done := True;
+      break;
+    end;
+  end;
+  // Brickets
+  if not Done then
+  begin
+    for i := 0 to FBracketList.Count - 1 do
+    begin
+      Brackets := FBracketList[i];
+      if S[toStart] = Brackets[1] then
+      begin
+        FInBrackets := i;
+        toEnd := toStart + 1;
+        while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
+          Inc(toEnd);
+        if toEnd <= Len then
+          FInBrackets := -1
+        else
+          Dec(toEnd);
+        StyleNo := integer(FBracketList.Objects[i]);
+        TokenType := ttBracket;
+        Done := True;
+        break;
+      end;
+    end;
+  end;
+  // Delimeters
+  if not Done and CharInSet(S[toStart], Delimiters) then
+  begin
+    toEnd := toStart;
+    StyleNo := FDelimiterStyleNo;
+    TokenType := ttDelimiter;
+    Done := True;
+  end;
+  // --- Integer or float type
+  if not Done and CharInSet(S[toStart], ['0'..'9', '.']) then
+  begin
+    IntPart := 0;
+    WasPoint := False;
+    toEnd := toStart;
+    Done := True;
+    TokenType := ttInteger;
+    StyleNo := FNumberStyleNo;
+    while (toEnd <= Len) and CharInSet(S[toEnd], ['0'..'9', '.']) do
+    begin
+      if S[toEnd] = '.' then
+      begin
+        if not WasPoint then
+        begin
+          WasPoint := True;
+          TokenType := ttFloat;
+        end
+        else
+        begin
+          TokenType := ttWrongNumber;
+          Color := clRed;
+        end;
+      end
+      else if not WasPoint then
+        try
+          IntPart := IntPart * 10 + Ord(S[toEnd]) - Ord('0');
+        except
+          IntPart := MaxInt;
+        end;
+      Inc(toEnd);
+    end;
+    Dec(toEnd);
+  end;
+  // Select word
+  if not Done then
+  begin
+    toEnd := toStart;
+    while (toEnd <= Len) and not CharInSet(S[toEnd], Delimiters) do
+      Inc(toEnd);
+    Dec(toEnd);
+  end;
+  // Find in dictionary
+  Result := Copy(S, toStart, toEnd - toStart + 1);
+  for i := 0 to FWordList.Count - 1 do
+    if Equal(Result, FWordList[i]) then
+    begin
+      StyleNo := integer(FWordList.Objects[i]);
+      TokenType := ttWord;
+      break;
+    end;
+  From := toEnd + 1;
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - FIND LINE ATTRS
+//--------------------------------------------------------------
+
+procedure TGLSSynHiMemo.FindLineAttrs(Sender: TObject; LineNo: integer;
+  var Attrs: string);
+var
+  i, From, TokenLen: integer;
+  S, Token: string;
+  TokenType: TTokenType;
+  StyleNo, OldInBrackets: integer;
+  OldInComment: Boolean;
+begin
+  S := Lines[LineNo];
+  SetLength(Attrs, Length(S));
+  FInComment := InComment[LineNo];
+  FInBrackets := InBrackets[LineNo];
+  From := 1;
+  while True do
+  begin
+    Token := GetToken(S, From, TokenType, StyleNo);
+    if TokenType = ttEOL then
+      break;
+    TokenLen := Length(Token);
+    for i := From - TokenLen to From - 1 do
+      Attrs[i] := Char(StyleNo);
+  end;
+  if LineNo < Lines.Count - 1 then
+  begin
+    OldInComment := InComment[LineNo + 1];
+    OldInBrackets := InBrackets[LineNo + 1];
+    if OldInComment <> FInComment then
+    begin
+      InComment[LineNo + 1] := FInComment;
+      ValidAttrs[LineNo + 1] := False;
+    end;
+    if OldInBrackets <> FInBrackets then
+    begin
+      InBrackets[LineNo + 1] := FInBrackets;
+      ValidAttrs[LineNo + 1] := False;
+    end;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - ADD WORD
+//--------------------------------------------------------------
+
+procedure TGLSSynHiMemo.AddWord(StyleNo: integer; const ArrS: array of string);
+var
+  i: integer;
+begin
+  for i := Low(ArrS) to high(ArrS) do
+    FWordList.AddObject(ArrS[i], TObject(StyleNo));
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - ADD SPECIAL
+//--------------------------------------------------------------
+
+procedure TGLSSynHiMemo.AddSpecial(StyleNo: integer; const ArrS: array of string);
+var
+  i: integer;
+begin
+  for i := Low(ArrS) to high(ArrS) do
+    FSpecialList.AddObject(ArrS[i], TObject(StyleNo));
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - ADD BRACKETS
+//--------------------------------------------------------------
+
+procedure TGLSSynHiMemo.AddBrackets(StyleNo: integer; const ArrS: array of string);
+var
+  i: integer;
+begin
+  for i := Low(ArrS) to high(ArrS) do
+    FBracketList.AddObject(ArrS[i], TObject(StyleNo));
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - CREATE
+//--------------------------------------------------------------
+
+constructor TGLSSynHiMemo.Create(AOwner: TComponent);
+begin
+  inherited;
+  FInBrackets := -1;
+  FIsPainting := False;
+  FInComment := False;
+  FWordList := TGLSMemoStringList.Create;
+  FSpecialList := TGLSMemoStringList.Create;
+  FBracketList := TGLSMemoStringList.Create;
+
+  FDelimiterStyle := TCharStyle.Create;
+  with FDelimiterStyle do
+  begin
+    TextColor := clBlue;
+    BkColor := clWhite;
+    Style := [];
+  end;
+
+  FCommentStyle := TCharStyle.Create;
+  with FCommentStyle do
+  begin
+    TextColor := clYellow;
+    BkColor := clSkyBlue;
+    Style := [fsItalic];
+  end;
+
+  FNumberStyle := TCharStyle.Create;
+  with FNumberStyle do
+  begin
+    TextColor := clNavy;
+    BkColor := clWhite;
+    Style := [fsBold];
+  end;
+
+  FDelimiterStyleNo := Styles.Add(clBlue, clWhite, []);
+  FCommentStyleNo := Styles.Add(clSilver, clWhite, [fsItalic]);
+  FNumberStyleNo := Styles.Add(clNavy, clWhite, [fsBold]);
+  OnGetLineAttrs := FindLineAttrs;
+  Delimiters := [' ', ',', ';', ':', '.', '(', ')', '{', '}', '[', ']',
+    '=', '+', '-', '*', '/', '^', '%', '<', '>',
+    '"', '''', #13, #10];
+end;
+
+//--------------------------------------------------------------
+//        SYNTAX MEMO - DESTROY
+//--------------------------------------------------------------
+
+destructor TGLSSynHiMemo.Destroy;
+begin
+  FWordList.Free;
+  FSpecialList.Free;
+  FBracketList.Free;
+  FDelimiterStyle.Free;
+  FCommentStyle.Free;
+  FNumberStyle.Free;
+  inherited;
+end;
+
+// ---------------------TGLSMemoStringList
+
+procedure TGLSMemoStringList.ReadStrings(Reader: TReader);
+var
+  i: Integer;
+begin
+  try
+    Reader.ReadListBegin;
+    Clear;
+    while not Reader.EndOfList do
+    begin
+      i := Add(Reader.ReadString);
+      Objects[i] := TObject(Reader.ReadInteger);
+    end;
+    Reader.ReadListEnd;
+  finally
+  end;
+end;
+
+//--------------------------------------------------------------
+//        STRING LIST - WRITE STRINGS
+//--------------------------------------------------------------
+
+procedure TGLSMemoStringList.WriteStrings(Writer: TWriter);
+var
+  i: Integer;
+begin
+  with Writer do
+  begin
+    WriteListBegin;
+    for i := 0 to Count - 1 do
+    begin
+      WriteString(Strings[i]);
+      WriteInteger(Integer(Objects[i]));
+    end;
+    WriteListEnd;
+  end;
+end;
+
+//--------------------------------------------------------------
+//        STRING LIST - DEFINE PROPERTIES
+//--------------------------------------------------------------
+
+procedure TGLSMemoStringList.DefineProperties(Filer: TFiler);
+begin
+  Filer.DefineProperty('Strings', ReadStrings, WriteStrings, Count > 0);
+end;
+
+ 
+
+// ---------------------ScrollBar bitmaps 
+
+procedure CreateScrollBarBitmaps;
+var
+  i, j: integer;
+begin
+  bmScrollBarFill := TBitmap.Create;
+  with bmScrollBarFill, Canvas do
+  begin
+    Width := 8;
+    Height := 8;
+    Transparent := False;
+    for i := 0 to 7 do
+      for j := 0 to 7 do
+        if Odd(i + j) then
+          Pixels[i, j] := clSilver;
+  end;
+
+  bmScrollBarUp := TBitmap.Create;
+  with bmScrollBarUp, Canvas do
+  begin
+    Width := 7;
+    Height := 8;
+    Brush.Color := clSilver;
+    FillRect(Rect(0, 0, Width, Height));
+    Pixels[3, 2] := clBlack;
+    MoveTo(2, 3);
+    LineTo(5, 3);
+    MoveTo(1, 4);
+    LineTo(6, 4);
+    MoveTo(0, 5);
+    LineTo(7, 5);
+  end;
+
+  bmScrollBarDown := TBitmap.Create;
+  with bmScrollBarDown, Canvas do
+  begin
+    Width := 7;
+    Height := 8;
+    Brush.Color := clSilver;
+    FillRect(Rect(0, 0, Width, Height));
+    MoveTo(0, 2);
+    LineTo(7, 2);
+    MoveTo(1, 3);
+    LineTo(6, 3);
+    MoveTo(2, 4);
+    LineTo(5, 4);
+    Pixels[3, 5] := clBlack;
+  end;
+
+  bmScrollBarLeft := TBitmap.Create;
+  with bmScrollBarLeft, Canvas do
+  begin
+    Width := 8;
+    Height := 7;
+    Brush.Color := clSilver;
+    FillRect(Rect(0, 0, Width, Height));
+    Pixels[2, 3] := clBlack;
+    MoveTo(3, 2);
+    LineTo(3, 5);
+    MoveTo(4, 1);
+    LineTo(4, 6);
+    MoveTo(5, 0);
+    LineTo(5, 7);
+  end;
+  bmScrollBarRight := TBitmap.Create;
+  with bmScrollBarRight, Canvas do
+  begin
+    Width := 8;
+    Height := 7;
+    Brush.Color := clSilver;
+    FillRect(Rect(0, 0, Width, Height));
+    MoveTo(2, 0);
+    LineTo(2, 7);
+    MoveTo(3, 1);
+    LineTo(3, 6);
+    MoveTo(4, 2);
+    LineTo(4, 5);
+    Pixels[5, 3] := clBlack;
+  end;
+end;
+
+//------------------ FREE SCROLL BAR BITMAPs -------------------
+
+procedure FreeScrollBarBitmaps;
+begin
+  bmScrollBarFill.Free;
+  bmScrollBarUp.Free;
+  bmScrollBarDown.Free;
+  bmScrollBarLeft.Free;
+  bmScrollBarRight.Free;
+end;
+
+
+//----------------------------------
+initialization
+//----------------------------------
+
+  RegisterClasses([TGLSSynHiMemo]);
+  CreateScrollBarBitmaps;
+  IntelliMouseInit;
+
+//----------------------------------
+finalization
+//----------------------------------
+
+  FreeScrollBarBitmaps;
+
+end.
+

Source/GLS.ParallelRegister.pas

@@ -4,7 +4,7 @@
 
 unit GLS.ParallelRegister;
 
-(*  Registration unit for GLScene GPU Computing package *)
+(*  Registration unit for GPU Computing package *)
 
 interface
 

Source/GLPlugInManager.pas → Source/GLS.PlugInManager.pas

@@ -1,402 +1,416 @@
-//
-// This unit is part of the GLScene Engine, http://glscene.org
-//
-{
-  An old PlugIn Manager unit. Don't know if if ever wa used... 
-}
-unit GLPlugInManager;
-
-interface
-
-{$I GLScene.inc}
-
-uses
-  Winapi.Windows, 
-  System.Classes, 
-  System.SysUtils,
-  VCL.Dialogs, 
-  VCL.Forms,
-  GLPlugInIntf;
-
-
-type
-  PPlugInEntry = ^TGLPlugInEntry;
-
-  TGLPlugInEntry = record
-    Path: TFileName;
-    Handle: HINST;
-    FileSize: Integer;
-    FileDate: TDateTime;
-    EnumResourcenames: TEnumResourceNames;
-    GetServices: TGetServices;
-    GetVendor: TGetVendor;
-    GetDescription: TGetDescription;
-    GetVersion: TGetVersion;
-  end;
-
-  TGLPlugInManager = class;
-
-  TGLResourceManager = class(TComponent)
-  public
-    procedure Notify(Sender: TGLPlugInManager; Operation: TOperation;
-      Service: TPIServiceType; PlugIn: Integer); virtual; abstract;
-  end;
-
-  TGLPlugInList = class(TStringList)
-  private
-    FOwner: TGLPlugInManager;
-    function GetPlugInEntry(Index: Integer): PPlugInEntry;
-    procedure SetPlugInEntry(Index: Integer; AEntry: PPlugInEntry);
-  protected
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure ReadPlugIns(Reader: TReader);
-    procedure WritePlugIns(Writer: TWriter);
-  public
-    constructor Create(AOwner: TGLPlugInManager); virtual;
-    procedure ClearList;
-    property Objects[Index: Integer]: PPlugInEntry read GetPlugInEntry
-      write SetPlugInEntry; default;
-    property Owner: TGLPlugInManager read FOwner;
-  end;
-
-  PResManagerEntry = ^TResManagerEntry;
-
-  TResManagerEntry = record
-    Manager: TGLResourceManager;
-    Services: TPIServices;
-  end;
-
-  TGLPlugInManager = class(TComponent)
-  private
-    FLibraryList: TGLPlugInList;
-    FResManagerList: TList;
-  protected
-    procedure DoNotify(Operation: TOperation; Service: TPIServiceType;
-      PlugIn: Integer);
-    function FindResManager(AManager: TGLResourceManager): PResManagerEntry;
-    function GetIndexFromFilename(FileName: String): Integer;
-    function GetPlugInFromFilename(FileName: String): PPlugInEntry;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    function AddPlugIn(Path: TFileName): Integer;
-    procedure EditPlugInList;
-    procedure RegisterResourceManager(AManager: TGLResourceManager;
-      Services: TPIServices);
-    procedure RemovePlugIn(Index: Integer);
-    procedure UnRegisterRessourceManager(AManager: TGLResourceManager;
-      Services: TPIServices);
-  published
-    property PlugIns: TGLPlugInList read FLibraryList write FLibraryList;
-  end;
-
-// ------------------------------------------------------------------------------
-implementation
-// ------------------------------------------------------------------------------
-
-
-// ----------------- TGLPlugInList ------------------------------------------------
-
-constructor TGLPlugInList.Create(AOwner: TGLPlugInManager);
-
-begin
-  inherited Create;
-  FOwner := AOwner;
-  Sorted := False;
-  Duplicates := DupAccept;
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInList.ClearList;
-
-begin
-  while Count > 0 do
-    FOwner.RemovePlugIn(0);
-end;
-
-// ------------------------------------------------------------------------------
-
-function TGLPlugInList.GetPlugInEntry(Index: Integer): PPlugInEntry;
-
-begin
-  Result := PPlugInEntry( inherited Objects[Index]);
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInList.SetPlugInEntry(Index: Integer; AEntry: PPlugInEntry);
-
-begin
-  inherited Objects[Index] := Pointer(AEntry);
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInList.WritePlugIns(Writer: TWriter);
-
-var
-  I: Integer;
-
-begin
-  Writer.WriteListBegin;
-  for I := 0 to Count - 1 do
-    Writer.WriteString(Objects[I].Path);
-  Writer.WriteListEnd;
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInList.ReadPlugIns(Reader: TReader);
-
-begin
-  ClearList;
-  Reader.ReadListBegin;
-  while not Reader.EndOfList do
-    FOwner.AddPlugIn(Reader.ReadString);
-  Reader.ReadListEnd;
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInList.DefineProperties(Filer: TFiler);
-
-begin
-  Filer.DefineProperty('Paths', ReadPlugIns, WritePlugIns, Count > 0);
-end;
-
-// ----------------- TGLPlugInManager ---------------------------------------------
-
-constructor TGLPlugInManager.Create(AOwner: TComponent);
-
-begin
-  inherited Create(AOwner);
-  FLibraryList := TGLPlugInList.Create(Self);
-  FResManagerList := TList.Create;
-end;
-
-// ------------------------------------------------------------------------------
-
-destructor TGLPlugInManager.Destroy;
-var
-  I: Integer;
-begin
-  FLibraryList.ClearList;
-  FLibraryList.Free;
-  for I := 0 to FResManagerList.Count - 1 do
-    FreeMem(PResManagerEntry(FResManagerList[I]), SizeOf(TResManagerEntry));
-  FResManagerList.Free;
-  inherited Destroy;
-end;
-
-// ------------------------------------------------------------------------------
-
-function TGLPlugInManager.AddPlugIn(Path: TFileName): Integer;
-
-// open the given DLL and read its properties, to identify
-// whether it's a valid plug-in or not
-
-var
-  NewPlugIn: PPlugInEntry;
-  OldError: Integer;
-  NewHandle: HINST;
-  ServiceFunc: TGetServices;
-  SearchRec: TSearchRec;
-  Service: TPIServiceType;
-  Services: TPIServices;
-
-begin
-  Result := -1;
-  OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
-  if Length(Path) > 0 then
-    try
-      Result := GetIndexFromFilename(Path);
-      // plug-in already registered?
-      if Result > -1 then
-        Exit;
-      // first step is loading the file into client memory
-      NewHandle := LoadLibrary(PChar(Path));
-      // loading failed -> exit
-      if NewHandle = 0 then
-        Abort;
-      // get the service function address to identify the plug-in
-      ServiceFunc := GetProcAddress(NewHandle, 'GetServices');
-      if not assigned(ServiceFunc) then
-      begin
-        // if address not found then the given library is not valid
-        // release it from client memory
-        FreeLibrary(NewHandle);
-        Abort;
-      end;
-      // all went fine so far, we just loaded a valid plug-in
-      // allocate a new entry for the plug-in list and fill it
-      New(NewPlugIn);
-      NewPlugIn.Path := Path;
-      with NewPlugIn^ do
-      begin
-        Handle := NewHandle;
-        FindFirst(Path, faAnyFile, SearchRec);
-        FileSize := SearchRec.Size;
-        FileDate := SearchRec.TimeStamp;
-        FindClose(SearchRec);
-        GetServices := ServiceFunc;
-        EnumResourcenames := GetProcAddress(Handle, 'EnumResourceNames');
-        GetVendor := GetProcAddress(Handle, 'GetVendor');
-        GetVersion := GetProcAddress(Handle, 'GetVersion');
-        GetDescription := GetProcAddress(Handle, 'GetDescription');
-      end;
-      Result := FLibraryList.Add(string(NewPlugIn.GetVendor));
-      FLibraryList.Objects[Result] := NewPlugIn;
-      // now notify (for all provided services) all registered resource managers
-      // for which these services are relevant
-      Services := NewPlugIn.GetServices;
-      for Service := Low(TPIServiceType) to High(TPIServiceType) do
-        if Service in Services then
-          DoNotify(opInsert, Service, Result);
-    finally
-      SetErrorMode(OldError);
-    end;
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInManager.DoNotify(Operation: TOperation;
-  Service: TPIServiceType; PlugIn: Integer);
-
-var
-  I: Integer;
-
-begin
-  for I := 0 TO FResManagerList.Count - 1 do
-    if Service in PResManagerEntry(FResManagerList[I]).Services then
-      PResManagerEntry(FResManagerList[I]).Manager.Notify(Self, Operation,
-        Service, PlugIn);
-end;
-
-// ------------------------------------------------------------------------------
-
-function TGLPlugInManager.FindResManager(AManager: TGLResourceManager)
-  : PResManagerEntry;
-
-var
-  I: Integer;
-
-begin
-  Result := nil;
-  for I := 0 to FResManagerList.Count - 1 do
-    if PResManagerEntry(FResManagerList[I]).Manager = AManager then
-    begin
-      Result := PResManagerEntry(FResManagerList[I]);
-      Exit;
-    end;
-end;
-
-// ------------------------------------------------------------------------------
-
-function TGLPlugInManager.GetIndexFromFilename(FileName: String): Integer;
-
-var
-  I: Integer;
-
-begin
-  Result := -1;
-  for I := 0 to FLibraryList.Count - 1 do
-    if CompareText(FLibraryList[I].Path, FileName) = 0 then
-    begin
-      Result := I;
-      Exit;
-    end;
-end;
-
-// ------------------------------------------------------------------------------
-
-function TGLPlugInManager.GetPlugInFromFilename(FileName: String): PPlugInEntry;
-
-var
-  I: Integer;
-
-begin
-  I := GetIndexFromFilename(FileName);
-  if I > -1 then
-    Result := FLibraryList[I]
-  else
-    Result := nil;
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInManager.RegisterResourceManager(AManager: TGLResourceManager;
-  Services: TPIServices);
-
-var
-  ManagerEntry: PResManagerEntry;
-
-begin
-  ManagerEntry := FindResManager(AManager);
-  if assigned(ManagerEntry) then
-    ManagerEntry.Services := ManagerEntry.Services + Services
-  else
-  begin
-    New(ManagerEntry);
-    ManagerEntry.Manager := AManager;
-    ManagerEntry.Services := Services;
-    FResManagerList.Add(ManagerEntry);
-  end;
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInManager.RemovePlugIn(Index: Integer);
-
-var
-  Entry: PPlugInEntry;
-  Service: TPIServiceType;
-  Services: TPIServices;
-
-begin
-  Entry := FLibraryList.Objects[Index];
-  Services := Entry.GetServices;
-  // notify for all services to be deleted all registered resource managers
-  // for which these services are relevant
-  for Service := Low(TPIServiceType) to High(TPIServiceType) do
-    if Service in Services then
-      DoNotify(opRemove, Service, Index);
-  FreeLibrary(Entry.Handle);
-  Dispose(Entry);
-  FLibraryList.Delete(Index);
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInManager.EditPlugInList;
-
-begin
-  ///TGLPlugInManagerEditor.EditPlugIns(Self);   //Circular call to edit Listbox items?
-end;
-
-// ------------------------------------------------------------------------------
-
-procedure TGLPlugInManager.UnRegisterRessourceManager(AManager: TGLResourceManager;
-  Services: TPIServices);
-
-var
-  ManagerEntry: PResManagerEntry;
-  Index: Integer;
-
-begin
-  ManagerEntry := FindResManager(AManager);
-  if assigned(ManagerEntry) then
-  begin
-    ManagerEntry.Services := ManagerEntry.Services - Services;
-    if ManagerEntry.Services = [] then
-    begin
-      Index := FResManagerList.IndexOf(ManagerEntry);
-      Dispose(ManagerEntry);
-      FResManagerList.Delete(Index);
-    end;
-  end;
-end;
-
-// ------------------------------------------------------------------------------
-
-end.
+//
+// This unit is part of the GLScene Engine, http://glscene.org
+//
+
+unit GLS.PlugInManager;
+
+(* An old PlugIn Manager unit. Yet not ever was used... *)
+
+interface
+
+{$I GLScene.inc}
+
+uses
+  Winapi.Windows, 
+  System.Classes, 
+  System.SysUtils,
+  VCL.Dialogs, 
+  VCL.Forms;
+
+
+type
+  TPIServiceType = (stRaw, stObject, stBitmap, stTexture, stImport, stExport);
+  TPIServices = set of TPIServiceType;
+
+  TEnumCallBack = procedure(Name: PAnsiChar); stdcall;
+
+  TEnumResourceNames = procedure(Service: TPIServiceType;
+    Callback: TEnumCallBack); stdcall;
+  TGetServices = function: TPIServices; stdcall;
+  TGetVendor = function: PAnsiChar; stdcall;
+  TGetDescription = function: PAnsiChar; stdcall;
+  TGetVersion = function: PAnsiChar; stdcall;
+
+
+type
+
+  PPlugInEntry = ^TGLPlugInEntry;
+
+  TGLPlugInEntry = record
+    Path: TFileName;
+    Handle: HINST;
+    FileSize: Integer;
+    FileDate: TDateTime;
+    EnumResourcenames: TEnumResourceNames;
+    GetServices: TGetServices;
+    GetVendor: TGetVendor;
+    GetDescription: TGetDescription;
+    GetVersion: TGetVersion;
+  end;
+
+  TGLPlugInManager = class;
+
+  TGLResourceManager = class(TComponent)
+  public
+    procedure Notify(Sender: TGLPlugInManager; Operation: TOperation;
+      Service: TPIServiceType; PlugIn: Integer); virtual; abstract;
+  end;
+
+  TGLPlugInList = class(TStringList)
+  private
+    FOwner: TGLPlugInManager;
+    function GetPlugInEntry(Index: Integer): PPlugInEntry;
+    procedure SetPlugInEntry(Index: Integer; AEntry: PPlugInEntry);
+  protected
+    procedure DefineProperties(Filer: TFiler); override;
+    procedure ReadPlugIns(Reader: TReader);
+    procedure WritePlugIns(Writer: TWriter);
+  public
+    constructor Create(AOwner: TGLPlugInManager); virtual;
+    procedure ClearList;
+    property Objects[Index: Integer]: PPlugInEntry read GetPlugInEntry
+      write SetPlugInEntry; default;
+    property Owner: TGLPlugInManager read FOwner;
+  end;
+
+  PResManagerEntry = ^TResManagerEntry;
+
+  TResManagerEntry = record
+    Manager: TGLResourceManager;
+    Services: TPIServices;
+  end;
+
+  TGLPlugInManager = class(TComponent)
+  private
+    FLibraryList: TGLPlugInList;
+    FResManagerList: TList;
+  protected
+    procedure DoNotify(Operation: TOperation; Service: TPIServiceType;
+      PlugIn: Integer);
+    function FindResManager(AManager: TGLResourceManager): PResManagerEntry;
+    function GetIndexFromFilename(FileName: String): Integer;
+    function GetPlugInFromFilename(FileName: String): PPlugInEntry;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function AddPlugIn(Path: TFileName): Integer;
+    procedure EditPlugInList;
+    procedure RegisterResourceManager(AManager: TGLResourceManager;
+      Services: TPIServices);
+    procedure RemovePlugIn(Index: Integer);
+    procedure UnRegisterRessourceManager(AManager: TGLResourceManager;
+      Services: TPIServices);
+  published
+    property PlugIns: TGLPlugInList read FLibraryList write FLibraryList;
+  end;
+
+// ------------------------------------------------------------------------------
+implementation
+// ------------------------------------------------------------------------------
+
+
+// ----------------- TGLPlugInList ------------------------------------------------
+
+constructor TGLPlugInList.Create(AOwner: TGLPlugInManager);
+
+begin
+  inherited Create;
+  FOwner := AOwner;
+  Sorted := False;
+  Duplicates := DupAccept;
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInList.ClearList;
+
+begin
+  while Count > 0 do
+    FOwner.RemovePlugIn(0);
+end;
+
+// ------------------------------------------------------------------------------
+
+function TGLPlugInList.GetPlugInEntry(Index: Integer): PPlugInEntry;
+
+begin
+  Result := PPlugInEntry( inherited Objects[Index]);
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInList.SetPlugInEntry(Index: Integer; AEntry: PPlugInEntry);
+
+begin
+  inherited Objects[Index] := Pointer(AEntry);
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInList.WritePlugIns(Writer: TWriter);
+
+var
+  I: Integer;
+
+begin
+  Writer.WriteListBegin;
+  for I := 0 to Count - 1 do
+    Writer.WriteString(Objects[I].Path);
+  Writer.WriteListEnd;
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInList.ReadPlugIns(Reader: TReader);
+
+begin
+  ClearList;
+  Reader.ReadListBegin;
+  while not Reader.EndOfList do
+    FOwner.AddPlugIn(Reader.ReadString);
+  Reader.ReadListEnd;
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInList.DefineProperties(Filer: TFiler);
+
+begin
+  Filer.DefineProperty('Paths', ReadPlugIns, WritePlugIns, Count > 0);
+end;
+
+// ----------------- TGLPlugInManager ---------------------------------------------
+
+constructor TGLPlugInManager.Create(AOwner: TComponent);
+
+begin
+  inherited Create(AOwner);
+  FLibraryList := TGLPlugInList.Create(Self);
+  FResManagerList := TList.Create;
+end;
+
+// ------------------------------------------------------------------------------
+
+destructor TGLPlugInManager.Destroy;
+var
+  I: Integer;
+begin
+  FLibraryList.ClearList;
+  FLibraryList.Free;
+  for I := 0 to FResManagerList.Count - 1 do
+    FreeMem(PResManagerEntry(FResManagerList[I]), SizeOf(TResManagerEntry));
+  FResManagerList.Free;
+  inherited Destroy;
+end;
+
+// ------------------------------------------------------------------------------
+
+function TGLPlugInManager.AddPlugIn(Path: TFileName): Integer;
+
+// open the given DLL and read its properties, to identify
+// whether it's a valid plug-in or not
+
+var
+  NewPlugIn: PPlugInEntry;
+  OldError: Integer;
+  NewHandle: HINST;
+  ServiceFunc: TGetServices;
+  SearchRec: TSearchRec;
+  Service: TPIServiceType;
+  Services: TPIServices;
+
+begin
+  Result := -1;
+  OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
+  if Length(Path) > 0 then
+    try
+      Result := GetIndexFromFilename(Path);
+      // plug-in already registered?
+      if Result > -1 then
+        Exit;
+      // first step is loading the file into client memory
+      NewHandle := LoadLibrary(PChar(Path));
+      // loading failed -> exit
+      if NewHandle = 0 then
+        Abort;
+      // get the service function address to identify the plug-in
+      ServiceFunc := GetProcAddress(NewHandle, 'GetServices');
+      if not assigned(ServiceFunc) then
+      begin
+        // if address not found then the given library is not valid
+        // release it from client memory
+        FreeLibrary(NewHandle);
+        Abort;
+      end;
+      // all went fine so far, we just loaded a valid plug-in
+      // allocate a new entry for the plug-in list and fill it
+      New(NewPlugIn);
+      NewPlugIn.Path := Path;
+      with NewPlugIn^ do
+      begin
+        Handle := NewHandle;
+        FindFirst(Path, faAnyFile, SearchRec);
+        FileSize := SearchRec.Size;
+        FileDate := SearchRec.TimeStamp;
+        FindClose(SearchRec);
+        GetServices := ServiceFunc;
+        EnumResourcenames := GetProcAddress(Handle, 'EnumResourceNames');
+        GetVendor := GetProcAddress(Handle, 'GetVendor');
+        GetVersion := GetProcAddress(Handle, 'GetVersion');
+        GetDescription := GetProcAddress(Handle, 'GetDescription');
+      end;
+      Result := FLibraryList.Add(string(NewPlugIn.GetVendor));
+      FLibraryList.Objects[Result] := NewPlugIn;
+      // now notify (for all provided services) all registered resource managers
+      // for which these services are relevant
+      Services := NewPlugIn.GetServices;
+      for Service := Low(TPIServiceType) to High(TPIServiceType) do
+        if Service in Services then
+          DoNotify(opInsert, Service, Result);
+    finally
+      SetErrorMode(OldError);
+    end;
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInManager.DoNotify(Operation: TOperation;
+  Service: TPIServiceType; PlugIn: Integer);
+
+var
+  I: Integer;
+
+begin
+  for I := 0 TO FResManagerList.Count - 1 do
+    if Service in PResManagerEntry(FResManagerList[I]).Services then
+      PResManagerEntry(FResManagerList[I]).Manager.Notify(Self, Operation,
+        Service, PlugIn);
+end;
+
+// ------------------------------------------------------------------------------
+
+function TGLPlugInManager.FindResManager(AManager: TGLResourceManager)
+  : PResManagerEntry;
+
+var
+  I: Integer;
+
+begin
+  Result := nil;
+  for I := 0 to FResManagerList.Count - 1 do
+    if PResManagerEntry(FResManagerList[I]).Manager = AManager then
+    begin
+      Result := PResManagerEntry(FResManagerList[I]);
+      Exit;
+    end;
+end;
+
+// ------------------------------------------------------------------------------
+
+function TGLPlugInManager.GetIndexFromFilename(FileName: String): Integer;
+
+var
+  I: Integer;
+
+begin
+  Result := -1;
+  for I := 0 to FLibraryList.Count - 1 do
+    if CompareText(FLibraryList[I].Path, FileName) = 0 then
+    begin
+      Result := I;
+      Exit;
+    end;
+end;
+
+// ------------------------------------------------------------------------------
+
+function TGLPlugInManager.GetPlugInFromFilename(FileName: String): PPlugInEntry;
+
+var
+  I: Integer;
+
+begin
+  I := GetIndexFromFilename(FileName);
+  if I > -1 then
+    Result := FLibraryList[I]
+  else
+    Result := nil;
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInManager.RegisterResourceManager(AManager: TGLResourceManager;
+  Services: TPIServices);
+
+var
+  ManagerEntry: PResManagerEntry;
+
+begin
+  ManagerEntry := FindResManager(AManager);
+  if assigned(ManagerEntry) then
+    ManagerEntry.Services := ManagerEntry.Services + Services
+  else
+  begin
+    New(ManagerEntry);
+    ManagerEntry.Manager := AManager;
+    ManagerEntry.Services := Services;
+    FResManagerList.Add(ManagerEntry);
+  end;
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInManager.RemovePlugIn(Index: Integer);
+
+var
+  Entry: PPlugInEntry;
+  Service: TPIServiceType;
+  Services: TPIServices;
+
+begin
+  Entry := FLibraryList.Objects[Index];
+  Services := Entry.GetServices;
+  // notify for all services to be deleted all registered resource managers
+  // for which these services are relevant
+  for Service := Low(TPIServiceType) to High(TPIServiceType) do
+    if Service in Services then
+      DoNotify(opRemove, Service, Index);
+  FreeLibrary(Entry.Handle);
+  Dispose(Entry);
+  FLibraryList.Delete(Index);
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInManager.EditPlugInList;
+
+begin
+  ///TGLPlugInManagerEditor.EditPlugIns(Self);   //Circular call to edit Listbox items?
+end;
+
+// ------------------------------------------------------------------------------
+
+procedure TGLPlugInManager.UnRegisterRessourceManager(AManager: TGLResourceManager;
+  Services: TPIServices);
+
+var
+  ManagerEntry: PResManagerEntry;
+  Index: Integer;
+
+begin
+  ManagerEntry := FindResManager(AManager);
+  if assigned(ManagerEntry) then
+  begin
+    ManagerEntry.Services := ManagerEntry.Services - Services;
+    if ManagerEntry.Services = [] then
+    begin
+      Index := FResManagerList.IndexOf(ManagerEntry);
+      Dispose(ManagerEntry);
+      FResManagerList.Delete(Index);
+    end;
+  end;
+end;
+
+// ------------------------------------------------------------------------------
+
+end.

Source/GLS.SceneRegister.pas

@@ -5,7 +5,7 @@
 unit GLS.SceneRegister;
 
 (*
-  Registration unit for GLScene library components, property editors and
+  Registration unit for library components, property editors and
   IDE experts.
 *)
 
@@ -29,12 +29,12 @@ uses
   DesignEditors,
   VCLEditors,
 
-  GLScene,
-  GLStrings,
   GLContext,
+  GLScene,
   GLColor,
   GLCrossPlatform,
-  GLObjectManager;
+  GLObjectManager,
+  GLStrings;
 
 type
   TGLLibMaterialNameProperty = class(TStringProperty)
@@ -287,6 +287,7 @@ uses
   FShaderUniformEditor,
   FVectorEditor,
   FSceneEditor,
+
   GLAnimatedSprite,
   GLApplicationFileIO,
   GLAsmShader,
@@ -383,24 +384,22 @@ uses
   GLTimeEventsMgr,
   GLTrail,
   GLTree,
-  GLTypes,
-  GLFileTIN,
   GLUserShader,
   GLUtils,
   GLVectorFileObjects,
-  GLVfsPAK,
   GLWin32Viewer,
   GLWaterPlane,
   GLWindows,
   GLWindowsFont,
   GLzBuffer,
-  GLSMemo,
+  GLS.Memo,
   GLVectorTypes,
   GLVectorGeometry,
-  // Image file formats
+//----------------- File formats
+  GLFileVfsPAK,
   FileDDSImage,
   FileTGA,
-  // Vector file formats
+//------------------ Vector file formats
   GLFile3DS,
   GLFileASE,
   GLFileB3D,
@@ -423,11 +422,11 @@ uses
   GLFileSTL,
   GLFileVRML,
 
-  // Sound file formats
+//----------------- Sound file formats
   GLFileWAV,
   GLFileMP3,
 
-  // Raster file format
+//----------------- Raster file format
   GLFileDDS,
   GLFileO3TC,
   GLFileHDR,
@@ -1327,14 +1326,14 @@ end;
 procedure GLRegisterPropertiesInCategories;
 begin
   // property types
-  // TGLScreenDepth in GLWin32FullScreenViewer
+  // ScreenDepth in Win32FullScreenViewer
   RegisterPropertiesInCategory(strOpenGLCategoryName,
      [TypeInfo(TGLCamera), TypeInfo(TGLSceneBuffer),
      TypeInfo(TGLVSyncMode), TypeInfo(TGLScreenDepth)]);
-  // TGLSceneViewer
+  // SceneViewer
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLSceneViewer, ['*Render']);
 
-  // GLScene
+  // Scene
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLObjectsSorting), TypeInfo(TGLProgressEvent),
     TypeInfo(TGLBehaviours), TypeInfo(TGLEffects),
@@ -1355,16 +1354,10 @@ begin
   RegisterPropertiesInCategory(strVisualCategoryName, TGLCamera, ['DepthOfView', 'SceneScale']);
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLNonVisualViewer, ['*Render']);
 
-  // GLObjects
+  // Objects
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLLinesNodes), TypeInfo(TGLLineNodesAspect),
     TypeInfo(TGLLineSplineMode), TypeInfo(TGLLinesOptions)]);
-  // GLSpaceText
-  RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TGLTextAdjust)]);
-  RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLSpaceTextCharRange)]);
-  RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLLineSplineMode),
-    TypeInfo(TGLCapType), TypeInfo(TGLNormalSmoothing),
-    TypeInfo(TGLArrowHeadStyle), TypeInfo(TGLTextAdjust)]);
   // DummyCube
   RegisterPropertiesInCategory(strLayoutCategoryName, TGLDummyCube, ['VisibleAtRunTime']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLDummyCube, ['CubeSize', 'VisibleAtRunTime']);
@@ -1377,7 +1370,12 @@ begin
     ['Antialiased', 'Division', 'Line*', 'NodeSize']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLCube, ['Cube*']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLFrustrum, ['ApexHeight', 'Base*']);
-  // GLSpaceText
+  // SpaceText
+  RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TGLTextAdjust)]);
+  RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLSpaceTextCharRange)]);
+  RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLLineSplineMode),
+    TypeInfo(TGLCapType), TypeInfo(TGLNormalSmoothing),
+    TypeInfo(TGLArrowHeadStyle), TypeInfo(TGLTextAdjust)]);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLSpaceText,
     ['AllowedDeviation', 'AspectRatio', 'Extrusion', 'Oblique', 'TextHeight']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLSphere,
@@ -1398,12 +1396,12 @@ begin
     ['Bottom*', 'Loops', 'Slices', 'Stacks', 'Top*']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLPolygon, ['Division']);
 
-  // GLMultiPolygon
+  // MultiPolygon
   RegisterPropertiesInCategory(strVisualCategoryName, TGLContour, ['Division']);
   RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLContourNodes),
     TypeInfo(TGLContours)]);
 
-  // GLExtrusion
+  // Extrusion
   RegisterPropertiesInCategory(strVisualCategoryName, TGLExtrusionSolid, ['Stacks']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLPipeNode, ['RadiusFactor']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLPipe,
@@ -1413,7 +1411,7 @@ begin
   RegisterPropertiesInCategory(strVisualCategoryName, TGLRevolutionSolid,
     ['Division', 'Slices', 'YOffsetPerTurn']);
 
-  // GLVectorFileObjects
+  // VectorFileObjects
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLActorAnimationMode), TypeInfo(TGLActorAnimations),
     TypeInfo(TGLMeshAutoCenterings), TypeInfo(TGLActorFrameInterpolation),
@@ -1431,11 +1429,11 @@ begin
     ['*Frame*', 'Interval', 'OverlaySkeleton', 'UseMeshmaterials']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLActor,  ['OverlaySkeleton']);
 
-  // GLMesh 
+  // Mesh
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLMeshMode), TypeInfo(TGLVertexMode)]);
 
-  // GLGraph 
+  // Graph
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLHeightFieldOptions)]);
   RegisterPropertiesInCategory(strVisualCategoryName,
@@ -1444,11 +1442,11 @@ begin
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLXYZGrid, ['Antialiased']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLXYZGrid, ['Antialiased', 'Line*']);
 
-  // GLParticles
+  // Particles
   RegisterPropertiesInCategory(strLayoutCategoryName, TGLParticles, ['VisibleAtRunTime']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLParticles, ['*Size', 'VisibleAtRunTime']);
 
-  // GLSkydome
+  // Skydome
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLSkyDomeBands), TypeInfo(TGLSkyDomeOptions), TypeInfo(TGLSkyDomeStars)]);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLSkyDomeBand, ['Slices', 'Stacks', '*Angle']);
@@ -1456,11 +1454,11 @@ begin
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLEarthSkyDome,
     ['Slices', 'Stacks', 'SunElevation', 'Turbidity']);
 
-  // GLMirror
+  // Mirror
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLMirrorOptions), TypeInfo(TGLBaseSceneObject)]);
 
-  // GLParticleFX 
+  // ParticleFX
   RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLBlendingMode)]);
   RegisterPropertiesInCategory(strVisualCategoryName,
     [TypeInfo(TGLBlendingMode), TypeInfo(TPFXLifeColors), TypeInfo(TSpriteColorMode)]);
@@ -1472,69 +1470,60 @@ begin
   RegisterPropertiesInCategory(strVisualCategoryName, TGLPolygonPFXManager, ['NbSides']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLPointLightPFXManager, ['TexMapSize']);
 
-  // GLTerrainRenderer 
+  // TerrainRenderer
   RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLHeightDataSource)]);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLTerrainRenderer,
     ['*CLOD*', 'QualityDistance', 'Tile*']);
 
-  // GLzBuffer 
+  // zBuffer
   RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMemoryViewer),
     TypeInfo(TGLSceneViewer), TypeInfo(TOptimise)]);
   RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TOptimise)]);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLZShadows,
     ['DepthFade', '*Shadow', 'Soft', 'Tolerance']);
 
-  // GLHUDObjects
+  // HUDObjects
   RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TTextLayout)]);
   RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLBitmapFont), TypeInfo(TTextLayout)]);
   RegisterPropertiesInCategory(strLocalizableCategoryName,[TypeInfo(TGLBitmapFont)]);
 
-  // GLTexture
+  // Texture
   RegisterPropertiesInCategory(strOpenGLCategoryName,
     [TypeInfo(TGLMaterial), TypeInfo(TGLMaterialLibrary),
     TypeInfo(TGLLibMaterials), TypeInfo(TGLTextureNeededEvent)]);
-  RegisterPropertiesInCategory(strOpenGLCategoryName,
-    TGLLibMaterial, ['Texture2Name']);
+  RegisterPropertiesInCategory(strOpenGLCategoryName, TGLLibMaterial, ['Texture2Name']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLLibMaterial, ['TextureOffset', 'TextureScale']);
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLMaterialLibrary, ['TexturePaths']);
 
-  // GLCadencer
-  RegisterPropertiesInCategory(strOpenGLCategoryName,
-    [TypeInfo(TGLCadencer)]);
+  // Cadencer
+  RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLCadencer)]);
 
-  // GLCollision
-  RegisterPropertiesInCategory(strOpenGLCategoryName,
-    [TypeInfo(TObjectCollisionEvent)]);
+  // Collision
+  RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TObjectCollisionEvent)]);
 
-  // GLFireFX
+  // FireFX
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLFireFXManager,
     ['MaxParticles', 'NoZWrite', 'Paused', 'UseInterval']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLFireFXManager,
     ['Fire*', 'InitialDir', 'NoZWrite', 'Particle*', 'Paused']);
 
-  // GLThorFX
-  RegisterPropertiesInCategory(strOpenGLCategoryName,
-    [TypeInfo(TCalcPointEvent)]);
+  // ThorFX
+  RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TCalcPointEvent)]);
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLThorFXManager,
     ['Maxpoints', 'Paused']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLThorFXManager,
     ['Core', 'Glow*', 'Paused', 'Target', 'Vibrate', 'Wildness']);
 
-  // GLBitmapFont 
-  RegisterPropertiesInCategory(strOpenGLCategoryName,
-    [TypeInfo(TGLMagFilter), TypeInfo(TGLMinFilter)]);
-  RegisterPropertiesInCategory(strLocalizableCategoryName,
-    [TypeInfo(TGLBitmapFontRanges)]);
-  RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFontRange,
-    ['*ASCII']);
-  RegisterPropertiesInCategory(strLayoutCategoryName, TGLBitmapFont,
-    ['Char*', '*Interval*', '*Space']);
-  RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFont,
-    ['Glyphs']);
+  // BitmapFont
+  RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMagFilter), TypeInfo(TGLMinFilter)]);
+  RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLBitmapFontRanges)]);
+  RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFontRange, ['*ASCII']);
+  RegisterPropertiesInCategory(strLayoutCategoryName, TGLBitmapFont, ['Char*', '*Interval*', '*Space']);
+  RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFont, ['Glyphs']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLBitmapFont,
     ['Char*', '*Interval*', '*Space', 'Glyphs']);
 
-  // GLHeightData
+  // HeightData
   RegisterPropertiesInCategory(strOpenGLCategoryName, TGLBitmapHDS, ['MaxPoolSize']);
   RegisterPropertiesInCategory(strVisualCategoryName, TGLBitmapHDS, ['Picture']);
 end;
@@ -1663,17 +1652,12 @@ begin
   RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
     'LibTessEvalShaderName', TGLLibShaderNameProperty);
 
-  RegisterPropertyEditor(TypeInfo(string), TGLTextureImageEx, 'SourceFile',
-    TPictureFileProperty);
-  RegisterPropertyEditor(TypeInfo(string), TGLShaderEx, 'SourceFile',
-    TShaderFileProperty);
-  RegisterPropertyEditor(TypeInfo(string), TGLASMVertexProgram, 'SourceFile',
-    TAsmProgFileProperty);
+  RegisterPropertyEditor(TypeInfo(string), TGLTextureImageEx, 'SourceFile', TPictureFileProperty);
+  RegisterPropertyEditor(TypeInfo(string), TGLShaderEx, 'SourceFile', TShaderFileProperty);
+  RegisterPropertyEditor(TypeInfo(string), TGLASMVertexProgram, 'SourceFile', TAsmProgFileProperty);
 
-  RegisterPropertyEditor(TypeInfo(Boolean), TGLBaseShaderModel,
-    'AutoFillOfUniforms', TUniformAutoSetProperty);
-  RegisterPropertyEditor(TypeInfo(TStringList), TGLShaderEx, 'Source',
-    TGLShaderEditorProperty);
+  RegisterPropertyEditor(TypeInfo(Boolean), TGLBaseShaderModel, 'AutoFillOfUniforms', TUniformAutoSetProperty);
+  RegisterPropertyEditor(TypeInfo(TStringList), TGLShaderEx, 'Source', TGLShaderEditorProperty);
 end;
 
 function GetGLSceneVersion: string;
@@ -1880,7 +1864,9 @@ begin
   RegisterSceneObject(TGLFBORenderer, 'OpenGL FrameBuffer', '', HInstance);
 end;
 
+//------------------------------------------------------
 finalization
+//------------------------------------------------------
 
 ObjectManager.Free;
 

Source/GLS.cgRegister.pas

@@ -4,7 +4,7 @@
 
 unit GLS.cgRegister;
 
-(*  Registration unit for CG shader *)
+(*  Registration unit for CG shader package *)
 
 interface
 

Source/GLSCrossXML.pas

@@ -1,12 +1,11 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-  Cross XML routines
-}
 
 unit GLSCrossXML;
 
+(* Cross XML routines *)
+
 interface
 
 uses

Source/GLScene.pas

@@ -8093,3 +8093,4 @@ initialization
   QueryPerformanceFrequency(vCounterFrequency);
 
 end.
+

Source/GLVectorFileObjects.pas

@@ -38,7 +38,7 @@ uses
   GLRenderContextInfo,
   GLCoordinates,
   GLBaseClasses,
-  GLTypes,
+  GLVectorRecTypes,
   GLTextureFormat;
 
 type

Source/GLTypes.pas → Source/GLVectorRecTypes.pas

@@ -1,10 +1,10 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-{
-   Defines common vector types as advanced records.
-}
-unit GLTypes;
+
+unit GLVectorRecTypes;
+
+(* Defines common vector types as advanced records *)
 
 interface
 
@@ -325,14 +325,14 @@ type
 type
   TxPolyhedron = array of TxPolygon3D;
 
-{
+(*
   TxPolyhedron = record
     Facets: array of TxPolygon3D;
     function NetLength;
     function Area;
     function Volume;
   end;
-}
+*)
 
 //--------------------------
 // Mesh simple record types
@@ -775,7 +775,9 @@ begin
 end;
 
 
-{ TxVector }
+//-----------------------------
+// TxVector
+//-----------------------------
 
 constructor TxVector.Create(V: TAbstractVector);
 begin
@@ -986,7 +988,9 @@ begin
   end;
 end;
 
-{ TxQuatHelper }
+//-----------------------------
+// TxQuatHelper
+//-----------------------------
 
 function TxQuatHelper.ToMatrix: TxMatrix;
 begin
@@ -1002,7 +1006,9 @@ begin
   Result[3, 3] := Sqr(FData[0]) - Sqr(FData[1]) - Sqr(FData[2]) + Sqr(FData[3]);
 end;
 
-{ TxVecHelper }
+//-----------------------------
+// TxVecHelper
+//-----------------------------
 
 function TxVecHelper.ToDiagMatrix: TxMatrix;
 var
@@ -1079,7 +1085,9 @@ begin
   end;
 end;
 
-{ TxDim }
+//-----------------------------
+// TxDim
+//-----------------------------
 
 constructor TxDim.Create(ARowCount: Integer; AColCount: Integer = 0);
 begin
@@ -1088,7 +1096,9 @@ begin
 end;
 
 
-{ TxPoint2D }
+//-----------------------------
+// TxPoint2D
+//-----------------------------
 
 function TxPoint2D.Create(X, Y : Single): TxPoint2D;
 begin
@@ -1129,7 +1139,9 @@ begin
   Result := Point.Distance(Center) <= Radius;
 end;
 
-{ TxPoint3D }
+//-----------------------------
+// TxPoint3D
+//-----------------------------
 
 function TxPoint3D.Create(X, Y, Z: Single): TxPoint3D;
 begin
@@ -1169,7 +1181,9 @@ begin
   Self.Z := Z;
 end;
 
-{ TxVector2D }
+//-----------------------------
+// TxVector2D
+//-----------------------------
 
 function TxVector2D.Create(const AX, AY, AW: Single): TxVector2D;
 begin
@@ -1226,7 +1240,7 @@ begin
 end;
 
 //---------------------------------
-{ TxVector3D }
+// TxVector3D
 //---------------------------------
 function TxVector3D.Create(const AX, AY, AZ, AW: Single): TxVector3D;
 begin
@@ -1287,7 +1301,7 @@ begin
 end;
 
 //---------------------------------
-{ TxQuaternion }
+// TxQuaternion
 //---------------------------------
 
 function TxQuaternion.GetElement(Index: Byte): Extended;

Source/GLVfsPAK.pas

@@ -1,452 +0,0 @@
-//
-// This unit is part of the GLScene Engine, http://glscene.org
-//
-(*
-   Support-code for loading files from Quake II PAK Files.
-   When instance is created all LoadFromFile methods using
-   GLApplicationFileIO mechanism will be pointed into PAK file.
-   You can change current PAK file by ActivePak variable.
-
-*)
-unit GLVfsPAK;
-
-{$I GLScene.inc}
-
-interface
-
-uses
-  System.Classes,
-  System.Contnrs,
-  System.SysUtils,
-
-  GLStrings,
-  GLApplicationFileIO;
-
-const
-   SIGN = 'PACK'; //Signature for uncompressed - raw pak.
-   SIGN_COMPRESSED = 'PACZ'; //Signature for compressed pak.
-
-type
-
-   TZCompressedMode = (Good, Fast, Auto, None);
-
-   TPakHeader = record
-      Signature: array[0..3] of AnsiChar;
-      DirOffset: integer;
-      DirLength: integer;
-   end;
-
-   TFileSection = record
-      FileName: array[0..119] of AnsiChar;
-      FilePos: integer;
-      FileLength: integer;
-   end;
-
-   TGLVfsPAK = class (TComponent)
-   private
-      FPakFiles: TStringList;
-      FHeader: TPakHeader;
-      FHeaderList: array of TPakHeader;
-      FStream: TFileStream;
-      FStreamList: TObjectList;
-      FFiles: TStrings;
-      FFilesLists: TObjectList;
-      FFileName: string;
-      FCompressionLevel: TZCompressedMode;
-      FCompressed: Boolean;
-      function GetFileCount: integer;
-      procedure MakeFileList;
-      function GetStreamNumber: integer;
-      procedure SetStreamNumber(i:integer);
-   public
-      property PakFiles: TStringList read FPakFiles;
-      property Files: TStrings read FFiles;
-      property ActivePakNum: integer read GetStreamNumber write SetStreamNumber;
-      property FileCount: integer Read GetFileCount;
-      property PakFileName: string Read FFileName;
-      property Compressed: Boolean read FCompressed;
-      property CompressionLevel: TZCompressedMode read FCompressionLevel;
-      constructor Create(AOwner : TComponent); overload; override;
-      constructor Create(AOwner : TComponent; const CbrMode: TZCompressedMode); reintroduce; overload;
-      destructor Destroy; override;
-      // for Mode value search Delphi Help for "File open mode constants"
-      procedure LoadFromFile(const FileName: string; Mode: word);
-      procedure ClearPakFiles;
-      function FileExists(const FileName: string): boolean;
-      function GetFile(index: integer): TStream; overload;
-      function GetFile(const FileName: string): TStream; overload;
-      function GetFileSize(index: integer): integer; overload;
-      function GetFileSize(const FileName: string): integer; overload;
-      procedure AddFromStream(const FileName, Path: string; F: TStream);
-      procedure AddFromFile(const FileName, Path: string);
-      procedure AddEmptyFile(const FileName, Path: string);
-      procedure RemoveFile(index: integer); overload;
-      procedure RemoveFile(const FileName: string); overload;
-      procedure Extract(index: integer; const NewName: string); overload;
-      procedure Extract(const FileName, NewName: string); overload;
-   end;
-
-// for GLApplicationFileIO unit
-function PAKCreateFileStream(const fileName: string; mode: word): TStream;
-function PAKFileStreamExists(const fileName: string): boolean;
-
-var
-   ActiveVfsPAK: TGLVfsPak;
-
-//---------------------------------------------------------------------
-implementation
-//---------------------------------------------------------------------
-
-var
-   Dir: TFileSection;
-
-function BackToSlash(const s: string): string;
-var
-   i: integer;
-begin
-   SetLength(Result, Length(s));
-   for i := 1 to Length(s) do
-      if s[i] = '\' then
-         Result[i] := '/'
-      else
-         Result[i] := s[i];
-end;
-
-// GLApplicationFileIO begin
-function PAKCreateFileStream(const fileName: string; mode: word): TStream;
-var
-   i: integer;
-begin
-   with ActiveVfsPAK do
-   for i:=FStreamList.Count-1 downto 0 do begin
-      FFiles:=TStrings(FFilesLists[i]);
-      if FileExists(BackToSlash(fileName)) then begin
-         FHeader:=FHeaderList[i];
-         FStream:=TFileStream(FStreamList[i]);
-         Result:=GetFile(BackToSlash(fileName));
-         Exit;
-      end
-      else begin
-        if FileExists(fileName) then begin
-          Result := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite);
-          Exit;
-         end
-         else begin
-            Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
-            Exit;
-         end;
-      end;
-   end;
-   if FileExists(fileName) then begin
-      Result := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite);
-      Exit;
-   end
-   else begin
-      Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
-      Exit;
-   end;
-   Result:=nil;
-end;
-
-function PAKFileStreamExists(const fileName: string): boolean;
-var
-   i: integer;
-begin
-   with ActiveVfsPAK do
-   for i:=0 to FStreamList.Count-1 do begin
-      FFiles:=TStrings(FFilesLists[i]);
-      if FileExists(BackToSlash(fileName)) then begin
-         Result:=True;
-         Exit;
-      end;
-   end;
-   Result := FileExists(fileName);
-end;
-
-//--------------------------
-// TGLVfsPAK
-//--------------------------
-
-function TGLVfsPAK.GetStreamNumber: integer;
-begin
-   Result:=FStreamList.IndexOf(FStream);
-end;
-
-procedure TGLVfsPAK.SetStreamNumber(i:integer);
-begin
-   FStream:=TFileStream(FStreamList[i]);
-end;
-
-constructor TGLVfsPAK.Create(AOwner : TComponent);
-begin
-   inherited Create(AOwner);
-   FPakFiles := TStringList.Create;
-   FStreamList := TObjectList.Create(True);
-   FFilesLists := TObjectList.Create(True);
-   ActiveVfsPAK := Self;
-   vAFIOCreateFileStream := PAKCreateFileStream;
-   vAFIOFileStreamExists := PAKFileStreamExists;
-   FCompressionLevel := None;
-   FCompressed := False;
-end;
-
-constructor TGLVfsPAK.Create(AOwner : TComponent; const CbrMode: TZCompressedMode);
-begin
-   Self.Create(AOwner);
-   FCompressionLevel := None;
-   FCompressed := FCompressionLevel <> None;
-end;
-
-destructor TGLVfsPAK.Destroy;
-begin
-   vAFIOCreateFileStream := nil;
-   vAFIOFileStreamExists := nil;
-   SetLength(FHeaderList, 0);
-   FPakFiles.Free;
-   // Objects are automatically freed by TObjectList
-   FStreamList.Free;
-   FFilesLists.Free;
-   ActiveVfsPAK := nil;
-   inherited Destroy;
-end;
-
-function TGLVfsPAK.GetFileCount: integer;
-begin
-   Result := FHeader.DirLength div SizeOf(TFileSection);
-end;
-
-procedure TGLVfsPAK.MakeFileList;
-var
-   I: integer;
-begin
-   FStream.Seek(FHeader.DirOffset, soFromBeginning);
-   FFiles.Clear;
-   for i := 0 to FileCount - 1 do
-   begin
-      FStream.ReadBuffer(Dir, SizeOf(TFileSection));
-      FFiles.Add(string(Dir.FileName));
-   end;
-end;
-
-procedure TGLVfsPAK.LoadFromFile(const FileName: string; Mode: word);
-var
-   l: integer;
-begin
-   FFileName := FileName;
-   FPakFiles.Clear;
-   FPakFiles.Add(FileName);
-   FFiles := TStringList.Create;
-   FStream := TFileStream.Create(FileName, Mode);
-   if FStream.Size = 0 then
-   begin
-    if FCompressed then
-      FHeader.Signature := SIGN_COMPRESSED
-    else
-      FHeader.Signature := SIGN;
-    FHeader.DirOffset := SizeOf(TPakHeader);
-    FHeader.DirLength := 0;
-    if FHeader.Signature = SIGN_COMPRESSED then begin
-     FStream.Free;
-     raise Exception.Create(FileName + ' - This is a compressed PAK file. This version of software does not support Compressed Pak files.');
-     Exit;
-    end;
-    FStream.WriteBuffer(FHeader, SizeOf(TPakHeader));
-    FStream.Position := 0;
-   end;
-   FStream.ReadBuffer(FHeader, SizeOf(TPakHeader));
-   if (FHeader.Signature <> SIGN) and (FHeader.Signature <> SIGN_COMPRESSED) then
-   begin
-      FStream.Free;
-      raise Exception.Create(FileName+' - This is not PAK file');
-      Exit;
-   end;
-
-   //Set the compression flag property.
-   FCompressed := FHeader.Signature = SIGN_COMPRESSED;
-   if FCompressed then begin
-    FStream.Free;
-    raise Exception.Create(FileName + ' - This is a compressed PAK file. This version of software does not support Compressed Pak files.');
-    Exit;
-   end;
-   if FileCount <> 0 then
-      MakeFileList;
-   l:=Length(FHeaderList);
-   SetLength(FHeaderList, l+1);
-   FHeaderList[l]:=FHeader;
-   FFilesLists.Add(FFiles);
-   FStreamList.Add(FStream);
-end;
-
-procedure TGLVfsPAK.ClearPakFiles;
-begin
-   SetLength(FHeaderList, 0);
-   FPakFiles.Clear;
-   // Objects are automatically freed by TObjectList
-   FStreamList.Clear;
-   FFilesLists.Clear;
-   ActiveVfsPAK := nil;
-end;
-
-function TGLVfsPAK.GetFile(index: integer): TStream;
-begin
-   FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index, soFromBeginning);
-   FStream.Read(Dir, SizeOf(TFileSection));
-   FStream.Seek(Dir.FilePos, soFromBeginning);
-   Result := TMemoryStream.Create;
-   Result.CopyFrom(FStream, Dir.FileLength);
-   Result.Position := 0;
-end;
-
-function TGLVfsPAK.FileExists(const FileName: string): boolean;
-begin
-   Result := (FFiles.IndexOf(FileName) > -1);
-end;
-
-function TGLVfsPAK.GetFile(const FileName: string): TStream;
-begin
-   Result := nil;
-   if Self.FileExists(FileName) then
-      Result := GetFile(FFiles.IndexOf(FileName));
-end;
-
-function TGLVfsPAK.GetFileSize(index: integer): integer;
-begin
-   FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index, soFromBeginning);
-   FStream.Read(Dir, SizeOf(Dir));
-   Result := Dir.FileLength;
-end;
-
-function TGLVfsPAK.GetFileSize(const FileName: string): integer;
-begin
-   Result := -1;
-   if Self.FileExists(FileName) then
-      Result := GetFileSize(FFiles.IndexOf(FileName));
-end;
-
-{$WARNINGS OFF}
-procedure TGLVfsPAK.AddFromStream(const FileName, Path: string; F: TStream);
-var
-   Temp: TMemoryStream;
-begin
-   FStream.Position := FHeader.DirOffset;
-   if FHeader.DirLength > 0 then
-   begin
-      Temp := TMemoryStream.Create;
-      Temp.CopyFrom(FStream, FHeader.DirLength);
-      Temp.Position    := 0;
-      FStream.Position := FHeader.DirOffset;
-   end;
-   Dir.FilePos    := FHeader.DirOffset;
-
-   Dir.FileLength := F.Size;
-   FStream.CopyFrom(F, 0);
-   FHeader.DirOffset := FStream.Position;
-   if FHeader.DirLength > 0 then
-   begin
-      FStream.CopyFrom(Temp, 0);
-      Temp.Free;
-   end;
-   StrPCopy(Dir.FileName, Path + ExtractFileName(FileName));
-   FStream.WriteBuffer(Dir, SizeOf(TFileSection));
-   FHeader.DirLength := FHeader.DirLength + SizeOf(TFileSection);
-   FStream.Position  := 0;
-   FStream.WriteBuffer(FHeader, SizeOf(TPakHeader));
-   FFiles.Add(Dir.FileName);
-end;
-
-{$WARNINGS ON}
-
-procedure TGLVfsPAK.AddFromFile(const FileName, Path: string);
-var
-   F: TFileStream;
-begin
-   if not FileExists(FileName) then
-      exit;
-   F := TFileStream.Create(FileName, fmOpenRead);
-   try
-      AddFromStream(FileName, Path, F);
-   finally
-      F.Free;
-   end;
-end;
-
-procedure TGLVfsPAK.AddEmptyFile(const FileName, Path: string);
-var
-   F: TMemoryStream;
-begin
-   F := TMemoryStream.Create;
-   try
-      AddFromStream(FileName, Path, F);
-   finally
-      F.Free;
-   end;
-end;
-
-procedure TGLVfsPAK.RemoveFile(index: integer);
-var
-   Temp: TMemoryStream;
-   i:    integer;
-   f:    TFileSection;
-begin
-   Temp := TMemoryStream.Create;
-   FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index, soFromBeginning);
-   FStream.ReadBuffer(Dir, SizeOf(TFileSection));
-   FStream.Seek(Dir.FilePos + Dir.FileLength, soFromBeginning);
-   Temp.CopyFrom(FStream, FStream.Size - FStream.Position);
-   FStream.Position := Dir.FilePos;
-   FStream.CopyFrom(Temp, 0);
-   FHeader.DirOffset := FHeader.DirOffset - dir.FileLength;
-   Temp.Clear;
-   for i := 0 to FileCount - 1 do
-      if i > index then
-      begin
-         FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * i, soFromBeginning);
-         FStream.ReadBuffer(f, SizeOf(TFileSection));
-         FStream.Position := FStream.Position - SizeOf(TFileSection);
-         f.FilePos := f.FilePos - dir.FileLength;
-         FStream.WriteBuffer(f, SizeOf(TFileSection));
-      end;
-
-   i := FHeader.DirOffset + SizeOf(TFileSection) * index;
-   FStream.Position := i + SizeOf(TFileSection);
-   if FStream.Position < FStream.Size then
-   begin
-      Temp.CopyFrom(FStream, FStream.Size - FStream.Position);
-      FStream.Position := i;
-      FStream.CopyFrom(Temp, 0);
-   end;
-   Temp.Free;
-   FHeader.DirLength := FHeader.DirLength - SizeOf(TFileSection);
-   FStream.Position  := 0;
-   FStream.WriteBuffer(FHeader, SizeOf(TPakHeader));
-   FStream.Size := FStream.Size - dir.FileLength - SizeOf(TFileSection);
-   MakeFileList;
-end;
-
-procedure TGLVfsPAK.RemoveFile(const FileName: string);
-begin
-   if Self.FileExists(FileName) then
-      RemoveFile(FFiles.IndexOf(FileName));
-end;
-
-procedure TGLVfsPAK.Extract(index: integer; const NewName: string);
-var
-   s: TFileStream;
-begin
-   if NewName = '' then
-      Exit;
-   if (index < 0) or (index >= FileCount) then
-      exit;
-   s := TFileStream.Create(NewName, fmCreate);
-   s.CopyFrom(GetFile(index), 0);
-   s.Free;
-end;
-
-procedure TGLVfsPAK.Extract(const FileName, NewName: string);
-begin
-   if Self.FileExists(FileName) then
-      Extract(FFiles.IndexOf(FileName), NewName);
-end;
-
-
-end.

Source/OpenGLTokens.pas

@@ -1,18 +1,18 @@
 //
 // This unit is part of the GLScene Engine, http://glscene.org
 //
-(*
-   OpenGL tokens
-*)
+
 unit OpenGLTokens;
 
+(* OpenGL tokens *)
+
 interface
 
 {$I GLScene.inc}
 
 uses
-  System.SysUtils,
   Winapi.Windows,
+  System.SysUtils,
   GLVectorTypes;
 
 type