├── CubeMan3D ├── CubeMan3D.gif ├── readme.md └── src │ ├── CubeManFMX3D.dpr │ ├── CubeManFMX3D.dproj │ ├── CubeManFMX3D.res │ ├── Main.fmx │ └── Main.pas ├── GLPanel ├── Entitlement.TemplateOSX32.xml ├── Execute.CrossGL.pas ├── Execute.CubeMan.pas ├── Execute.FMX.GLPanels.Types.pas ├── Execute.FMX.GLPanels.Win.pas ├── Execute.FMX.GLPanels.pas ├── Execute.Presentation.Mac.pas ├── GLPanel.png ├── GLPanelDemo.dpr ├── GLPanelDemo.dproj ├── GLPanelDemo.res ├── GlPanelMac.png ├── Main.fmx ├── Main.pas └── readme.md ├── Isometric ├── Isometric.dpr ├── Isometric.dproj ├── Isometric.png ├── Isometric.res ├── Main.fmx ├── Main.pas └── readme.md ├── LICENSE ├── MoreThan8Lights ├── FMXLights.dpr ├── FMXLights.dproj ├── FMXLights.res ├── Main.fmx ├── Main.pas ├── readme.md ├── screen1.png ├── screen2.png └── screen3.png ├── PuzzleSolver ├── readme.md └── src │ ├── PuzzleSolver.Main.fmx │ ├── PuzzleSolver.Main.pas │ ├── PuzzleSolver.dpr │ ├── PuzzleSolver.dproj │ └── PuzzleSolver.res ├── README.md ├── SourceShaders ├── Execute.ShaderMaterial.pas ├── Form1.png ├── Main.fmx ├── Main.pas ├── ShaderSource.dpr ├── ShaderSource.dproj └── readme.md ├── TextPath ├── Execute.FMX.TextPath.fmx ├── Execute.FMX.TextPath.pas ├── Execute.FMX.TextPathDesigner.dpk ├── Execute.FMX.TextPathDesigner.dproj ├── Execute.FontBuilder.pas ├── TextPath.png ├── TextPath2.png └── readme.md └── WoodTexture ├── NathaanTFM.AS3Perlin.pas ├── Wood.FlashLike.pas ├── Wood.gif ├── WoodTexture.Main.fmx ├── WoodTexture.Main.pas ├── WoodTexture.dpr ├── WoodTexture.dproj ├── WoodTexture.res └── readme.md /CubeMan3D/CubeMan3D.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/CubeMan3D/CubeMan3D.gif -------------------------------------------------------------------------------- /CubeMan3D/readme.md: -------------------------------------------------------------------------------- 1 | # CubeMan3D for FMX 2 | 3 | Not a single line of code for this FMX demo :) 4 | 5 | ![screenshot](CubeMan3D.gif) -------------------------------------------------------------------------------- /CubeMan3D/src/CubeManFMX3D.dpr: -------------------------------------------------------------------------------- 1 | program CubeManFMX3D; 2 | 3 | uses 4 | // Removing those 2 units speedup a little the application starting process 5 | // System.StartUpCopy, 6 | // FMX.MobilePreview, 7 | FMX.Forms, 8 | Main in 'Main.pas' {Form1}; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /CubeMan3D/src/CubeManFMX3D.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/CubeMan3D/src/CubeManFMX3D.res -------------------------------------------------------------------------------- /CubeMan3D/src/Main.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | Color = xFFFFFFFE 6 | ClientHeight = 653 7 | ClientWidth = 652 8 | FormFactor.Width = 320 9 | FormFactor.Height = 480 10 | FormFactor.Devices = [Desktop] 11 | DesignerMobile = True 12 | DesignerWidth = 652 13 | DesignerHeight = 653 14 | DesignerDeviceName = '' 15 | DesignerOrientation = 0 16 | DesignerOSVersion = '' 17 | object body: TRoundCube 18 | Position.X = 0.001703739166259766 19 | Position.Y = 25.150325775146480000 20 | Position.Z = 100.000000000000000000 21 | RotationAngle.Y = 30.000000000000000000 22 | Width = 15.000000000000000000 23 | Height = 17.000000000000000000 24 | Depth = 10.000000000000000000 25 | MaterialSource = LightMaterialSource1 26 | Quanternion = '(0,0.258819043636322,0,0.965925812721252)' 27 | object head: TRoundCube 28 | Position.Y = -15.000000000000000000 29 | Width = 10.000000000000000000 30 | Height = 10.000000000000000000 31 | Depth = 10.000000000000000000 32 | MaterialSource = LightMaterialSource1 33 | end 34 | object Shoulder2: TDummy 35 | Position.X = 7.500000000000000000 36 | Position.Y = -8.500000000000000000 37 | RotationAngle.Z = 315.000000000000000000 38 | Width = 1.000000000000000000 39 | Height = 1.000000000000000000 40 | Depth = 1.000000000000000000 41 | Quanternion = 42 | '(-4.92974940868862E-8,-4.31467590544798E-8,-0.382683396339417,0.' + 43 | '923879444599152)' 44 | object Arm2: TRoundCube 45 | Position.Y = 5.000000000000000000 46 | Width = 6.000000000000000000 47 | Height = 10.000000000000000000 48 | Depth = 6.000000000000000000 49 | MaterialSource = LightMaterialSource1 50 | object Elbow2: TDummy 51 | Position.Y = 5.000000000000000000 52 | Width = 1.000000000000000000 53 | Height = 1.000000000000000000 54 | Depth = 1.000000000000000000 55 | object Forearm2: TRoundCube 56 | Position.Y = 5.000000000000000000 57 | Width = 6.000000000000000000 58 | Height = 10.000000000000000000 59 | Depth = 6.000000000000000000 60 | MaterialSource = LightMaterialSource1 61 | end 62 | object Forearm2Animation: TFloatAnimation 63 | AutoReverse = True 64 | Enabled = True 65 | Duration = 0.500000000000000000 66 | Loop = True 67 | PropertyName = 'RotationAngle.X' 68 | StartValue = 0.000000000000000000 69 | StopValue = -90.000000000000000000 70 | end 71 | end 72 | end 73 | object Arm2Animation: TFloatAnimation 74 | AutoReverse = True 75 | Enabled = True 76 | Duration = 1.000000000000000000 77 | Loop = True 78 | PropertyName = 'RotationAngle.X' 79 | StartValue = -80.000000000000000000 80 | StopValue = 80.000000000000000000 81 | end 82 | end 83 | object Shoulder1: TDummy 84 | Position.X = -7.500000000000000000 85 | Position.Y = -8.500000000000000000 86 | RotationAngle.Z = 45.000000000000000000 87 | Width = 1.000000000000000000 88 | Height = 1.000000000000000000 89 | Depth = 1.000000000000000000 90 | Quanternion = '(0,0,0.382683455944061,0.923879504203796)' 91 | object Arm1: TRoundCube 92 | Position.Y = 5.000000000000000000 93 | Width = 6.000000000000000000 94 | Height = 10.000000000000000000 95 | Depth = 6.000000000000000000 96 | MaterialSource = LightMaterialSource1 97 | object Elbow1: TDummy 98 | Position.Y = 5.000000000000000000 99 | Width = 1.000000000000000000 100 | Height = 1.000000000000000000 101 | Depth = 1.000000000000000000 102 | object Forearm1: TRoundCube 103 | Position.Y = 5.000000000000000000 104 | Width = 6.000000000000000000 105 | Height = 10.000000000000000000 106 | Depth = 6.000000000000000000 107 | MaterialSource = LightMaterialSource1 108 | end 109 | object Forearm1Animation: TFloatAnimation 110 | AutoReverse = True 111 | Enabled = True 112 | Duration = 0.500000000000000000 113 | Loop = True 114 | PropertyName = 'RotationAngle.X' 115 | StartValue = 0.000000000000000000 116 | StopValue = -90.000000000000000000 117 | end 118 | end 119 | end 120 | object Arm1Animation: TFloatAnimation 121 | AutoReverse = True 122 | Enabled = True 123 | Duration = 1.000000000000000000 124 | Loop = True 125 | PropertyName = 'RotationAngle.X' 126 | StartValue = 80.000000000000000000 127 | StopValue = -80.000000000000000000 128 | end 129 | end 130 | object Pelvis1: TDummy 131 | Position.X = -5.000000000000000000 132 | Position.Y = 8.500000000000000000 133 | Width = 1.000000000000000000 134 | Height = 1.000000000000000000 135 | Depth = 1.000000000000000000 136 | object Thigh1: TRoundCube 137 | Position.Y = 5.000000000000000000 138 | Width = 6.000000000000000000 139 | Height = 10.000000000000000000 140 | Depth = 6.000000000000000000 141 | MaterialSource = LightMaterialSource1 142 | object Knee1: TDummy 143 | Position.Y = 5.000000000000000000 144 | Width = 1.000000000000000000 145 | Height = 1.000000000000000000 146 | Depth = 1.000000000000000000 147 | object Leg1: TRoundCube 148 | Position.Y = 5.000000000000000000 149 | Width = 6.000000000000000000 150 | Height = 10.000000000000000000 151 | Depth = 6.000000000000000000 152 | MaterialSource = LightMaterialSource1 153 | end 154 | object Leg1KeyAnimation: TFloatKeyAnimation 155 | Enabled = True 156 | Duration = 2.000000000000000000 157 | Keys = < 158 | item 159 | end 160 | item 161 | Key = 0.500000000000000000 162 | end 163 | item 164 | Key = 0.800000011920929000 165 | Value = 120.000000000000000000 166 | end 167 | item 168 | Key = 1.000000000000000000 169 | end> 170 | Loop = True 171 | PropertyName = 'RotationAngle.X' 172 | StartFromCurrent = False 173 | end 174 | end 175 | end 176 | object Thigh1Animation: TFloatAnimation 177 | AutoReverse = True 178 | Enabled = True 179 | Duration = 1.000000000000000000 180 | Loop = True 181 | PropertyName = 'RotationAngle.X' 182 | StartValue = -45.000000000000000000 183 | StopValue = 45.000000000000000000 184 | end 185 | end 186 | object Pelvis2: TDummy 187 | Position.X = 5.000000000000000000 188 | Position.Y = 8.500000000000000000 189 | Width = 1.000000000000000000 190 | Height = 1.000000000000000000 191 | Depth = 1.000000000000000000 192 | object Thigh2: TRoundCube 193 | Position.Y = 5.000000000000000000 194 | Width = 6.000000000000000000 195 | Height = 10.000000000000000000 196 | Depth = 6.000000000000000000 197 | MaterialSource = LightMaterialSource1 198 | object Knee2: TDummy 199 | Position.Y = 5.000000000000000000 200 | Width = 1.000000000000000000 201 | Height = 1.000000000000000000 202 | Depth = 1.000000000000000000 203 | object Leg2: TRoundCube 204 | Position.Y = 5.000000000000000000 205 | Width = 6.000000000000000000 206 | Height = 10.000000000000000000 207 | Depth = 6.000000000000000000 208 | MaterialSource = LightMaterialSource1 209 | end 210 | object Leg2KeyAnimation: TFloatKeyAnimation 211 | Enabled = True 212 | Duration = 2.000000000000000000 213 | Keys = < 214 | item 215 | end 216 | item 217 | Key = 0.300000011920929000 218 | Value = 120.000000000000000000 219 | end 220 | item 221 | Key = 0.500000000000000000 222 | end 223 | item 224 | Key = 1.000000000000000000 225 | end> 226 | Loop = True 227 | PropertyName = 'RotationAngle.X' 228 | StartFromCurrent = False 229 | end 230 | end 231 | end 232 | object Thigh2Animation: TFloatAnimation 233 | AutoReverse = True 234 | Enabled = True 235 | Duration = 1.000000000000000000 236 | Loop = True 237 | PropertyName = 'RotationAngle.X' 238 | StartValue = 60.000000000000000000 239 | StopValue = -60.000000000000000000 240 | end 241 | end 242 | object TurnAround: TFloatAnimation 243 | Enabled = True 244 | Duration = 15.000000000000000000 245 | Loop = True 246 | PropertyName = 'RotationAngle.Y' 247 | StartValue = 0.000000000000000000 248 | StopValue = 360.000000000000000000 249 | end 250 | end 251 | object Light1: TLight 252 | Color = claWhite 253 | LightType = Directional 254 | SpotCutOff = 180.000000000000000000 255 | Position.X = -7.463888168334961000 256 | Position.Y = 14.385499954223630000 257 | Position.Z = 10.000011444091800000 258 | RotationAngle.X = 6.787704467773438000 259 | RotationAngle.Y = 15.729310035705570000 260 | RotationAngle.Z = 359.635833740234400000 261 | Width = 1.000000000000000000 262 | Height = 1.000000000000000000 263 | Depth = 1.000000000000000000 264 | Quanternion = 265 | '(0.0582080632448196,0.136406436562538,-0.0112425368279219,0.9888' + 266 | '77713680267)' 267 | end 268 | object LightMaterialSource1: TLightMaterialSource 269 | Diffuse = xFF7F7FFF 270 | Ambient = xFF00007F 271 | Emissive = claNull 272 | Specular = xFF606060 273 | Shininess = 30 274 | Left = 184 275 | Top = 280 276 | end 277 | end 278 | -------------------------------------------------------------------------------- /CubeMan3D/src/Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/CubeMan3D/src/Main.pas -------------------------------------------------------------------------------- /GLPanel/Entitlement.TemplateOSX32.xml: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | <%appSandboxKeys%> 6 | 7 | 8 | -------------------------------------------------------------------------------- /GLPanel/Execute.CrossGL.pas: -------------------------------------------------------------------------------- 1 | unit Execute.CrossGL; 2 | 3 | { 4 | Cross-platform OpenGL implementation for Delphi Tokyo 5 | 6 | (c)2017 Execute SARL 7 | 8 | http://www.execute.fr 9 | 10 | } 11 | 12 | interface 13 | 14 | uses 15 | System.SysUtils, 16 | System.Math 17 | 18 | {$IFDEF Android} 19 | ,Androidapi.Log 20 | ,Androidapi.AppGlue 21 | ,Androidapi.Looper 22 | ,Androidapi.Egl 23 | ,Androidapi.Gles 24 | ,Androidapi.NativeWindow 25 | {$ENDIF} 26 | 27 | {$IFDEF MSWINDOWS} 28 | ,Winapi.Windows 29 | ,Winapi.Messages 30 | ,Winapi.OpenGL 31 | {$ENDIF} 32 | 33 | {$IFDEF MACOS} 34 | ,Macapi.Mach 35 | ,Macapi.CocoaTypes 36 | // ,Execute.MacOS 37 | {$ENDIF}; 38 | 39 | const 40 | GL_NO_ERROR =$0000; 41 | 42 | GL_ZERO =$0000; 43 | GL_ONE =$0001; 44 | 45 | GL_POINTS =$0000; // Treats each vertex as a single point. Vertex n defines point n. N points are drawn. 46 | GL_LINES =$0001; // Treats each pair of vertexes as an independent line segment. Vertexes 2n - 1 and 2n define line n. N/2 lines are drawn. 47 | GL_LINE_LOOP =$0002; // Draws a connected group of line segments from the first vertex to the last, then back to the first. Vertexes n and n+1 define line n. The last line, however, is defined by vertexes N and 1. N lines are drawn. 48 | GL_LINE_STRIP =$0003; // Draws a connected group of line segments from the first vertex to the last. Vertexes n and n+1 define line n. N - 1 lines are drawn. 49 | GL_TRIANGLES =$0004; // Treats each triplet of vertexes as an independent triangle. Vertexes 3n - 2, 3n-1, and 3n define triangle n. N/3 triangles are drawn. 50 | GL_TRIANGLE_STRIP =$0005; // Draws a connected group of triangles. One triangle is defined for each vertex presented after the first two vertexes. For odd n, vertexes n, n+1, and n+2 define triangle n. 51 | // For even n, vertexes n+1, n, and n+2 define triangle n. N - 2 triangles are drawn. 52 | GL_TRIANGLE_FAN =$0006; // Draws a connected group of triangles. One triangle is defined for each vertex presented after the first two vertexes. Vertexes 1, n+1, and n+2 define triangle n. N - 2 triangles are drawn. 53 | GL_QUADS =$0007; // Treats each group of four vertexes as an independent quadrilateral. Vertexes 4n - 3, 4n - 2, 4n - 1, and 4n define quadrilateral n. N/4 quadrilaterals are drawn. 54 | GL_QUAD_STRIP =$0008; // Draws a connected group of quadrilaterals. One quadrilateral is defined for each pair of vertexes presented after the first pair. Vertexes 2n - 1, 2n, 2n+2, and 2n+1 define quadrilateral n. N quadrilaterals are drawn. Note that the order in which vertexes are used to construct a quadrilateral from strip data is different from that used with independent data. 55 | GL_POLYGON =$0009; // Draws a single, convex polygon. Vertexes 1 through N define this polygon. 56 | 57 | GL_DEPTH_BUFFER_BIT =$0100; // Indicates the depth buffer. 58 | 59 | GL_ACCUM =$0100; 60 | GL_LOAD =$0101; 61 | GL_RETURN =$0102; 62 | GL_MULT =$0103; 63 | GL_ADD =$0104; 64 | 65 | GL_ACCUM_BUFFER_BIT =$0200; // Indicates the accumulation buffer. 66 | GL_NEVER =$0200; // Never passes. 67 | GL_LESS =$0201; // Passes if the incoming z value is less than the stored z value. 68 | GL_EQUAL =$0202; // Passes if the incoming z value is equal to the stored z value. 69 | GL_LEQUAL =$0203; // Passes if the incoming z value is less than or equal to the stored z value. 70 | GL_GREATER =$0204; // Passes if the incoming z value is greater than the stored z value. 71 | GL_NOTEQUAL =$0205; // Passes if the incoming z value is not equal to the stored z value. 72 | GL_GEQUAL =$0206; // Passes if the incoming z value is greater than or equal to the stored z value. 73 | GL_ALWAYS =$0207; // Always passes. 74 | 75 | GL_SRC_COLOR =$0300; 76 | GL_ONE_MINUS_SRC_COLOR =$0301; 77 | GL_SRC_ALPHA =$0302; 78 | GL_ONE_MINUS_SRC_ALPHA =$0303; 79 | GL_DST_ALPHA =$0304; 80 | GL_ONE_MINUS_DST_ALPHA =$0305; 81 | GL_DST_COLOR =$0306; 82 | GL_ONE_MINUS_DST_COLOR =$0307; 83 | GL_SRC_ALPHA_SATURATE =$0308; 84 | 85 | GL_STENCIL_BUFFER_BIT =$0400; // Indicates the stencil buffer. 86 | GL_FRONT =$0404; 87 | GL_BACK =$0405; 88 | GL_FRONT_AND_BACK =$0408; 89 | 90 | GL_INVALID_ENUM =$0500; // is generated if cap is not one of the values listed above. 91 | GL_INVALID_VALUE =$0501; 92 | GL_INVALID_OPERATION =$0502; // is generated if glEnable is called between a call to glBegin and the corresponding call to glEnd. 93 | GL_STACK_OVERFLOW =$0503; 94 | GL_STACK_UNDERFLOW =$0504; 95 | GL_OUT_OF_MEMORY =$0505; 96 | 97 | GL_EXP =$0800; 98 | GL_EXP2 =$0801; 99 | 100 | GL_CW =$0900; 101 | GL_CCW =$0901; 102 | 103 | GL_POINT_SMOOTH =$0B10; // If enabled, draw points with proper filtering. Otherwise, draw aliased points. See glPointSize. 104 | GL_LINE_SMOOTH =$0B20; // If enabled, draw lines with correct filtering. Otherwise, draw aliased lines. See glLineWidth. 105 | GL_LINE_STIPPLE =$0B24; // If enabled, use the current line stipple pattern when drawing lines. See glLineStipple. 106 | GL_POLYGON_SMOOTH =$0B41; // If enabled, draw polygons with proper filtering. Otherwise, draw aliased polygons. See glPolygonMode. 107 | GL_POLYGON_STIPPLE =$0B42; // If enabled, use the current polygon stipple pattern when rendering polygons. See glPolygonStipple. 108 | GL_CULL_FACE =$0B44; // If enabled, cull polygons based on their winding in window coordinates. See glCullFace. 109 | GL_LIGHTING =$0B50; // If enabled, use the current lighting parameters to compute the vertex color or index. Otherwise, simply associate the current color or index with each vertex. See glMaterial, glLightModel, and glLight. 110 | GL_LIGHT_MODEL_LOCAL_VIEWER =$0B51; 111 | GL_LIGHT_MODEL_TWO_SIDE =$0B52; 112 | GL_LIGHT_MODEL_AMBIENT =$0B53; 113 | GL_COLOR_MATERIAL =$0B57; // If enabled, have one or more material parameters track the current color. See glColorMaterial. 114 | GL_FOG =$0B60; // If enabled, blend a fog color into the posttexturing color. See glFog. 115 | GL_FOG_INDEX =$0B61; 116 | GL_FOG_DENSITY =$0B62; 117 | GL_FOG_START =$0B63; 118 | GL_FOG_END =$0B64; 119 | GL_FOG_MODE =$0B65; 120 | GL_FOG_COLOR =$0B66; 121 | GL_DEPTH_TEST =$0B71; // If enabled, do depth comparisons and update the depth buffer. See glDepthFunc and glDepthRange. 122 | GL_ACCUM_CLEAR_VALUE =$0B80; 123 | GL_STENCIL_TEST =$0B90; // If enabled, do stencil testing and update the stencil buffer. See glStencilFunc and glStencilOp. 124 | GL_NORMALIZE =$0BA1; // If enabled, normal vectors specified with glNormal are scaled to unit length after transformation. See glNormal. 125 | GL_VIEWPORT =$0BA2; 126 | GL_MODELVIEW_MATRIX =$0BA6; 127 | GL_PROJECTION_MATRIX =$0BA7; 128 | GL_ALPHA_TEST =$0BC0; // If enabled, do alpha testing. See glAlphaFunc. 129 | GL_DITHER =$0BD0; // If enabled, dither color components or indices before they are written to the color buffer. 130 | GL_BLEND_DST =$0BE0; 131 | GL_BLEND_SRC =$0BE1; 132 | GL_BLEND =$0BE2; // If enabled, blend the incoming RGBA color values with the values in the color buffers. See glBlendFunc. 133 | GL_LOGIC_OP =$0BF1; // If enabled, apply the currently selected logical operation to the incoming and color buffer indices. See glLogicOp. 134 | 135 | GL_SCISSOR_TEST =$0C11; // If enabled, discard fragments that are outside the scissor rectangle. See glScissor. 136 | GL_PERSPECTIVE_CORRECTION_HINT =$0C50; 137 | GL_POINT_SMOOTH_HINT =$0C51; 138 | GL_LINE_SMOOTH_HINT =$0C52; 139 | GL_POLYGON_SMOOTH_HINT =$0C53; 140 | GL_FOG_HINT =$0C54; 141 | GL_TEXTURE_GEN_S =$0C60; // If enabled, the s texture coordinate is computed using the texture generation function defined with glTexGen. Otherwise, the current s texture coordinate is used. 142 | GL_TEXTURE_GEN_T =$0C61; // If enabled, the t texture coordinate is computed using the texture generation function defined with glTexGen. Otherwise, the current t texture coordinate is used. 143 | GL_TEXTURE_GEN_Q =$0C63; // If enabled, the q texture coordinate is computed using the texture generation function defined with glTexGen. Otherwise, the current q texture coordinate is used. 144 | GL_TEXTURE_GEN_R =$0C62; // If enabled, the r texture coordinate is computed using the texture generation function defined with glTexGen. Otherwise, the current r texture coordinate is used. 145 | GL_UNPACK_SWAP_BYTES =$0CF0; 146 | GL_UNPACK_LSB_FIRST =$0CF1; 147 | GL_UNPACK_ROW_LENGTH =$0CF2; 148 | GL_UNPACK_SKIP_PIXELS =$0CF4; 149 | GL_UNPACK_SKIP_ROWS =$0CF3; 150 | GL_UNPACK_ALIGNMENT =$0CF5; 151 | 152 | GL_PACK_SWAP_BYTES =$0D00; 153 | GL_PACK_LSB_FIRST =$0D01; 154 | GL_PACK_ROW_LENGTH =$0D02; 155 | GL_PACK_SKIP_PIXELS =$0D04; 156 | GL_PACK_SKIP_ROWS =$0D03; 157 | GL_PACK_ALIGNMENT =$0D05; 158 | GL_AUTO_NORMAL =$0D80; // If enabled, compute surface normal vectors analytically when either GL_MAP2_VERTEX_3 or GL_MAP2_VERTEX_4 is used to generate vertexes. See glMap2. 159 | 160 | GL_TEXTURE_1D =$0DE0; // If enabled, one-dimensional texturing is performed (unless two-dimensional texturing is also enabled). See glTexImage1D. 161 | GL_TEXTURE_2D =$0DE1; // If enabled, two-dimensional texturing is performed. See glTexImage2D. 162 | 163 | GL_DONT_CARE =$1100; // The client doesn't have a preference. 164 | GL_FASTEST =$1101; // The most efficient option should be chosen. 165 | GL_NICEST =$1102; // The most correct, or highest quality, option should be chosen. 166 | 167 | GL_AMBIENT =$1200; 168 | GL_DIFFUSE =$1201; 169 | GL_SPECULAR =$1202; 170 | GL_POSITION =$1203; 171 | GL_SPOT_DIRECTION =$1204; 172 | GL_SPOT_EXPONENT =$1205; 173 | GL_SPOT_CUTOFF =$1206; 174 | GL_CONSTANT_ATTENUATION =$1207; 175 | GL_LINEAR_ATTENUATION =$1208; 176 | GL_QUADRATIC_ATTENUATION =$1209; 177 | 178 | GL_COMPILE =$1300; 179 | GL_COMPILE_AND_EXECUTE =$1301; 180 | 181 | GL_BYTE =$1400; 182 | GL_UNSIGNED_BYTE =$1401; 183 | GL_SHORT =$1402; 184 | GL_UNSIGNED_SHORT =$1403; 185 | GL_INT =$1404; 186 | GL_UNSIGNED_INT =$1405; 187 | GL_FLOAT =$1406; 188 | GL_2_BYTES =$1407; 189 | GL_3_BYTES =$1408; 190 | GL_4_BYTES =$1409; 191 | GL_DOUBLE =$140A; 192 | GL_DOUBLE_EXT =$140A; 193 | 194 | GL_INVERT =$150A; 195 | 196 | GL_EMISSION =$1600; 197 | GL_SHININESS =$1601; 198 | GL_AMBIENT_AND_DIFFUSE =$1602; 199 | 200 | GL_MODELVIEW =$1700; // Applies subsequent matrix operations to the modelview matrix stack. 201 | GL_PROJECTION =$1701; // Applies subsequent matrix operations to the projection matrix stack. 202 | GL_TEXTURE =$1702; // Applies subsequent matrix operations to the texture matrix stack. 203 | 204 | GL_COLOR_INDEX =$1900; 205 | GL_RED =$1903; 206 | GL_GREEN =$1904; 207 | GL_BLUE =$1905; 208 | GL_ALPHA =$1906; 209 | GL_RGB =$1907; 210 | GL_RGBA =$1908; 211 | GL_LUMINANCE =$1909; 212 | GL_LUMINANCE_ALPHA =$190A; 213 | 214 | GL_BITMAP =$1A00; 215 | 216 | GL_POINT =$1B00; 217 | GL_LINE =$1B01; 218 | GL_FILL =$1B02; 219 | 220 | GL_RENDER =$1C00; 221 | GL_FEEDBACK =$1C01; 222 | GL_SELECT =$1C02; 223 | 224 | GL_FLAT =$1D00; 225 | GL_SMOOTH =$1D01; 226 | 227 | GL_KEEP =$1E00; 228 | GL_REPLACE =$1E01; 229 | GL_INCR =$1E02; 230 | GL_DECR =$1E03; 231 | 232 | GL_VENDOR =$1F00; // Returns the company responsible for this GL implementation. This name does not change from release to release. 233 | GL_RENDERER =$1F01; // Returns the name of the renderer. This name is typically specific to a particular configuration of a hardware platform. It does not change from release to release. 234 | GL_VERSION =$1F02; // Returns a version or release number. 235 | GL_EXTENSIONS =$1F03; // Returns a space-separated list of supported extensions to GL. ); 236 | 237 | GL_MODULATE =$2100; 238 | GL_DECAL =$2101; 239 | 240 | GL_TEXTURE_ENV_MODE =$2200; 241 | GL_TEXTURE_ENV_COLOR =$2201; 242 | GL_TEXTURE_ENV =$2300; 243 | 244 | GL_NEAREST =$2600; 245 | GL_LINEAR =$2601; 246 | 247 | GL_NEAREST_MIPMAP_NEAREST =$2700; 248 | GL_LINEAR_MIPMAP_NEAREST =$2701; 249 | GL_NEAREST_MIPMAP_LINEAR =$2702; 250 | GL_LINEAR_MIPMAP_LINEAR =$2703; 251 | 252 | GL_TEXTURE_MAG_FILTER =$2800; 253 | GL_TEXTURE_MIN_FILTER =$2801; 254 | GL_TEXTURE_WRAP_S =$2802; 255 | GL_TEXTURE_WRAP_T =$2803; 256 | 257 | GL_CLAMP =$2900; 258 | GL_REPEAT =$2901; 259 | 260 | GL_COLOR_BUFFER_BIT =$4000; // Indicates the buffers currently enabled for color writing. 261 | GL_LIGHT0 =$4000; // If enabled, include light i in the evaluation of the lighting equation. See glLightModel and glLight. 262 | GL_LIGHT1 =$4001; 263 | GL_LIGHT2 =$4002; 264 | GL_LIGHT3 =$4003; 265 | GL_LIGHT4 =$4004; 266 | GL_LIGHT5 =$4005; 267 | GL_LIGHT6 =$4006; 268 | GL_LIGHT7 =$4007; 269 | 270 | GL_POLYGON_OFFSET_EXT =$8037; 271 | GL_POLYGON_OFFSET_FILL =$8037; 272 | 273 | GL_VERTEX_ARRAY =$8074; 274 | GL_NORMAL_ARRAY =$8075; 275 | GL_COLOR_ARRAY =$8076; 276 | GL_INDEX_ARRAY =$8077; 277 | GL_TEXTURE_COORD_ARRAY =$8078; 278 | GL_EDGE_FLAG_ARRAY =$8079; 279 | GL_VERTEX_ARRAY_SIZE =$807A; 280 | GL_VERTEX_ARRAY_TYPE =$807B; 281 | GL_VERTEX_ARRAY_STRIDE =$807C; 282 | GL_NORMAL_ARRAY_TYPE =$807E; 283 | GL_NORMAL_ARRAY_STRIDE =$807F; 284 | GL_COLOR_ARRAY_SIZE =$8081; 285 | GL_COLOR_ARRAY_TYPE =$8082; 286 | GL_COLOR_ARRAY_STRIDE =$8083; 287 | GL_INDEX_ARRAY_TYPE =$8085; 288 | GL_INDEX_ARRAY_STRIDE =$8086; 289 | GL_TEXTURE_COORD_ARRAY_SIZE =$8088; 290 | GL_TEXTURE_COORD_ARRAY_TYPE =$8089; 291 | GL_TEXTURE_COORD_ARRAY_STRIDE =$808A; 292 | GL_EDGE_FLAG_ARRAY_STRIDE =$808C; 293 | 294 | GL_BGR_EXT =$80E0; 295 | GL_BGRA_EXT =$80E1; 296 | 297 | {$IFDEF Android} 298 | const 299 | OpenGL = '/usr/lib/libGLESv1_CM.so'; 300 | Prefix = ''; 301 | {$DEFINE CDECL} 302 | {$ENDIF} 303 | 304 | {$IFDEF MSWINDOWS} 305 | const 306 | OpenGL = 'OpenGL32.DLL'; 307 | {$DEFINE STDCALL} 308 | {$ENDIF} 309 | 310 | {$IFDEF MACOS} 311 | const 312 | OpenGL = '/System/Library/Frameworks/OpenGL.framework/OpenGL'; 313 | Prefix = '_'; 314 | {$DEFINE CDECL} 315 | {$ENDIF} 316 | 317 | {$IFDEF CDECL} 318 | procedure glClear(mask: GLbitfield); cdecl; external OpenGL name Prefix + 'glClear'; 319 | procedure glClearColor(red, green, blue, alpha: GLclampf); cdecl; external OpenGL name Prefix + 'glClearColor'; 320 | procedure glDrawArrays(mode: GLenum; first: GLint; count: GLsizei); cdecl; external OpenGL name Prefix + 'glDrawArrays'; 321 | procedure glEnable(cap: GLenum); cdecl; external OpenGL name Prefix + 'glEnable'; 322 | procedure glEnableClientState(array_: GLenum); cdecl; external OpenGL name Prefix + 'glEnableClientState'; 323 | procedure glFlush; cdecl; external OpenGL name Prefix + 'glFlush'; 324 | procedure glHint(target, mode: GLenum); cdecl; external OpenGL name Prefix + 'glHint'; 325 | procedure glLightfv(light, pname: GLenum; params: PGLfloat); cdecl; external OpenGL name Prefix + 'glLightfv'; 326 | procedure glLoadIdentity; cdecl; external OpenGL name Prefix + 'glLoadIdentity'; 327 | procedure glMatrixMode (mode: GLenum); cdecl; external OpenGL name Prefix + 'glMatrixMode'; 328 | procedure glMultMatrixf (m: PGLfloat); cdecl; external OpenGL name Prefix + 'glMultMatrixf'; 329 | procedure glNormalPointer(type_: GLenum; stride: GLsizei; pointer: PGLvoid); cdecl; external OpenGL name Prefix + 'glNormalPointer'; 330 | procedure glPopMatrix; cdecl; external OpenGL name Prefix + 'glPopMatrix'; 331 | procedure glPushMatrix; cdecl; external OpenGL name Prefix + 'glPushMatrix'; 332 | procedure glRotatef(angle, x, y, z: GLfloat); cdecl; external OpenGL name Prefix + 'glRotatef'; 333 | procedure glShadeModel(mode: GLenum); cdecl; external OpenGL name Prefix + 'glShadeModel'; 334 | procedure glTranslatef(x, y, z: GLfloat); cdecl; external OpenGL name Prefix + 'glTranslatef'; 335 | procedure glVertexPointer(size: GLint; type_: GLenum; stride: GLsizei; pointer: PGLvoid); cdecl; external OpenGL name Prefix + 'glVertexPointer'; 336 | procedure glViewport (x,y: GLint; width, height: GLsizei); cdecl; external OpenGL name Prefix + 'glViewport'; 337 | {$ENDIF} 338 | 339 | {$IFDEF STDCALL} 340 | procedure glClear(mask: GLbitfield); stdcall; external OpenGL; 341 | procedure glClearColor(red, green, blue, alpha: GLclampf); stdcall; external OpenGL; 342 | procedure glDrawArrays(mode: GLenum; first: GLint; count: GLsizei); stdcall; external OpenGL; 343 | procedure glEnable(cap: GLenum); stdcall; external OpenGL; 344 | procedure glEnableClientState(array_: GLenum); stdcall; external OpenGL; 345 | procedure glFlush; stdcall; external OpenGL; 346 | procedure glHint(target, mode: GLenum); stdcall; external OpenGL; 347 | procedure glLightfv(light, pname: GLenum; params: PGLfloat); stdcall; external OpenGL; 348 | procedure glLoadIdentity; stdcall; external OpenGL; 349 | procedure glNormalPointer(type_: GLenum; stride: GLsizei; pointer: Pointer); stdcall; external OpenGL; 350 | procedure glMatrixMode (mode: GLenum); stdcall; external OpenGL; 351 | procedure glMultMatrixf (m: PGLfloat); stdcall; external OpenGL; 352 | procedure glPopMatrix; stdcall; external OpenGL; 353 | procedure glPushMatrix; stdcall; external OpenGL; 354 | procedure glRotatef(angle, x, y, z: GLfloat); stdcall; external OpenGL; 355 | procedure glShadeModel(mode: GLenum); stdcall; external OpenGL; 356 | procedure glTranslatef(x, y, z: GLfloat); stdcall; external OpenGL; 357 | procedure glVertexPointer(size: GLint; type_: GLenum; stride: GLsizei; pointer: Pointer); stdcall; external OpenGL; 358 | procedure glViewport (x,y: GLint; width, height: GLsizei); stdcall; external OpenGL; 359 | {$ENDIF} 360 | 361 | procedure Log(const Str: string); 362 | function GetTickCount: Cardinal; 363 | 364 | implementation 365 | 366 | {$IFDEF ANDROID} 367 | 368 | procedure Log(const Str: string); 369 | {$IFDEF DEBUG} 370 | var 371 | M: TMarshaller; 372 | begin 373 | // Oh dear ! give us back our AnsiString ! 374 | LOGI(M.AsAnsi(Str).ToPointer); 375 | end; 376 | {$ELSE} 377 | begin 378 | end; 379 | {$ENDIF} 380 | 381 | // GetTickCount from System.pas (not published) 382 | const 383 | CLOCK_MONOTONIC = 1; 384 | 385 | type 386 | timespec = record 387 | tv_sec: Longint; 388 | tv_nsec: Int32; 389 | end; 390 | Ptimespec = ^timespec; 391 | 392 | function clock_gettime(Clk: Integer; Tp: Ptimespec): Integer; cdecl; 393 | external '/system/lib/libc' name 'clock_gettime'; 394 | 395 | function GetTickCount: Cardinal; inline; 396 | var 397 | res: timespec; 398 | begin 399 | clock_gettime(CLOCK_MONOTONIC, @res); 400 | Result := (Int64(1000000000) * res.tv_sec + res.tv_nsec) div 1000000; 401 | end; 402 | {$ENDIF Android} 403 | 404 | {$IFDEF MSWINDOWS} 405 | 406 | function GetTickCount: Cardinal stdcall; external kernel32; 407 | 408 | procedure Log(const Str: string); 409 | begin 410 | {$IFDEF DEBUG} 411 | AllocConsole; 412 | WriteLn(Str); 413 | {$ENDIF DEBUG} 414 | end; 415 | {$ENDIF MSWINDOWS} 416 | 417 | {$IFDEF MACOS} 418 | 419 | procedure Log(const Str: string); 420 | begin 421 | {$IFDEF DEBUG} 422 | WriteLn(Str); 423 | {$ENDIF DEBUG} 424 | end; 425 | 426 | const 427 | LibcLib = '/usr/lib/libc.dylib'; 428 | 429 | type 430 | TTimebaseInfoData = record 431 | Numer: UInt32; 432 | Denom: UInt32; 433 | end; 434 | 435 | function MachAbsoluteTime: UInt64; cdecl; external LibcLib name '_mach_absolute_time'; 436 | function MachTimebaseInfo(var TimebaseInfoData: TTimebaseInfoData): Integer; cdecl; external LibcLib name '_mach_timebase_info'; 437 | 438 | function AbsoluteToNanoseconds(AbsoluteTime: UInt64): UInt64; 439 | var 440 | Info: TTimebaseInfoData; 441 | begin 442 | MachTimebaseInfo(Info); 443 | Result := AbsoluteTime * Info.Numer; 444 | Result := Result div Info.Denom; 445 | end; 446 | 447 | function GetTickCount: Cardinal; //inline; 448 | begin 449 | Result := AbsoluteToNanoseconds(MachAbsoluteTime) div 1000000; 450 | end; 451 | 452 | {$ENDIF MACOS} 453 | 454 | procedure gluPerspective(fovy, aspect, zNear, zFar: double); 455 | var 456 | m: array[0..3,0..3] of Single; 457 | sn, cs: Extended; 458 | cotangent, deltaZ: Double; 459 | radians: Double; 460 | begin 461 | if aspect = 0 then 462 | Exit; 463 | deltaZ := zFar - zNear; 464 | if deltaZ = 0 then 465 | Exit; 466 | radians := fovy * PI / 360; 467 | SinCos(radians, sn, cs); 468 | if sn = 0 then 469 | Exit; 470 | cotangent := cs / sn; 471 | FillChar(m, SizeOf(m), 0); 472 | m[0,0] := cotangent / aspect; 473 | m[1,1] := cotangent; 474 | m[2,2] := -(zFar + zNear) / deltaZ; 475 | m[2,3] := -1; 476 | m[3,2] := -2 * zNear * zFar / deltaZ; 477 | glMultMatrixf(@m); 478 | end; 479 | 480 | end. 481 | 482 | -------------------------------------------------------------------------------- /GLPanel/Execute.CubeMan.pas: -------------------------------------------------------------------------------- 1 | unit Execute.CubeMan; 2 | 3 | { 4 | Pure OpenGL 3D man (c)2017 Execute SARL 5 | } 6 | 7 | interface 8 | 9 | uses 10 | Execute.CrossGL; 11 | 12 | procedure glSetupCubeMan(); 13 | procedure glDrawCubeMan(); 14 | 15 | implementation 16 | 17 | const 18 | Vertices: array[0..7, 0..2] of Single = ( 19 | (-1.0, -1.0, -1.0), // 0 20 | ( 1.0, -1.0, -1.0), // 1 21 | ( 1.0, 1.0, -1.0), // 2 22 | (-1.0, 1.0, -1.0), // 3 23 | (-1.0, -1.0, 1.0), // 4 24 | ( 1.0, -1.0, 1.0), // 5 25 | ( 1.0, 1.0, 1.0), // 6 26 | (-1.0, 1.0, 1.0) // 7 27 | ); 28 | 29 | Indices: array[0..11, 0..2] of Byte = ( 30 | (0, 5, 4), (0, 1, 5), 31 | (1, 6, 5), (1, 2, 6), 32 | (2, 7, 6), (2, 3, 7), 33 | (3, 4, 7), (3, 0, 4), 34 | (4, 6, 7), (4, 5, 6), 35 | (3, 1, 0), (3, 2, 1) 36 | ); 37 | 38 | Diffuse : array[0..3] of Single = (0.5, 0.5, 1.0, 1); 39 | Ambient : array[0..3] of Single = (0.0, 0.0, 0.5, 1); 40 | Position: array[0..3] of Single = (0.0, 0.0, 0.0, 1); 41 | 42 | CUBE_SIZE = 3 * 2 * 6; 43 | CUBE_0 = 0; 44 | CUBE_1 = CUBE_SIZE; 45 | CUBE_2 = 2 * CUBE_SIZE; 46 | 47 | type 48 | TVertex = record 49 | x, y, z: Single; 50 | end; 51 | 52 | TPoint = record 53 | Vertex: TVertex; 54 | Normal: TVertex; 55 | end; 56 | 57 | TFace = array[0..2] of TPoint; // triangles 58 | 59 | TCube = array[0..11] of TFace; // 12 triangles 60 | 61 | var 62 | Cubes: array[0..2] of TCube; 63 | 64 | procedure BuildCube(var Cube: TCube; Width, Height, Depth: Single); 65 | var 66 | Face : Integer; 67 | Vertex: Integer; 68 | Normal: TVertex; 69 | begin 70 | FillChar(Normal, SizeOf(Normal), 0); 71 | for Face := 0 to 11 do 72 | begin 73 | case Face of 74 | 0: 75 | begin 76 | Normal.y := -1; 77 | end; 78 | 2: 79 | begin 80 | Normal.y := 0; 81 | Normal.x := 1; 82 | end; 83 | 4: 84 | begin 85 | Normal.x := 0; 86 | Normal.y := 1; 87 | end; 88 | 6: 89 | begin 90 | Normal.y := 0; 91 | Normal.x := -1; 92 | end; 93 | 8: 94 | begin 95 | Normal.x := 0; 96 | Normal.z := 1; 97 | end; 98 | 10: 99 | begin 100 | Normal.z := -1; 101 | end; 102 | end; 103 | for Vertex := 0 to 2 do 104 | begin 105 | Cube[Face, Vertex].Vertex.x := Vertices[Indices[Face, Vertex], 0] * Width; 106 | Cube[Face, Vertex].Vertex.y := Vertices[Indices[Face, Vertex], 1] * Height; 107 | Cube[Face, Vertex].Vertex.z := Vertices[Indices[Face, Vertex], 2] * Depth; 108 | Cube[Face, Vertex].Normal := Normal; 109 | end; 110 | end; 111 | end; 112 | 113 | procedure Init(); 114 | begin 115 | BuildCube(Cubes[0], 10, 17, 15); 116 | BuildCube(Cubes[1], 10, 10, 10); 117 | BuildCube(Cubes[2], 6, 6, 10); 118 | end; 119 | 120 | procedure glSetupCubeMan(); 121 | begin 122 | glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST); 123 | glEnable(GL_CULL_FACE); 124 | glEnable(GL_DEPTH_TEST); 125 | glShadeModel(GL_SMOOTH); 126 | 127 | glLightfv(GL_LIGHT0, GL_AMBIENT, @Ambient); 128 | glLightfv(GL_LIGHT0, GL_DIFFUSE, @Diffuse); 129 | glLightfv(GL_LIGHT0, GL_POSITION, @Position); 130 | glEnable(GL_LIGHT0); 131 | glEnable(GL_LIGHTING); 132 | 133 | glVertexPointer(3, GL_FLOAT, SizeOf(TPoint), @Cubes[0, 0, 0].Vertex); 134 | glNormalPointer(GL_FLOAT, SizeOf(TPoint), @Cubes[0, 0, 0].Normal); 135 | 136 | glEnableClientState(GL_VERTEX_ARRAY); 137 | glEnableClientState(GL_NORMAL_ARRAY); 138 | end; 139 | 140 | procedure glDrawCubeMan(); 141 | var 142 | Time : Cardinal; 143 | Timer: Cardinal; 144 | begin 145 | Time := GetTickCount; 146 | 147 | glTranslatef(0, 0, -250); 148 | glRotatef(Time/50, 0, 1, 0); 149 | 150 | Timer := Time div 2; 151 | 152 | glPushMatrix; 153 | glDrawArrays(GL_TRIANGLES, CUBE_0, CUBE_SIZE); 154 | glTranslatef(0, +30, 0); 155 | glDrawArrays(GL_TRIANGLES, CUBE_1, CUBE_SIZE); 156 | glPopMatrix; 157 | glPushMatrix; 158 | glTranslatef(0, +15, 25-10); 159 | glRotatef(+45, 1, 0, 0); 160 | glRotatef(Abs((Timer div 3) mod 320 - 160) - 80, 0, 1, 0); 161 | glTranslatef(0, 0, 10); 162 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 163 | glTranslatef(0, 0, 20-10); 164 | glRotatef(Abs((Timer div 3) mod 180 - 90), 0, 1, 0); 165 | glTranslatef(0, 0, 10); 166 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 167 | glPopMatrix; 168 | glPushMatrix; 169 | glTranslatef(0, +15, 10-25); 170 | glRotatef(-45, 1, 0, 0); 171 | glRotatef(Abs((Timer div 3) mod 320 - 160) - 80, 0, 1, 0); 172 | glTranslatef(0, 0, -10); 173 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 174 | glTranslatef(0, 0, 10-20); 175 | glRotatef(-Abs((Timer div 3) mod 180 - 90), 0, 1, 0); 176 | glTranslatef(0, 0, -10); 177 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 178 | glPopMatrix; 179 | glPushMatrix; 180 | glTranslatef(0, 10-25, 10); 181 | glRotatef(-90, 1, 0, 0); 182 | glRotatef(Abs((Timer div 4) mod 240 - 120) - 60, 0, 1, 0); 183 | glTranslatef(0, 0, -10); 184 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 185 | glTranslatef(0, 0, 10-20); 186 | glRotatef((1-Integer((Timer div 2) mod 480) div 240) * (120 - Abs((Timer div 2) mod 240 - 120)), 0, 1, 0); 187 | glTranslatef(0, 0, -10); 188 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 189 | glPopMatrix; 190 | glPushMatrix; 191 | glTranslatef(0, 10-25, -10); 192 | glRotatef(-90, 1, 0, 0); 193 | glRotatef(-Abs((Timer div 4) mod 240 - 120) + 60, 0, 1, 0); 194 | glTranslatef(0, 0, -10); 195 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 196 | glTranslatef(0, 0, 10-20); 197 | glRotatef((Integer((Timer div 2) mod 480) div 240) * (120 - Abs((Timer div 2) mod 240 - 120)), 0, 1, 0); 198 | glTranslatef(0, 0, -10); 199 | glDrawArrays(GL_TRIANGLES, CUBE_2, CUBE_SIZE); 200 | glPopMatrix; 201 | end; 202 | 203 | initialization 204 | Init(); 205 | end. 206 | -------------------------------------------------------------------------------- /GLPanel/Execute.FMX.GLPanels.Types.pas: -------------------------------------------------------------------------------- 1 | unit Execute.FMX.GLPanels.Types; 2 | 3 | interface 4 | uses 5 | System.Classes, 6 | FMX.Controls.Presentation, 7 | FMX.Controls.Model; 8 | 9 | type 10 | TGLPanelModel = class(TDataModel) 11 | const 12 | STYLE_NAME = 'GLPanel-style'; 13 | PM_INVALIDE = PM_USER + 1; 14 | type 15 | TGLEvent = ( 16 | glSetup, 17 | glResize, 18 | glPaint 19 | ); 20 | private 21 | FEvents: array[TGLEvent] of TNotifyEvent; 22 | 23 | function getEvents(index : TGlevent) : TNotifyEvent; 24 | procedure setEvents(index : TGlevent; Value : TNotifyEvent); 25 | public 26 | function OnEvent(Event: TGLEvent): Boolean; 27 | property Events[index : TglEvent]: TNotifyEvent read getevents write setEvents; 28 | end; 29 | implementation 30 | 31 | 32 | function TGLPanelModel.OnEvent(Event: TGLEvent): Boolean; 33 | begin 34 | Result := Assigned(FEvents[Event]); 35 | if Result then 36 | FEvents[Event](Owner); 37 | end; 38 | 39 | function TGLPanelModel.getEvents(index: TGlevent): TNotifyEvent; 40 | begin 41 | Result := FEvents[index]; 42 | end; 43 | 44 | procedure TGLPanelModel.setEvents(index: TGlevent; Value: TNotifyEvent); 45 | begin 46 | FEvents[index] := Value; 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /GLPanel/Execute.FMX.GLPanels.Win.pas: -------------------------------------------------------------------------------- 1 | unit Execute.FMX.GLPanels.Win; 2 | 3 | { 4 | FMX GLPanel for Delphi Tokyo (c)2017 Execute SARL 5 | } 6 | 7 | 8 | interface 9 | 10 | uses 11 | Winapi.Windows, 12 | Winapi.Messages, 13 | Winapi.OpenGL, 14 | Winapi.OpenGLExt, 15 | System.Classes, 16 | FMX.Controls, 17 | FMX.Controls.Model, 18 | FMX.Controls.Win, 19 | FMX.Presentation.Factory, 20 | FMX.Presentation.Win, 21 | Execute.FMX.GLPanels.Types; 22 | 23 | type 24 | TWinGLPanel = class(TWinPresentation) 25 | private 26 | // Windows stuffs 27 | FDC : HDC; 28 | FGL : HGLRC; 29 | FSetup: Boolean; 30 | procedure CreateGLContext; 31 | procedure DestroyGLContext; 32 | procedure ResizeGL; 33 | procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND; 34 | procedure WMPaint(var Msg: TMessage); message WM_PAINT; 35 | // Presentation messages 36 | procedure PMInvalidate(var Msg: TDispatchMessage); message TGLPanelModel.PM_INVALIDE; 37 | private 38 | [unsafe] FModel: TGLPanelModel; 39 | protected 40 | // need this 41 | procedure CreateParams(var Params: TCreateParams); override; 42 | procedure CreateHandle; override; 43 | procedure DestroyHandle; override; 44 | procedure Resized; override; 45 | // link to the model 46 | function DefineModelClass: TDataModelClass; override; 47 | public 48 | constructor Create(AOwner: TComponent); override; 49 | end; 50 | 51 | implementation 52 | 53 | { TWinGLPanel } 54 | 55 | constructor TWinGLPanel.Create(AOwner: TComponent); 56 | begin 57 | inherited; 58 | FModel := TGLPanelModel(inherited Model); 59 | end; 60 | 61 | procedure TWinGLPanel.CreateGLContext; 62 | var 63 | pfd: TPIXELFORMATDESCRIPTOR; 64 | pixelformat: Integer; 65 | Cl: TRGBQuad; 66 | begin 67 | FDC := GetDC(Handle); 68 | if FDC = 0 then 69 | Exit; 70 | // set pixel format 71 | FillChar(pfd, SizeOf(pfd), 0); 72 | pfd.nSize := sizeof(pfd); 73 | pfd.nVersion := 1; 74 | pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER; 75 | pfd.iLayerType := PFD_MAIN_PLANE; 76 | pfd.iPixelType := PFD_TYPE_RGBA; 77 | pfd.cColorBits := 32; 78 | pfd.iLayerType := PFD_MAIN_PLANE; 79 | pfd.cStencilBits:= 0; 80 | pixelformat := ChoosePixelFormat(FDC, @pfd); 81 | if PixelFormat = 0 then 82 | Exit; 83 | if not SetPixelFormat(FDC, pixelformat, @pfd) then 84 | Exit; 85 | // create OpenGL Context 86 | FGL := wglCreateContext(FDC); 87 | // select it 88 | wglMakeCurrent(FDC, FGL); 89 | // setup GL mode 90 | // setup the clear color 91 | // Integer(cl) := ColorToRGB(Color); 92 | // glClearColor(cl.rgbRed/255, cl.rgbGreen/255, cl.rgbBlue/255, 1); 93 | // setup the clear depth 94 | glClearDepth(1); 95 | 96 | InitOpenGLext; 97 | 98 | FSetup := FModel.OnEvent(TGLPanelModel.TGLEvent.glSetup); 99 | 100 | ResizeGL(); 101 | end; 102 | 103 | procedure TWinGLPanel.CreateHandle; 104 | begin 105 | inherited; 106 | if HandleAllocated then 107 | begin 108 | CreateGLContext; 109 | end; 110 | end; 111 | 112 | procedure TWinGLPanel.CreateParams(var Params: TCreateParams); 113 | begin 114 | inherited; 115 | Params.WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH); 116 | end; 117 | 118 | function TWinGLPanel.DefineModelClass: TDataModelClass; 119 | begin 120 | Result := TGLPanelModel; 121 | end; 122 | 123 | procedure TWinGLPanel.DestroyGLContext; 124 | begin 125 | if FGL <> 0 then 126 | begin 127 | wglMakeCurrent(FDC, 0); 128 | wglDeleteContext(FGL); 129 | FGL := 0; 130 | end; 131 | if FDC <> 0 then 132 | begin 133 | DeleteDC(FDC); 134 | FDC := 0; 135 | end; 136 | end; 137 | 138 | procedure TWinGLPanel.DestroyHandle; 139 | begin 140 | if HandleAllocated then 141 | begin 142 | DestroyGLContext; 143 | end; 144 | inherited; 145 | end; 146 | 147 | procedure TWinGLPanel.PMInvalidate(var Msg: TDispatchMessage); 148 | begin 149 | InvalidateRect(Handle, nil, False); 150 | end; 151 | 152 | procedure TWinGLPanel.Resized; 153 | begin 154 | inherited; 155 | if FGL <> 0 then 156 | begin 157 | ResizeGL; 158 | InvalidateRect(Handle, nil, False); 159 | end; 160 | end; 161 | 162 | procedure TWinGLPanel.ResizeGL; 163 | var 164 | LSize: TSize; 165 | begin 166 | LSize := Size; 167 | glMatrixMode(GL_PROJECTION); 168 | glLoadIdentity; 169 | if LSize.cy <> 0 then 170 | gluPerspective(45, LSize.cx / LSize.cy, 1, 1000); 171 | glMatrixMode(GL_MODELVIEW); 172 | glLoadIdentity; 173 | glViewport(0, 0, LSize.cx, LSize.cy); 174 | FModel.OnEvent(TGLPanelModel.TGLEvent.glResize); 175 | end; 176 | 177 | procedure TWinGLPanel.WMEraseBkGnd(var Msg: TMessage); 178 | begin 179 | if FGL <> 0 then 180 | Msg.Result := 1 181 | else 182 | inherited; 183 | end; 184 | 185 | procedure TWinGLPanel.WMPaint(var Msg: TMessage); 186 | begin 187 | if FGL <> 0 then 188 | begin 189 | wglMakeCurrent(FDC, FGL); 190 | if FSetup = False then 191 | begin 192 | FModel.OnEvent(TGLPanelModel.TGLEvent.glSetup); 193 | FSetup := True; 194 | end; 195 | glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); 196 | glLoadIdentity(); 197 | FModel.OnEvent(TGLPanelModel.TGLEvent.glPaint); 198 | glFlush(); 199 | SwapBuffers(FDC); 200 | ValidateRect(Handle, nil); 201 | end else begin 202 | inherited; 203 | end; 204 | end; 205 | 206 | initialization 207 | TPresentationProxyFactory.Current.Register(TGLPanelModel.STYLE_NAME, TWinPresentationProxy); 208 | finalization 209 | TPresentationProxyFactory.Current.Unregister(TGLPanelModel.STYLE_NAME, TWinPresentationProxy); 210 | end. 211 | -------------------------------------------------------------------------------- /GLPanel/Execute.FMX.GLPanels.pas: -------------------------------------------------------------------------------- 1 | unit Execute.FMX.GLPanels; 2 | 3 | { 4 | FMX GLPanel for Delphi Tokyo (c)2017 Execute SARL 5 | } 6 | 7 | interface 8 | 9 | // http://yaroslavbrovin.ru/new-approach-of-development-of-firemonkey-control-control-model-presentation-part-1-en/ 10 | 11 | uses 12 | System.Classes, 13 | FMX.Types, 14 | FMX.Presentation.Messages, 15 | FMX.Controls.Model, 16 | Execute.FMX.GLPanels.Types, 17 | FMX.Controls.Presentation; 18 | 19 | type 20 | // the published GLPanel component 21 | TGLPanel = class(TPresentedControl) 22 | private 23 | // could be a [weak] reference, [unsafe] is fine also, but the value of FModel could be invalide 24 | [unsafe] FModel: TGLPanelModel; 25 | // generic event getter/setter 26 | function GetGLEvent(Index: TGLPanelModel.TGLEvent): TNotifyEvent; 27 | procedure SetGLEvent(Index: TGLPanelModel.TGLEvent; Value: TNotifyEvent); 28 | protected 29 | // explicit link to model class 30 | function DefineModelClass: TDataModelClass; override; 31 | // link to presentation (by name) 32 | function DefinePresentationName: string; override; 33 | 34 | public 35 | constructor Create(AOwner: TComponent); override; 36 | // refresh the OpenGL panel 37 | procedure Invalidate; 38 | published 39 | // change the general OpenGL settings 40 | property OnGLSetup: TNotifyEvent index TGLPanelModel.TGLEvent.glSetup read GetGLEvent write SetGLEvent; 41 | // when the Panel is resized 42 | property OnGLResize: TNotifyEvent index TGLPanelModel.TGLEvent.glResize read GetGLEvent write SetGLEvent; 43 | // when the Panel is rendering 44 | property OnGLPaint: TNotifyEvent index TGLPanelModel.TGLEvent.glPaint read GetGLEvent write SetGLEvent; 45 | end; 46 | 47 | implementation 48 | 49 | {$IFDEF MSWINDOWS} 50 | uses 51 | // Windows presentation for TGLPanel 52 | Execute.FMX.GLPanels.Win; 53 | 54 | {$ENDIF} 55 | 56 | {$IFDEF MACOS} 57 | uses 58 | Execute.Presentation.Mac; 59 | {$ENDIF} 60 | 61 | { TGLPanel } 62 | 63 | constructor TGLPanel.Create(AOwner: TComponent); 64 | begin 65 | inherited; 66 | FModel := GetModel; 67 | SetAcceptsControls(False); 68 | CanFocus := True; 69 | ClipChildren := False; 70 | end; 71 | 72 | function TGLPanel.DefineModelClass: TDataModelClass; 73 | begin 74 | Result := TGLPanelModel; 75 | end; 76 | 77 | function TGLPanel.DefinePresentationName: string; 78 | begin 79 | Result := TGLPanelModel.STYLE_NAME; 80 | end; 81 | 82 | function TGLPanel.GetGLEvent(Index: TGLPanelModel.TGLEvent): TNotifyEvent; 83 | begin 84 | Result := FModel.Events[Index]; 85 | end; 86 | 87 | procedure TGLPanel.SetGLEvent(Index: TGLPanelModel.TGLEvent; Value: TNotifyEvent); 88 | begin 89 | FModel.Events[Index] := Value; 90 | end; 91 | 92 | procedure TGLPanel.Invalidate; 93 | begin 94 | PresentationProxy.SendMessage(TGLPanelModel.PM_INVALIDE); 95 | end; 96 | 97 | 98 | end. 99 | -------------------------------------------------------------------------------- /GLPanel/Execute.Presentation.Mac.pas: -------------------------------------------------------------------------------- 1 | { ******************************************************* } 2 | { } 3 | { Delphi FireMonkey Platform } 4 | { } 5 | { Copyright(c) 2016 Embarcadero Technologies, Inc. } 6 | { All rights reserved } 7 | { } 8 | { ******************************************************* } 9 | 10 | unit Execute.Presentation.Mac; 11 | 12 | interface 13 | 14 | {$SCOPEDENUMS ON} 15 | 16 | uses 17 | System.TypInfo, 18 | System.Types, 19 | System.Classes, 20 | Macapi.ObjectiveC, 21 | Macapi.Foundation, 22 | Macapi.CocoaTypes, 23 | Macapi.AppKit, 24 | Macapi.CoreGraphics, 25 | FMX.Graphics, 26 | FMX.Controls.Presentation, 27 | FMX.Controls, 28 | FMX.Presentation.Messages, 29 | FMX.Forms, 30 | FMX.Types, 31 | Execute.FMX.GLPanels.Types, 32 | FMX.Controls.Model; 33 | 34 | type 35 | 36 | { TMacNativeView } 37 | 38 | TMacNativeView = class; 39 | 40 | IFMXNsView = interface(NsOpenglView) 41 | ['{BA60202C-47E6-4FD2-9999-30EC62C6384C}'] 42 | procedure drawRect(dirtyRect: NSRect); cdecl; 43 | end; 44 | 45 | TMacNativeView = class(TOCLocal) 46 | private 47 | private 48 | [Weak] 49 | FParentView: NSView; 50 | [Weak] 51 | FControl: TControl; 52 | [Weak] 53 | FModel: TGLPanelModel; 54 | [Weak] 55 | FForm: TCommonCustomForm; 56 | FSize: TSizeF; 57 | FVisible: Boolean; 58 | FControlSize: TSizeF; 59 | 60 | FContext: NSOpenGLContext; 61 | FPixelFormat: NSOpenGLPixelFormat; 62 | FContentRect: NSRect; 63 | 64 | procedure RefreshNativeParent; virtual; 65 | procedure SetupOpenGLContext; 66 | procedure UpdateOrderAndBounds; 67 | procedure ResizeGL; 68 | 69 | protected 70 | procedure InitView; virtual; 71 | function GetViewFrame: NSRect; 72 | procedure SetSize(const ASize: TSizeF); virtual; 73 | function GetObjectiveCClass: PTypeInfo; override; 74 | 75 | function GetView: NsOpenglView; overload; 76 | 77 | function GetParentView: NSView; 78 | procedure Resized; virtual; 79 | { Messages from PresentationProxy } 80 | procedure PMGetNativeObject(var AMessage: TDispatchMessageWithValue); message PM_GET_NATIVE_OBJECT; 81 | procedure PMRootChanged(var AMessage: TDispatchMessageWithValue); message PM_ROOT_CHANGED; 82 | procedure PMAncesstorPresentationLoaded(var AMessage: TDispatchMessageWithValue); message PM_ANCESTOR_PRESENTATION_LOADED; 83 | procedure PMRefreshParent(var AMessage: TDispatchMessage); message PM_REFRESH_PARENT; 84 | procedure PMChangeOrder(var AMessage: TDispatchMessage); message PM_CHANGE_ORDER; 85 | procedure PMAbsoluteChanged(var AMessage: TDispatchMessage); message PM_ABSOLUTE_CHANGED; 86 | procedure PMSetSize(var AMessage: TDispatchMessageWithValue); message PM_SET_SIZE; 87 | procedure PMGetSize(var AMessage: TDispatchMessageWithValue); message PM_GET_SIZE; 88 | procedure PMSetVisible(var AMessage: TDispatchMessageWithValue); message PM_SET_VISIBLE; 89 | procedure PMGetVisible(var AMessage: TDispatchMessageWithValue); message PM_GET_VISIBLE; 90 | procedure PMAncesstorVisibleChanged(var AMessage: TDispatchMessageWithValue); message PM_ANCESSTOR_VISIBLE_CHANGED; 91 | procedure PMSetAbsoluteEnabled(var AMessage: TDispatchMessageWithValue); message PM_SET_ABSOLUTE_ENABLED; 92 | procedure PMGetAbsoluteEnabled(var AMessage: TDispatchMessageWithValue); message PM_GET_ABSOLUTE_ENABLED; 93 | procedure PMDoExit(var AMessage: TDispatchMessage); message PM_DO_EXIT; 94 | procedure PMDoEnter(var AMessage: TDispatchMessage); message PM_DO_ENTER; 95 | procedure PMResetFocus(var AMessage: TDispatchMessage); message PM_RESET_FOCUS; 96 | 97 | procedure PMInvalidate(var AMessage: TDispatchMessage); message TGLPanelModel.PM_INVALIDE; 98 | 99 | 100 | 101 | public 102 | procedure drawRect(dirtyRect: NSRect); cdecl; 103 | property Control: TControl read FControl; 104 | 105 | function DefineModelClass: TDataModelClass; virtual; 106 | constructor Create; overload; virtual; 107 | constructor Create(const AModel: TDataModel; const AControl: TControl); overload; virtual; 108 | destructor Destroy; override; 109 | function HasControl: Boolean; 110 | procedure SetFocus; virtual; 111 | property Model: TGLPanelModel read FModel; 112 | property View: NsOpenglView read GetView; 113 | 114 | end; 115 | 116 | TMacNativeViewClass = class of TMacNativeView; 117 | 118 | /// Generics proxy for all Mac native presentations 119 | TMacPresentationProxy = class(TPresentationProxy) 120 | protected 121 | function CreateReceiver: TObject; override; 122 | end; 123 | 124 | implementation 125 | 126 | uses 127 | System.UITypes, 128 | System.SysUtils, 129 | System.Math, 130 | Macapi.Helpers, 131 | Macapi.ObjCRuntime, 132 | Macapi.OpenGL, 133 | FMX.Platform.Mac, 134 | FMX.Surfaces, 135 | FMX.Presentation.Factory, 136 | FMX.Helpers.Mac, 137 | FMX.Consts; 138 | 139 | constructor TMacNativeView.Create; 140 | begin 141 | inherited; 142 | FVisible := True; 143 | end; 144 | 145 | procedure TMacNativeView.InitView; 146 | var 147 | V: Pointer; 148 | 149 | begin 150 | V := NsOpenglView(Super).initWithFrame(GetViewFrame, TNSOpenGLView.OCClass.defaultPixelFormat); 151 | if NSAppKitVersionNumber >= NSAppKitVersionNumber10_7 then 152 | NsOpenglView(Super).setWantsBestResolutionOpenGLSurface(True); 153 | if GetObjectID <> V then 154 | UpdateObjectID(V); 155 | if HasControl then 156 | begin 157 | FParentView := GetParentView; 158 | if FParentView <> nil then 159 | FParentView.addSubview(NSView(Super)); 160 | end; 161 | end; 162 | 163 | constructor TMacNativeView.Create(const AModel: TDataModel; const AControl: TControl); 164 | begin 165 | FControl := AControl; 166 | FModel := AModel as TGLPanelModel; 167 | if FModel is DefineModelClass then 168 | FModel.Receiver := Self 169 | else 170 | raise EPresentationWrongModel.CreateFmt(SWrongModelClassType, [DefineModelClass.ClassName, FModel.ClassName]); 171 | 172 | Create; 173 | InitView; 174 | end; 175 | 176 | function TMacNativeView.DefineModelClass: TDataModelClass; 177 | begin 178 | Result := TDataModel; 179 | end; 180 | 181 | destructor TMacNativeView.Destroy; 182 | begin 183 | View.removeFromSuperview; 184 | inherited; 185 | end; 186 | 187 | function TMacNativeView.GetObjectiveCClass: PTypeInfo; 188 | begin 189 | Result := TypeInfo(IFMXNsView); 190 | end; 191 | 192 | function TMacNativeView.GetView: NsOpenglView; 193 | begin 194 | Result := NsOpenglView(Super); 195 | end; 196 | 197 | procedure TMacNativeView.SetupOpenGLContext; 198 | var 199 | Attributes: TArray; 200 | begin 201 | Attributes := TArray.Create(NSOpenGLPFAOpenGLProfile, NSOpenGLProfileVersionLegacy, NSOpenGLPFADoubleBuffer, NSOpenGLPFADepthSize, 16); 202 | Attributes := Attributes + [0]; 203 | FPixelFormat := TNSOpenGLPixelFormat.Wrap(TNSOpenGLPixelFormat.Alloc.initWithAttributes(@Attributes[0])); 204 | FContext := TNSOpenGLContext.Wrap(TNSOpenGLContext.Alloc.initWithFormat(FPixelFormat, nil)); 205 | View.setOpenGLContext(FContext); 206 | FContext.makeCurrentContext; 207 | ResizeGL(); 208 | end; 209 | 210 | function TMacNativeView.GetViewFrame: NSRect; 211 | begin 212 | if HasControl then 213 | Result := Nsrect.Create(FControl.AbsoluteRect) 214 | else 215 | Result := CGRectMake(0, 0, 50, 50); 216 | end; 217 | 218 | function TMacNativeView.HasControl: Boolean; 219 | begin 220 | Result := FControl <> nil; 221 | end; 222 | 223 | 224 | procedure TMacNativeView.SetFocus; 225 | begin 226 | View.becomeFirstResponder; 227 | end; 228 | 229 | procedure TMacNativeView.SetSize(const ASize: TSizeF); 230 | var 231 | ViewSize: NSSize; 232 | begin 233 | FSize := ASize; 234 | View.setFrameSize(cgsize.Create(FSize)); 235 | UpdateOrderAndBounds; 236 | end; 237 | 238 | 239 | function TMacPresentationProxy.CreateReceiver: TObject; 240 | var 241 | PresentationClass: TMacNativeViewClass; 242 | begin 243 | PresentationClass := T; 244 | Result := PresentationClass.Create(Model, PresentedControl); 245 | end; 246 | 247 | procedure TMacNativeView.PMRootChanged(var AMessage: TDispatchMessageWithValue); 248 | begin 249 | if AMessage.Value is TCommonCustomForm then 250 | FForm := TCommonCustomForm(AMessage.Value) 251 | else 252 | FForm := nil; 253 | RefreshNativeParent; 254 | end; 255 | 256 | procedure TMacNativeView.PMGetNativeObject(var AMessage: TDispatchMessageWithValue); 257 | begin 258 | AMessage.Value := View; 259 | end; 260 | 261 | procedure TMacNativeView.PMGetSize(var AMessage: TDispatchMessageWithValue); 262 | var 263 | Size: NSSize; 264 | begin 265 | AMessage.Value := FControlSize; 266 | end; 267 | 268 | function TMacNativeView.GetParentView: NSView; 269 | var 270 | FormHandle: TMacWindowHandle; 271 | begin 272 | if FForm <> nil then 273 | begin 274 | FormHandle := WindowHandleToPlatform(FForm.Handle); 275 | Result := FormHandle.View; 276 | end 277 | else 278 | Result := nil; 279 | end; 280 | 281 | procedure TMacNativeView.RefreshNativeParent; 282 | begin 283 | FParentView := nil; 284 | if HasControl then 285 | begin 286 | FParentView := GetParentView; 287 | if FParentView = nil then 288 | begin 289 | View.removeFromSuperview 290 | end 291 | else 292 | begin 293 | FParentView.addSubview(View); 294 | SetupOpenGLContext; 295 | end; 296 | end; 297 | end; 298 | 299 | procedure TMacNativeView.drawRect(dirtyRect: NSRect); 300 | begin 301 | glClearColor(0, 0, 0, 1.0); 302 | glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT); 303 | glLoadIdentity(); 304 | FModel.Events[glSetup](Self); 305 | FModel.Events[glPaint](Self); 306 | FContext.flushBuffer; 307 | end; 308 | 309 | procedure TMacNativeView.PMAncesstorPresentationLoaded(var AMessage: TDispatchMessageWithValue); 310 | begin 311 | RefreshNativeParent; 312 | UpdateOrderAndBounds; 313 | end; 314 | 315 | procedure TMacNativeView.PMRefreshParent(var AMessage: TDispatchMessage); 316 | begin 317 | RefreshNativeParent; 318 | end; 319 | 320 | procedure TMacNativeView.PMChangeOrder(var AMessage: TDispatchMessage); 321 | begin 322 | UpdateOrderAndBounds; 323 | end; 324 | 325 | procedure TMacNativeView.PMAbsoluteChanged(var AMessage: TDispatchMessage); 326 | begin 327 | UpdateOrderAndBounds; 328 | end; 329 | 330 | procedure TMacNativeView.PMSetSize(var AMessage: TDispatchMessageWithValue); 331 | begin 332 | FControlSize := AMessage.Value; 333 | UpdateOrderAndBounds; 334 | Resized; 335 | end; 336 | 337 | procedure TMacNativeView.PMSetVisible(var AMessage: TDispatchMessageWithValue); 338 | begin 339 | View.setHidden(not AMessage.Value); 340 | end; 341 | 342 | procedure TMacNativeView.PMGetVisible(var AMessage: TDispatchMessageWithValue); 343 | begin 344 | AMessage.Value := not View.isHiddenOrHasHiddenAncestor; 345 | end; 346 | 347 | procedure TMacNativeView.PMAncesstorVisibleChanged(var AMessage: TDispatchMessageWithValue); 348 | var 349 | LMessage: TDispatchMessageWithValue; 350 | begin 351 | LMessage.Value := Control.Visible and Control.ParentedVisible; 352 | PMSetVisible(LMessage); 353 | if LMessage.Value then 354 | UpdateOrderAndBounds; 355 | end; 356 | 357 | procedure TMacNativeView.PMSetAbsoluteEnabled(var AMessage: TDispatchMessageWithValue); 358 | begin 359 | 360 | end; 361 | 362 | procedure TMacNativeView.PMGetAbsoluteEnabled(var AMessage: TDispatchMessageWithValue); 363 | begin 364 | AMessage.Value := not View.isHiddenOrHasHiddenAncestor; 365 | end; 366 | 367 | procedure TMacNativeView.PMDoExit(var AMessage: TDispatchMessage); 368 | begin 369 | end; 370 | 371 | procedure TMacNativeView.PMDoEnter(var AMessage: TDispatchMessage); 372 | begin 373 | end; 374 | 375 | procedure TMacNativeView.PMResetFocus(var AMessage: TDispatchMessage); 376 | begin 377 | end; 378 | 379 | procedure TMacNativeView.UpdateOrderAndBounds; 380 | var 381 | temp: NSRect; 382 | winrect : NSRect; 383 | begin 384 | temp := GetViewFrame; 385 | if GetParentView <> nil then 386 | begin 387 | winrect := GetParentView.frame; 388 | temp.origin.y := winrect.size.height - (temp.origin.y + temp.size.height); 389 | end; 390 | View.setFrame(temp); 391 | Resized; 392 | end; 393 | 394 | procedure TMacNativeView.Resized; 395 | begin 396 | ResizeGL; 397 | FModel.OnEvent(TGLPanelModel.TGLEvent.glResize); 398 | end; 399 | 400 | procedure TMacNativeView.PMInvalidate(var AMessage: TDispatchMessage); 401 | begin 402 | View.display; 403 | end; 404 | 405 | procedure TMacNativeView.ResizeGL; 406 | 407 | procedure perspective(const fovy, aspect, zNear, zFar: double); 408 | var 409 | xmin, xmax, ymin, ymax: double; 410 | begin 411 | ymax := zNear * tan(fovy * PI / 360.0); 412 | ymin := - ymax; 413 | xmin := ymin * aspect; 414 | xmax := ymax * aspect; 415 | glFrustum(xmin, xmax, ymin, ymax, zNear, zFar); 416 | end; 417 | 418 | var 419 | LSize: TSizeF; 420 | 421 | begin 422 | LSize := GetViewFrame.size.ToSizeF; 423 | glMatrixMode(GL_PROJECTION); 424 | glLoadIdentity; 425 | if LSize.cy <> 0 then 426 | perspective(45, LSize.cx / LSize.cy, 1, 1000); 427 | 428 | glMatrixMode(GL_MODELVIEW); 429 | glLoadIdentity; 430 | end; 431 | 432 | initialization 433 | 434 | InitOpenGL; 435 | TPresentationProxyFactory.Current.Register(TGLPanelModel.STYLE_NAME, TMacPresentationProxy); 436 | 437 | finalization 438 | 439 | TPresentationProxyFactory.Current.Unregister(TGLPanelModel.STYLE_NAME, TMacPresentationProxy); 440 | 441 | end. 442 | -------------------------------------------------------------------------------- /GLPanel/GLPanel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/GLPanel/GLPanel.png -------------------------------------------------------------------------------- /GLPanel/GLPanelDemo.dpr: -------------------------------------------------------------------------------- 1 | program GLPanelDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | Main in 'Main.pas' {Form2}, 7 | Execute.FMX.GLPanels in 'Execute.FMX.GLPanels.pas', 8 | Execute.CubeMan in 'Execute.CubeMan.pas', 9 | Execute.CrossGL in 'Execute.CrossGL.pas', 10 | Execute.FMX.GLPanels.Types in 'Execute.FMX.GLPanels.Types.pas'; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | Application.Initialize; 16 | Application.CreateForm(TMainForm, MainForm); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /GLPanel/GLPanelDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/GLPanel/GLPanelDemo.res -------------------------------------------------------------------------------- /GLPanel/GlPanelMac.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/GLPanel/GlPanelMac.png -------------------------------------------------------------------------------- /GLPanel/Main.fmx: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'OpenGL Panel' 5 | ClientHeight = 510 6 | ClientWidth = 466 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | DesignerMasterStyle = 0 12 | object Panel1: TPanel 13 | Align = Top 14 | Size.Width = 466.000000000000000000 15 | Size.Height = 49.000000000000000000 16 | Size.PlatformDefault = False 17 | TabOrder = 1 18 | object Label1: TLabel 19 | Position.X = 24.000000000000000000 20 | Position.Y = 8.000000000000000000 21 | Size.Width = 305.000000000000000000 22 | Size.Height = 33.000000000000000000 23 | Size.PlatformDefault = False 24 | Text = 'Cross platform TGLPanel for FMX (c)2017 Execute SARL' 25 | end 26 | end 27 | object Timer1: TTimer 28 | Interval = 40 29 | OnTimer = Timer1Timer 30 | Left = 192 31 | Top = 192 32 | end 33 | object Panel2: TPanel 34 | Align = Left 35 | Position.Y = 49.000000000000000000 36 | Size.Width = 65.000000000000000000 37 | Size.Height = 391.000000000000000000 38 | Size.PlatformDefault = False 39 | TabOrder = 4 40 | end 41 | object Panel3: TPanel 42 | Align = Bottom 43 | Position.Y = 440.000000000000000000 44 | Size.Width = 466.000000000000000000 45 | Size.Height = 70.000000000000000000 46 | Size.PlatformDefault = False 47 | TabOrder = 5 48 | end 49 | object Panel4: TPanel 50 | Align = Right 51 | Position.X = 413.000000000000000000 52 | Position.Y = 49.000000000000000000 53 | Size.Width = 53.000000000000000000 54 | Size.Height = 391.000000000000000000 55 | Size.PlatformDefault = False 56 | TabOrder = 6 57 | end 58 | end 59 | -------------------------------------------------------------------------------- /GLPanel/Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/GLPanel/Main.pas -------------------------------------------------------------------------------- /GLPanel/readme.md: -------------------------------------------------------------------------------- 1 | #TGLPanel 2 | 3 | an OpenGL Panel for Firemonkey under Windows and OSX 4 | 5 | ![screenshot](GLPanel.png) ![screenshot](GlPanelMac.png) 6 | 7 | TPresentedControl is well explained in this article 8 | http://yaroslavbrovin.ru/new-approach-of-development-of-firemonkey-control-control-model-presentation-part-1-en/ 9 | 10 | -------------------------------------------------------------------------------- /Isometric/Isometric.dpr: -------------------------------------------------------------------------------- 1 | program Isometric; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | Main in 'Main.pas' {MainForm}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TMainForm, MainForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Isometric/Isometric.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/Isometric/Isometric.png -------------------------------------------------------------------------------- /Isometric/Isometric.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/Isometric/Isometric.res -------------------------------------------------------------------------------- /Isometric/Main.fmx: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Isometric view under Firemonkey for Delphi Tokyo' 5 | Color = xFE000000 6 | ClientHeight = 571 7 | ClientWidth = 933 8 | FormFactor.Width = 320 9 | FormFactor.Height = 480 10 | FormFactor.Devices = [Desktop] 11 | OnRender = Form3DRender 12 | DesignerMasterStyle = 0 13 | end 14 | -------------------------------------------------------------------------------- /Isometric/Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/Isometric/Main.pas -------------------------------------------------------------------------------- /Isometric/readme.md: -------------------------------------------------------------------------------- 1 | # Isometric view under Firemonkey 2 | 3 | Firemonkey do not provide Isometric projection, but if you set the ContextState to cs2DScene, you can override the projection matrix with the "RenderToMatrix" matrix ! 4 | 5 | ![screenshot](Isometric.png) 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /MoreThan8Lights/FMXLights.dpr: -------------------------------------------------------------------------------- 1 | program FMXLights; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | Main in 'Main.pas' {Form1}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /MoreThan8Lights/FMXLights.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/MoreThan8Lights/FMXLights.res -------------------------------------------------------------------------------- /MoreThan8Lights/Main.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 583 6 | ClientWidth = 1177 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object Viewport3D1: TViewport3D 12 | Position.X = 72.000000000000000000 13 | Position.Y = 40.000000000000000000 14 | Size.Width = 1009.000000000000000000 15 | Size.Height = 521.000000000000000000 16 | Size.PlatformDefault = False 17 | object Plane1: TPlane 18 | Position.X = -13.289526939392090000 19 | Position.Y = -2.696880817413330000 20 | Position.Z = 5.000000000000000000 21 | RotationAngle.X = 340.000000000000000000 22 | Width = 8.072472572326660000 23 | Height = 7.663682937622070000 24 | Depth = 0.001000000047497451 25 | SubdivisionsHeight = 10 26 | SubdivisionsWidth = 10 27 | MaterialSource = LightMaterialSource1 28 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 29 | object Light1: TLight 30 | Color = claWhite 31 | LightType = Spot 32 | SpotCutOff = 60.000000000000000000 33 | SpotExponent = 4.000000000000000000 34 | Position.Z = -4.000000000000000000 35 | RotationAngle.Y = 345.047607421875000000 36 | Width = 1.000000000000000000 37 | Height = 1.000000000000000000 38 | Depth = 1.000000000000000000 39 | Quanternion = '(0,0.212956428527832,0,-0.977061569690704)' 40 | end 41 | end 42 | object Plane2: TPlane 43 | Position.X = -4.686008453369141000 44 | Position.Y = -4.134114742279053000 45 | Position.Z = 5.000000000000000000 46 | RotationAngle.X = 340.000000000000000000 47 | Width = 8.072472572326660000 48 | Height = 7.663682937622070000 49 | Depth = 0.001000000047497451 50 | SubdivisionsHeight = 10 51 | SubdivisionsWidth = 10 52 | MaterialSource = LightMaterialSource1 53 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 54 | object Light2: TLight 55 | Color = claWhite 56 | LightType = Spot 57 | SpotCutOff = 60.000000000000000000 58 | SpotExponent = 4.000000000000000000 59 | Position.X = 0.624485969543457000 60 | Position.Y = 1.925696253776550000 61 | Position.Z = -3.299103498458862000 62 | RotationAngle.Y = 1.283422470092773000 63 | Width = 1.000000000000000000 64 | Height = 1.000000000000000000 65 | Depth = 1.000000000000000000 66 | Quanternion = '(0,-0.0111995469778776,0,-0.999936878681183)' 67 | end 68 | end 69 | object Plane3: TPlane 70 | Position.X = 3.908743143081665000 71 | Position.Y = -4.262164115905762000 72 | Position.Z = 5.000000000000000000 73 | RotationAngle.X = 340.000000000000000000 74 | Width = 8.072472572326660000 75 | Height = 7.663682937622070000 76 | Depth = 0.001000000047497451 77 | SubdivisionsHeight = 10 78 | SubdivisionsWidth = 10 79 | MaterialSource = LightMaterialSource1 80 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 81 | object Light3: TLight 82 | Color = claWhite 83 | LightType = Spot 84 | SpotCutOff = 60.000000000000000000 85 | SpotExponent = 4.000000000000000000 86 | Position.X = -1.169054508209229000 87 | Position.Y = 3.225466728210449000 88 | Position.Z = -3.113871097564697000 89 | RotationAngle.X = 19.724609375000000000 90 | Width = 1.000000000000000000 91 | Height = 1.000000000000000000 92 | Depth = 1.000000000000000000 93 | Quanternion = '(0.171279892325401,0,0,0.985222935676575)' 94 | end 95 | end 96 | object Plane4: TPlane 97 | Position.X = 12.693408012390140000 98 | Position.Y = -2.882531166076660000 99 | Position.Z = 5.000000000000000000 100 | RotationAngle.X = 340.000000000000000000 101 | Width = 8.072472572326660000 102 | Height = 7.663682937622070000 103 | Depth = 0.001000000047497451 104 | SubdivisionsHeight = 10 105 | SubdivisionsWidth = 10 106 | MaterialSource = LightMaterialSource1 107 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 108 | object Light4: TLight 109 | Color = claWhite 110 | LightType = Spot 111 | SpotCutOff = 60.000000000000000000 112 | SpotExponent = 4.000000000000000000 113 | Position.X = 0.072504639625549320 114 | Position.Y = -0.017682626843452450 115 | Position.Z = -4.294281959533691000 116 | Width = 1.000000000000000000 117 | Height = 1.000000000000000000 118 | Depth = 1.000000000000000000 119 | end 120 | end 121 | object Plane5: TPlane 122 | Position.X = -15.005095481872560000 123 | Position.Y = 6.844037532806396000 124 | Position.Z = 5.000000000000000000 125 | RotationAngle.X = 340.000000000000000000 126 | Width = 8.072472572326660000 127 | Height = 7.663682937622070000 128 | Depth = 0.001000000047497451 129 | SubdivisionsHeight = 10 130 | SubdivisionsWidth = 10 131 | MaterialSource = LightMaterialSource1 132 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 133 | object Light5: TLight 134 | Color = claWhite 135 | LightType = Spot 136 | SpotCutOff = 60.000000000000000000 137 | SpotExponent = 4.000000000000000000 138 | Position.X = 0.072504639625549320 139 | Position.Y = -0.017682626843452450 140 | Position.Z = -4.294281959533691000 141 | Width = 1.000000000000000000 142 | Height = 1.000000000000000000 143 | Depth = 1.000000000000000000 144 | end 145 | end 146 | object Plane6: TPlane 147 | Position.X = -7.242356777191162000 148 | Position.Y = 11.192867279052730000 149 | Position.Z = 5.000000000000000000 150 | RotationAngle.X = 340.000000000000000000 151 | Width = 8.072472572326660000 152 | Height = 7.663682937622070000 153 | Depth = 0.001000000047497451 154 | SubdivisionsHeight = 10 155 | SubdivisionsWidth = 10 156 | MaterialSource = LightMaterialSource1 157 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 158 | object Light6: TLight 159 | Color = claWhite 160 | LightType = Spot 161 | SpotCutOff = 60.000000000000000000 162 | SpotExponent = 4.000000000000000000 163 | Position.X = 2.210926532745361000 164 | Position.Y = -2.583330154418945000 165 | Position.Z = -5.228101730346680000 166 | Width = 1.000000000000000000 167 | Height = 1.000000000000000000 168 | Depth = 1.000000000000000000 169 | end 170 | end 171 | object Plane7: TPlane 172 | Position.X = 6.339773654937744000 173 | Position.Y = 10.366033554077150000 174 | Position.Z = 5.000000000000000000 175 | RotationAngle.X = 340.000000000000000000 176 | Width = 8.072472572326660000 177 | Height = 7.663682937622070000 178 | Depth = 0.001000000047497451 179 | SubdivisionsHeight = 10 180 | SubdivisionsWidth = 10 181 | MaterialSource = LightMaterialSource1 182 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 183 | object Light7: TLight 184 | Color = claWhite 185 | LightType = Spot 186 | SpotCutOff = 60.000000000000000000 187 | SpotExponent = 4.000000000000000000 188 | Position.X = -2.012195110321045000 189 | Position.Y = -1.893937706947327000 190 | Position.Z = -4.977183341979980000 191 | Width = 1.000000000000000000 192 | Height = 1.000000000000000000 193 | Depth = 1.000000000000000000 194 | end 195 | end 196 | object Plane8: TPlane 197 | Position.X = 14.763480186462400000 198 | Position.Y = 7.284362792968750000 199 | Position.Z = 4.999998092651367000 200 | RotationAngle.X = 340.000000000000000000 201 | Width = 8.072472572326660000 202 | Height = 7.663682937622070000 203 | Depth = 0.001000000047497451 204 | SubdivisionsHeight = 10 205 | SubdivisionsWidth = 10 206 | MaterialSource = LightMaterialSource1 207 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 208 | object Light8: TLight 209 | Color = claWhite 210 | LightType = Spot 211 | SpotCutOff = 60.000000000000000000 212 | SpotExponent = 4.000000000000000000 213 | Position.X = 0.072504639625549320 214 | Position.Y = -0.017682626843452450 215 | Position.Z = -4.294281959533691000 216 | Width = 1.000000000000000000 217 | Height = 1.000000000000000000 218 | Depth = 1.000000000000000000 219 | end 220 | end 221 | object Dummy1: TDummy 222 | Width = 1.000000000000000000 223 | Height = 1.000000000000000000 224 | Depth = 1.000000000000000000 225 | OnRender = Dummy1Render 226 | object Plane9: TPlane 227 | Position.X = -0.341574072837829600 228 | Position.Y = 3.916938304901123000 229 | Position.Z = 5.000000000000000000 230 | RotationAngle.X = 340.000000000000000000 231 | Width = 8.072472572326660000 232 | Height = 7.663682937622070000 233 | Depth = 0.001000000047497451 234 | SubdivisionsHeight = 10 235 | SubdivisionsWidth = 10 236 | MaterialSource = LightMaterialSource1 237 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 238 | object Light9: TLight 239 | Color = claWhite 240 | LightType = Spot 241 | SpotCutOff = 60.000000000000000000 242 | SpotExponent = 4.000000000000000000 243 | Position.Z = -4.000000000000000000 244 | Width = 1.000000000000000000 245 | Height = 1.000000000000000000 246 | Depth = 1.000000000000000000 247 | end 248 | end 249 | end 250 | end 251 | object LightMaterialSource1: TLightMaterialSource 252 | Diffuse = claWhite 253 | Ambient = xFF202020 254 | Emissive = claNull 255 | Specular = xFF606060 256 | Shininess = 30 257 | Left = 136 258 | Top = 24 259 | end 260 | end 261 | -------------------------------------------------------------------------------- /MoreThan8Lights/Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/MoreThan8Lights/Main.pas -------------------------------------------------------------------------------- /MoreThan8Lights/readme.md: -------------------------------------------------------------------------------- 1 | ## FMX Lights 2 | 3 | There's an hard coded limit of 8 simultaneous lights on a FMX Scene 4 | 5 | this demo shows a dirty hack to overflow this limitation. 6 | 7 | 9 planes with 9 lights in the IDE 8 | 9 | ![screen1.png](screen1.png) 10 | 11 | without the hack 12 | 13 | ![screen2.png](screen2.png) 14 | 15 | with the hack 16 | 17 | ![screen3.png](screen3.png) 18 | 19 | French explanations on Youtube 20 | 21 | [![Youtube](https://img.youtube.com/vi/fL5CmQdDTfg/0.jpg)](https://youtu.be/fL5CmQdDTfg) 22 | -------------------------------------------------------------------------------- /MoreThan8Lights/screen1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/MoreThan8Lights/screen1.png -------------------------------------------------------------------------------- /MoreThan8Lights/screen2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/MoreThan8Lights/screen2.png -------------------------------------------------------------------------------- /MoreThan8Lights/screen3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/MoreThan8Lights/screen3.png -------------------------------------------------------------------------------- /PuzzleSolver/readme.md: -------------------------------------------------------------------------------- 1 | ## PuzzleSolver 2 | 3 | 3D Puzzle Solver with Delphi 11 under Firemonkey 4 | 5 | Special video for Delphi's 27th Birthday ! 6 | 7 | [![Youtube](https://img.youtube.com/vi/9ttIgAJt7Bg/0.jpg)](https://www.youtube.com/watch?v=9ttIgAJt7Bg) -------------------------------------------------------------------------------- /PuzzleSolver/src/PuzzleSolver.Main.fmx: -------------------------------------------------------------------------------- 1 | object Main: TMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Puzzle Solver' 5 | ClientHeight = 583 6 | ClientWidth = 1035 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | DesignerMasterStyle = 0 12 | object Viewport3D1: TViewport3D 13 | Anchors = [akLeft, akTop, akRight, akBottom] 14 | Position.X = 16.000000000000000000 15 | Position.Y = 112.000000000000000000 16 | Size.Width = 889.000000000000000000 17 | Size.Height = 463.000000000000000000 18 | Size.PlatformDefault = False 19 | OnMouseDown = Viewport3D1MouseDown 20 | OnMouseMove = Viewport3D1MouseMove 21 | object Dummy1: TDummy 22 | Scale.X = 2.000000000000000000 23 | Scale.Y = 2.000000000000000000 24 | Scale.Z = 2.000000000000000000 25 | Width = 1.000000000000000000 26 | Height = 1.000000000000000000 27 | Depth = 1.000000000000000000 28 | object FloatAnimation1: TFloatAnimation 29 | Enabled = True 30 | Duration = 10.000000000000000000 31 | Loop = True 32 | PropertyName = 'RotationAngle.X' 33 | StartValue = 0.000000000000000000 34 | StopValue = 359.000000000000000000 35 | end 36 | object Dummy2: TDummy 37 | RotationAngle.Y = 20.000000000000000000 38 | Width = 1.000000000000000000 39 | Height = 1.000000000000000000 40 | Depth = 1.000000000000000000 41 | Quanternion = '(0,0.173648178577423,0,0.984807729721069)' 42 | object FloatAnimation2: TFloatAnimation 43 | Enabled = True 44 | Duration = 10.000000000000000000 45 | Loop = True 46 | PropertyName = 'RotationAngle.Y' 47 | StartValue = 0.000000000000000000 48 | StopValue = 359.000000000000000000 49 | end 50 | object Grid3D1: TGrid3D 51 | Marks = 1.000000000000000000 52 | Frequency = 1.000000000000000000 53 | LineColor = claSlategray 54 | Position.Z = -2.000000000000000000 55 | Width = 4.099999904632568000 56 | Height = 4.099999904632568000 57 | Depth = 0.001000000047497451 58 | HitTest = False 59 | VisibleContextMenu = False 60 | end 61 | object Grid3D2: TGrid3D 62 | Marks = 1.000000000000000000 63 | Frequency = 1.000000000000000000 64 | LineColor = claSlategray 65 | Position.Y = 2.000000000000000000 66 | RotationAngle.X = 90.000000000000000000 67 | Width = 4.099999904632568000 68 | Height = 4.099999904632568000 69 | Depth = 0.001000000047497451 70 | HitTest = False 71 | VisibleContextMenu = False 72 | Quanternion = '(0.70710676908493,0,0,0.70710676908493)' 73 | end 74 | object Grid3D3: TGrid3D 75 | Marks = 1.000000000000000000 76 | Frequency = 1.000000000000000000 77 | LineColor = claSlategray 78 | Position.Y = -2.000000000000000000 79 | RotationAngle.X = 90.000000000000000000 80 | Width = 4.099999904632568000 81 | Height = 4.099999904632568000 82 | Depth = 0.001000000047497451 83 | HitTest = False 84 | VisibleContextMenu = False 85 | Quanternion = '(0.70710676908493,0,0,0.70710676908493)' 86 | end 87 | object Grid3D4: TGrid3D 88 | Marks = 1.000000000000000000 89 | Frequency = 1.000000000000000000 90 | LineColor = claSlategray 91 | Position.Z = 2.000000000000000000 92 | Width = 4.099999904632568000 93 | Height = 4.099999904632568000 94 | Depth = 0.001000000047497451 95 | HitTest = False 96 | VisibleContextMenu = False 97 | end 98 | object Grid3D5: TGrid3D 99 | Marks = 1.000000000000000000 100 | Frequency = 1.000000000000000000 101 | LineColor = claSlategray 102 | Position.X = 2.000000000000000000 103 | RotationAngle.Y = 90.000000000000000000 104 | Width = 4.099999904632568000 105 | Height = 4.099999904632568000 106 | Depth = 0.001000000047497451 107 | HitTest = False 108 | VisibleContextMenu = False 109 | Quanternion = '(0,0.70710676908493,0,0.70710676908493)' 110 | end 111 | object Grid3D6: TGrid3D 112 | Marks = 1.000000000000000000 113 | Frequency = 1.000000000000000000 114 | LineColor = claSlategray 115 | Position.X = -2.000000000000000000 116 | RotationAngle.Y = 90.000000000000000000 117 | Width = 4.099999904632568000 118 | Height = 4.099999904632568000 119 | Depth = 0.001000000047497451 120 | HitTest = False 121 | VisibleContextMenu = False 122 | Quanternion = '(0,0.70710676908493,0,0.70710676908493)' 123 | end 124 | end 125 | end 126 | object Light1: TLight 127 | Color = claWhite 128 | LightType = Directional 129 | SpotCutOff = 180.000000000000000000 130 | Position.X = -7.494535923004150000 131 | Position.Y = -5.105115890502930000 132 | RotationAngle.X = 313.606384277343800000 133 | RotationAngle.Y = 18.971349716186520000 134 | RotationAngle.Z = 4.719841003417969000 135 | Width = 1.000000000000000000 136 | Height = 1.000000000000000000 137 | Depth = 1.000000000000000000 138 | Quanternion = 139 | '(-0.38193815946579,0.169022768735886,0.0139321302995086,0.908493' + 140 | '459224701)' 141 | end 142 | end 143 | object Pie1: TPie 144 | Position.X = 16.000000000000000000 145 | Position.Y = 16.000000000000000000 146 | Size.Width = 50.000000000000000000 147 | Size.Height = 50.000000000000000000 148 | Size.PlatformDefault = False 149 | StartAngle = -90.000000000000000000 150 | EndAngle = 359.000000000000000000 151 | end 152 | object Pie2: TPie 153 | Position.X = 74.000000000000000000 154 | Position.Y = 16.000000000000000000 155 | Size.Width = 50.000000000000000000 156 | Size.Height = 50.000000000000000000 157 | Size.PlatformDefault = False 158 | StartAngle = -90.000000000000000000 159 | EndAngle = 359.000000000000000000 160 | end 161 | object Pie3: TPie 162 | Position.X = 132.000000000000000000 163 | Position.Y = 16.000000000000000000 164 | Size.Width = 50.000000000000000000 165 | Size.Height = 50.000000000000000000 166 | Size.PlatformDefault = False 167 | StartAngle = -90.000000000000000000 168 | EndAngle = 359.000000000000000000 169 | end 170 | object Pie4: TPie 171 | Position.X = 190.000000000000000000 172 | Position.Y = 16.000000000000000000 173 | Size.Width = 50.000000000000000000 174 | Size.Height = 50.000000000000000000 175 | Size.PlatformDefault = False 176 | StartAngle = -90.000000000000000000 177 | EndAngle = 359.000000000000000000 178 | end 179 | object Pie5: TPie 180 | Position.X = 248.000000000000000000 181 | Position.Y = 16.000000000000000000 182 | Size.Width = 50.000000000000000000 183 | Size.Height = 50.000000000000000000 184 | Size.PlatformDefault = False 185 | StartAngle = -90.000000000000000000 186 | EndAngle = 359.000000000000000000 187 | end 188 | object Pie6: TPie 189 | Position.X = 306.000000000000000000 190 | Position.Y = 16.000000000000000000 191 | Size.Width = 50.000000000000000000 192 | Size.Height = 50.000000000000000000 193 | Size.PlatformDefault = False 194 | StartAngle = -90.000000000000000000 195 | EndAngle = 359.000000000000000000 196 | end 197 | object Pie7: TPie 198 | Position.X = 364.000000000000000000 199 | Position.Y = 16.000000000000000000 200 | Size.Width = 50.000000000000000000 201 | Size.Height = 50.000000000000000000 202 | Size.PlatformDefault = False 203 | StartAngle = -90.000000000000000000 204 | EndAngle = 359.000000000000000000 205 | end 206 | object Pie8: TPie 207 | Position.X = 422.000000000000000000 208 | Position.Y = 16.000000000000000000 209 | Size.Width = 50.000000000000000000 210 | Size.Height = 50.000000000000000000 211 | Size.PlatformDefault = False 212 | StartAngle = -90.000000000000000000 213 | EndAngle = 359.000000000000000000 214 | end 215 | object Pie9: TPie 216 | Position.X = 480.000000000000000000 217 | Position.Y = 16.000000000000000000 218 | Size.Width = 50.000000000000000000 219 | Size.Height = 50.000000000000000000 220 | Size.PlatformDefault = False 221 | StartAngle = -90.000000000000000000 222 | EndAngle = 359.000000000000000000 223 | end 224 | object Pie10: TPie 225 | Position.X = 538.000000000000000000 226 | Position.Y = 16.000000000000000000 227 | Size.Width = 50.000000000000000000 228 | Size.Height = 50.000000000000000000 229 | Size.PlatformDefault = False 230 | StartAngle = -90.000000000000000000 231 | EndAngle = 359.000000000000000000 232 | end 233 | object TrackBar1: TTrackBar 234 | CanParentFocus = True 235 | Max = 50000000.000000000000000000 236 | Orientation = Horizontal 237 | Position.X = 16.000000000000000000 238 | Position.Y = 80.000000000000000000 239 | Size.Width = 572.000000000000000000 240 | Size.Height = 19.000000000000000000 241 | Size.PlatformDefault = False 242 | TabOrder = 17 243 | end 244 | object Button2: TButton 245 | Position.X = 929.000000000000000000 246 | Position.Y = 112.000000000000000000 247 | Size.Width = 80.000000000000000000 248 | Size.Height = 41.000000000000000000 249 | Size.PlatformDefault = False 250 | TabOrder = 18 251 | Text = 'Stop' 252 | OnClick = Button2Click 253 | end 254 | object CheckBox2: TCheckBox 255 | Tag = 1 256 | IsChecked = True 257 | Position.X = 929.000000000000000000 258 | Position.Y = 203.000000000000000000 259 | Size.Width = 88.000000000000000000 260 | Size.Height = 19.000000000000000000 261 | Size.PlatformDefault = False 262 | TabOrder = 12 263 | Text = '2' 264 | OnChange = CheckBox1Change 265 | end 266 | object CheckBox3: TCheckBox 267 | Tag = 2 268 | IsChecked = True 269 | Position.X = 929.000000000000000000 270 | Position.Y = 230.000000000000000000 271 | Size.Width = 88.000000000000000000 272 | Size.Height = 19.000000000000000000 273 | Size.PlatformDefault = False 274 | TabOrder = 9 275 | Text = '3' 276 | OnChange = CheckBox1Change 277 | end 278 | object CheckBox1: TCheckBox 279 | IsChecked = True 280 | Position.X = 929.000000000000000000 281 | Position.Y = 176.000000000000000000 282 | Size.Width = 88.000000000000000000 283 | Size.Height = 19.000000000000000000 284 | Size.PlatformDefault = False 285 | TabOrder = 20 286 | Text = '1' 287 | OnChange = CheckBox1Change 288 | end 289 | object CheckBox4: TCheckBox 290 | Tag = 3 291 | IsChecked = True 292 | Position.X = 929.000000000000000000 293 | Position.Y = 257.000000000000000000 294 | Size.Width = 88.000000000000000000 295 | Size.Height = 19.000000000000000000 296 | Size.PlatformDefault = False 297 | TabOrder = 19 298 | Text = '4' 299 | OnChange = CheckBox1Change 300 | end 301 | object CheckBox5: TCheckBox 302 | Tag = 4 303 | IsChecked = True 304 | Position.X = 929.000000000000000000 305 | Position.Y = 284.000000000000000000 306 | Size.Width = 88.000000000000000000 307 | Size.Height = 19.000000000000000000 308 | Size.PlatformDefault = False 309 | TabOrder = 11 310 | Text = '5' 311 | OnChange = CheckBox1Change 312 | end 313 | object CheckBox6: TCheckBox 314 | Tag = 5 315 | IsChecked = True 316 | Position.X = 929.000000000000000000 317 | Position.Y = 311.000000000000000000 318 | Size.Width = 88.000000000000000000 319 | Size.Height = 19.000000000000000000 320 | Size.PlatformDefault = False 321 | TabOrder = 8 322 | Text = '6' 323 | OnChange = CheckBox1Change 324 | end 325 | object CheckBox7: TCheckBox 326 | Tag = 6 327 | IsChecked = True 328 | Position.X = 929.000000000000000000 329 | Position.Y = 338.000000000000000000 330 | Size.Width = 88.000000000000000000 331 | Size.Height = 19.000000000000000000 332 | Size.PlatformDefault = False 333 | TabOrder = 6 334 | Text = '7' 335 | OnChange = CheckBox1Change 336 | end 337 | object CheckBox8: TCheckBox 338 | Tag = 7 339 | IsChecked = True 340 | Position.X = 929.000000000000000000 341 | Position.Y = 365.000000000000000000 342 | Size.Width = 88.000000000000000000 343 | Size.Height = 19.000000000000000000 344 | Size.PlatformDefault = False 345 | TabOrder = 10 346 | Text = '8' 347 | OnChange = CheckBox1Change 348 | end 349 | object CheckBox9: TCheckBox 350 | Tag = 8 351 | IsChecked = True 352 | Position.X = 929.000000000000000000 353 | Position.Y = 392.000000000000000000 354 | Size.Width = 88.000000000000000000 355 | Size.Height = 19.000000000000000000 356 | Size.PlatformDefault = False 357 | TabOrder = 7 358 | Text = '9' 359 | OnChange = CheckBox1Change 360 | end 361 | object CheckBox10: TCheckBox 362 | Tag = 9 363 | IsChecked = True 364 | Position.X = 929.000000000000000000 365 | Position.Y = 419.000000000000000000 366 | Size.Width = 88.000000000000000000 367 | Size.Height = 19.000000000000000000 368 | Size.PlatformDefault = False 369 | TabOrder = 5 370 | Text = '10' 371 | OnChange = CheckBox1Change 372 | end 373 | end 374 | -------------------------------------------------------------------------------- /PuzzleSolver/src/PuzzleSolver.Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/PuzzleSolver/src/PuzzleSolver.Main.pas -------------------------------------------------------------------------------- /PuzzleSolver/src/PuzzleSolver.dpr: -------------------------------------------------------------------------------- 1 | program PuzzleSolver; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | PuzzleSolver.Main in 'PuzzleSolver.Main.pas' {Main}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TMain, Main); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /PuzzleSolver/src/PuzzleSolver.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/PuzzleSolver/src/PuzzleSolver.res -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Firemonkey 2 | Firemonkey source code by Execute SARL 3 | -------------------------------------------------------------------------------- /SourceShaders/Execute.ShaderMaterial.pas: -------------------------------------------------------------------------------- 1 | unit Execute.ShaderMaterial; 2 | 3 | { 4 | Sample Shader compiler (c)2019 Execute SARL 5 | 6 | } 7 | 8 | interface 9 | 10 | uses 11 | System.SysUtils, 12 | System.Classes, 13 | System.Math.Vectors, 14 | FMX.Types3D, 15 | FMX.Materials, 16 | FMX.MaterialSources; 17 | 18 | const 19 | DEFAULT_VERTEX_SHADER = 20 | {$IFDEF MSWINDOWS} 21 | 'matrix MVPMatrix;'+ 22 | // input parameters 23 | 'struct Input {'+ 24 | ' float4 p: POSITION;'+ 25 | ' float2 t: TEXCOORD0;'+ 26 | '};'+ 27 | // output parameters 28 | 'struct Output {'+ 29 | ' float4 p: POSITION;'+ 30 | ' float2 t: TEXCOORD0;'+ 31 | '};'+ 32 | // main program 33 | 'Output main(Input input) {'+ 34 | ' Output output;'+ 35 | ' output.p = mul(MVPMatrix, input.p);'+ 36 | ' output.t = input.t;'+ 37 | ' return output;'+ 38 | '}'; 39 | {$ELSE} 40 | 'uniform mat4 _MVPMatrix;'+ 41 | // Input 42 | 'attribute vec2 a_TexCoord0;'+ 43 | 'attribute vec4 a_Position;'+ 44 | // Interpolation 45 | 'varying vec2 t;'+ 46 | // main program 47 | 'void main() {'+ 48 | ' t = a_TexCoord0;'+ 49 | ' gl_Position = _MVPMatrix * a_Position;'+ 50 | '}'; 51 | {$ENDIF} 52 | 53 | type 54 | TApplyShaderEvent = procedure(Sender: TObject; Context: TContext3D) of object; 55 | 56 | TShaderMaterial = class(TCustomMaterial) 57 | private 58 | FVertexShaderSource: string; 59 | FPixelShaderSource : string; 60 | FVertexShaderBytes : TBytes; 61 | FPixelShaderBytes : TBytes; 62 | FPixelShaderVars : TContextShaderVariables; 63 | MVPMatrix : TContextShaderVariable; 64 | FOnApply : TApplyShaderEvent; 65 | procedure SetVertexShader(const Value: string); 66 | procedure SetPixelShader(const Value: string); 67 | protected 68 | procedure DoInitialize; override; 69 | procedure DoApply(const Context: TContext3D); override; 70 | class function DoGetMaterialProperty(const Prop: TMaterial.TProperty): string; override; 71 | public 72 | constructor Create(const AVertexShader, APixelShader: string; const APixelShaderVars: TContextShaderVariables); reintroduce; 73 | property OnApply: TApplyShaderEvent read FOnApply write FOnApply; 74 | property VertexShader: string read FVertexShaderSource write SetVertexShader; 75 | property PixelShader: string read FPixelShaderSource write SetPixelShader; 76 | end; 77 | 78 | TShaderMaterialSource = class(TMaterialSource) 79 | private 80 | function GetVertexShader: string; 81 | procedure SetVertexShader(const Value: string); 82 | function GetPixelShader: string; 83 | procedure SetPixelShader(const Value: string); 84 | protected 85 | function CreateMaterial: TMaterial; override; 86 | public 87 | property VertexShader: string read GetVertexShader write SetVertexShader; 88 | property PixelShader: string read GetPixelShader write SetPixelShader; 89 | end; 90 | 91 | implementation 92 | 93 | {$IFDEF MSWINDOWS} 94 | uses 95 | Winapi.D3DCommon, 96 | Winapi.D3DCompiler; 97 | 98 | function DXCompile(const Source: string; Kind: TContextShaderKind; Arch: TContextShaderArch = TContextShaderArch.DX11): TBytes; 99 | var 100 | Data : TBytes; 101 | Target : AnsiString; 102 | Flags : Cardinal; 103 | Code : ID3DBlob; 104 | Err : ID3DBlob; 105 | Str : string; 106 | begin 107 | Data := TEncoding.ANSI.GetBytes(Source); 108 | case Arch of 109 | TContextShaderArch.DX11_level_9: Target := '2_0'; // D3D_FEATURE_LEVEL_9_1 110 | TContextShaderArch.DX10 : Target := '4_0'; // D3D_FEATURE_LEVEL_10_0 111 | TContextShaderArch.DX11 : Target := '5_0'; // D3D_FEATURE_LEVEL_11_0 112 | else 113 | raise Exception.Create('Unsupported architecture'); 114 | end; 115 | case Kind of 116 | TContextShaderKind.VertexShader: Target := 'vs_' + Target; 117 | TContextShaderKind.PixelShader : Target := 'ps_' + Target; 118 | end; 119 | 120 | Flags := D3DCOMPILE_OPTIMIZATION_LEVEL3 121 | // or D3DCOMPILE_ENABLE_STRICTNESS 122 | or D3DCOMPILE_ENABLE_BACKWARDS_COMPATIBILITY 123 | or D3DCOMPILE_WARNINGS_ARE_ERRORS; 124 | 125 | if D3DCompile(Data, Length(Data), nil, nil, nil, 'main', PAnsiChar(Target), Flags, 0, Code, Err) = 0 then 126 | begin 127 | SetLength(Result, Code.GetBufferSize); 128 | Move(Code.GetBufferPointer^, Result[0], Length(Result)); 129 | end else begin 130 | SetString(Str, PAnsiChar(Err.GetBufferPointer), Err.GetBufferSize); 131 | raise Exception.Create('Shader compilation error :'#13 + Str); 132 | end; 133 | end; 134 | {$ENDIF} 135 | 136 | {$IFDEF OSX} 137 | uses 138 | Macapi.CocoaTypes, 139 | Macapi.OpenGL; 140 | {$ENDIF} 141 | {$IFDEF ANDROID} 142 | uses 143 | Androidapi.Gles2; 144 | {$ENDIF} 145 | 146 | { TShaderMaterial } 147 | 148 | const 149 | ARCH = {$IFDEF MSWINDOWS}TContextShaderArch.DX11{$ELSE}TContextShaderArch.GLSL{$ENDIF}; 150 | 151 | constructor TShaderMaterial.Create(const AVertexShader, APixelShader: string; const APixelShaderVars: TContextShaderVariables); 152 | begin 153 | VertexShader := AVertexShader; 154 | PixelShader := APixelShader; 155 | FPixelShaderVars := APixelShaderVars; 156 | inherited Create; 157 | end; 158 | 159 | procedure TShaderMaterial.DoInitialize; 160 | begin 161 | // Why is the MaterialShader initialized from the constructor !!!! 162 | if (FVertexShaderBytes = nil) or (FPixelShaderBytes = nil) then 163 | Exit; 164 | 165 | inherited; 166 | 167 | MVPMatrix := TContextShaderVariable.Create('MVPMatrix', TContextShaderVariableKind.Matrix, 0, 64); 168 | FVertexShader := TShaderManager.RegisterShaderFromData( 169 | '', 170 | TContextShaderKind.VertexShader, 171 | '', 172 | [TContextShaderSource.Create(ARCH, FVertexShaderBytes,[MVPMatrix])] 173 | ); 174 | FPixelShader := TShaderManager.RegisterShaderFromData( 175 | '', TContextShaderKind.PixelShader, '', 176 | [TContextShaderSource.Create(ARCH, FPixelShaderBytes, FPixelShaderVars)] 177 | ); 178 | end; 179 | 180 | procedure TShaderMaterial.SetPixelShader(const Value: string); 181 | begin 182 | if Value <> FPixelShaderSource then 183 | begin 184 | FPixelShaderSource := Value; 185 | if FPixelShaderSource = '' then 186 | FPixelShaderBytes := nil 187 | else begin 188 | {$IFDEF MSWINDOWS} 189 | FPixelShaderBytes := DXCompile(FPixelShaderSource, TContextShaderKind.PixelShader); 190 | {$ELSE} 191 | FPixelShaderBytes := TEncoding.ANSI.GetBytes(FPixelShaderSource); 192 | {$ENDIF} 193 | DoInitialize; 194 | end; 195 | end; 196 | end; 197 | 198 | procedure TShaderMaterial.SetVertexShader(const Value: string); 199 | begin 200 | if Value <> FVertexShaderSource then 201 | begin 202 | FVertexShaderSource := Value; 203 | if FVertexShaderSource = '' then 204 | FVertexShaderBytes := nil 205 | else begin 206 | {$IFDEF MSWINDOWS} 207 | FVertexShaderBytes := DXCompile(FVertexShaderSource, TContextShaderKind.VertexShader); 208 | {$ELSE} 209 | FVertexShaderBytes := TEncoding.ANSI.GetBytes(FVertexShaderSource); 210 | {$ENDIF} 211 | DoInitialize; 212 | end; 213 | end; 214 | end; 215 | 216 | procedure TShaderMaterial.DoApply(const Context: TContext3D); 217 | {$IFNDEF MSWINDOWS} 218 | var 219 | M: TMatrix3D; 220 | {$ENDIF} 221 | begin 222 | inherited; 223 | {$IFNDEF MSWINDOWS} 224 | // https://quality.embarcadero.com/browse/RSP-16323 225 | M := Context.CurrentModelViewProjectionMatrix; 226 | glUniformMatrix4fv(MVPMatrix.Index, 1, GL_FALSE, @M.m11); 227 | {$ENDIF} 228 | if Assigned(FOnApply) then 229 | FOnApply(Self, Context); 230 | end; 231 | 232 | class function TShaderMaterial.DoGetMaterialProperty( 233 | const Prop: TMaterial.TProperty): string; 234 | begin 235 | {$IFDEF MSWINDOWS} 236 | // https://quality.embarcadero.com/browse/RSP-16323 237 | if Prop = TProperty.ModelViewProjection then 238 | begin 239 | Exit('MVPMatrix'); 240 | end; 241 | {$ENDIF} 242 | Result := ''; 243 | end; 244 | 245 | { TShaderMaterialSource } 246 | 247 | function TShaderMaterialSource.CreateMaterial: TMaterial; 248 | begin 249 | Result := TShaderMaterial.Create('', '', []); 250 | end; 251 | 252 | function TShaderMaterialSource.GetPixelShader: string; 253 | begin 254 | Result := TShaderMaterial(Material).PixelShader; 255 | end; 256 | 257 | function TShaderMaterialSource.GetVertexShader: string; 258 | begin 259 | Result := TShaderMaterial(Material).VertexShader; 260 | end; 261 | 262 | procedure TShaderMaterialSource.SetPixelShader(const Value: string); 263 | begin 264 | TShaderMaterial(Material).PixelShader := Value; 265 | end; 266 | 267 | procedure TShaderMaterialSource.SetVertexShader(const Value: string); 268 | begin 269 | TShaderMaterial(Material).VertexShader := Value; 270 | end; 271 | 272 | end. 273 | -------------------------------------------------------------------------------- /SourceShaders/Form1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/SourceShaders/Form1.png -------------------------------------------------------------------------------- /SourceShaders/Main.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'TShaderMaterial demo (c)2019 Execute SARL' 5 | ClientHeight = 566 6 | ClientWidth = 876 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = Form3DCreate 11 | DesignerMasterStyle = 0 12 | object Timer1: TTimer 13 | Interval = 33 14 | OnTimer = Timer1Timer 15 | end 16 | object Plane2: TPlane 17 | Position.X = -6.673500537872314000 18 | Position.Y = -3.909884214401245000 19 | RotationAngle.X = 340.000000000000000000 20 | Width = 9.418337821960449000 21 | Height = 6.704707622528076000 22 | Depth = 0.001000000047497451 23 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 24 | end 25 | object Plane3: TPlane 26 | Position.X = -8.095270156860352000 27 | Position.Y = 3.663649082183838000 28 | RotationAngle.X = 340.000000000000000000 29 | Width = 4.736832618713379000 30 | Height = 4.300696372985840000 31 | Depth = 0.001000000047497451 32 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 33 | end 34 | object Plane4: TPlane 35 | Position.X = 5.363698959350586000 36 | Position.Y = 5.243049144744873000 37 | RotationAngle.X = 340.000000000000000000 38 | Width = 9.418337821960449000 39 | Height = 6.704707622528076000 40 | Depth = 0.001000000047497451 41 | Quanternion = '(0.173648297786713,0,0,-0.984807729721069)' 42 | end 43 | object Plane1: TPlane 44 | Position.X = 4.807112693786621000 45 | Position.Y = -2.776535034179688000 46 | Width = 10.629789352416990000 47 | Height = 7.298233985900879000 48 | Depth = 0.001000000047497451 49 | object FloatAnimation1: TFloatAnimation 50 | Enabled = True 51 | Duration = 5.000000000000000000 52 | Loop = True 53 | PropertyName = 'RotationAngle.X' 54 | StartValue = 0.000000000000000000 55 | StopValue = 360.000000000000000000 56 | end 57 | object FloatAnimation2: TFloatAnimation 58 | Enabled = True 59 | Duration = 10.000000000000000000 60 | Loop = True 61 | PropertyName = 'RotationAngle.Y' 62 | StartValue = 0.000000000000000000 63 | StopValue = 360.000000000000000000 64 | end 65 | object FloatAnimation3: TFloatAnimation 66 | Enabled = True 67 | Duration = 20.000000000000000000 68 | Loop = True 69 | PropertyName = 'RotationAngle.Z' 70 | StartValue = 0.000000000000000000 71 | StopValue = 360.000000000000000000 72 | end 73 | end 74 | end 75 | -------------------------------------------------------------------------------- /SourceShaders/Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/SourceShaders/Main.pas -------------------------------------------------------------------------------- /SourceShaders/ShaderSource.dpr: -------------------------------------------------------------------------------- 1 | program ShaderSource; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | Main in 'Main.pas' {Form1}, 7 | Execute.ShaderMaterial in 'Execute.ShaderMaterial.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TForm1, Form1); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /SourceShaders/readme.md: -------------------------------------------------------------------------------- 1 | # SourceShader 2 | 3 | Sample FMX component to use a Shader as a MaterialSource 4 | 5 | tested with Dephi Rio 10.3.3 under Windows, OSX and Android ! 6 | 7 | you can use directly either a HLSL (DirectX under Windows) or GLSL (OpenGL on other platforms) source code. 8 | ``` 9 | const 10 | PIXEL_SHADER = 11 | {$IFDEF MSWINDOWS} 12 | ' float4 main() : COLOR {' 13 | + ' return float4(1.0, 0.5, 0.5, 1.0);' 14 | + '}'; 15 | {$ELSE} 16 | 'void main() {'+ 17 | ' gl_FragColor = vec4(1.0, 0.5, 0.5, 1.0);'+ 18 | '}'; 19 | {$ENDIF} 20 | ``` 21 | ![Form1](Form1.png) -------------------------------------------------------------------------------- /TextPath/Execute.FMX.TextPath.fmx: -------------------------------------------------------------------------------- 1 | object TextPathEditor: TTextPathEditor 2 | Left = 0 3 | Top = 0 4 | ClientHeight = 372 5 | ClientWidth = 627 6 | FormFactor.Width = 320 7 | FormFactor.Height = 480 8 | FormFactor.Devices = [Desktop, iPhone, iPad] 9 | OnCreate = FormCreate 10 | DesignerMasterStyle = 0 11 | object Layout1: TLayout 12 | Align = Top 13 | Size.Width = 627.000000000000000000 14 | Size.Height = 41.000000000000000000 15 | Size.PlatformDefault = False 16 | TabOrder = 1 17 | object edText: TEdit 18 | Touch.InteractiveGestures = [LongTap, DoubleTap] 19 | Anchors = [akLeft, akTop, akRight] 20 | TabOrder = 2 21 | Text = 'Sample Text' 22 | Position.X = 208.000000000000000000 23 | Position.Y = 8.000000000000000000 24 | Size.Width = 406.000000000000000000 25 | Size.Height = 22.000000000000000000 26 | Size.PlatformDefault = False 27 | OnChange = edTextChange 28 | object Label2: TLabel 29 | Position.X = -47.000000000000000000 30 | Size.Width = 40.000000000000000000 31 | Size.Height = 22.000000000000000000 32 | Size.PlatformDefault = False 33 | Text = 'Text' 34 | TabOrder = 0 35 | end 36 | end 37 | object Label1: TLabel 38 | Position.X = 8.000000000000000000 39 | Position.Y = 8.000000000000000000 40 | Size.Width = 41.000000000000000000 41 | Size.Height = 22.000000000000000000 42 | Size.PlatformDefault = False 43 | Text = 'Font' 44 | TabOrder = 0 45 | end 46 | object edSize: TEdit 47 | Touch.InteractiveGestures = [LongTap, DoubleTap] 48 | TabOrder = 1 49 | Text = '1024' 50 | Position.X = 96.000000000000000000 51 | Position.Y = 8.000000000000000000 52 | Size.Width = 57.000000000000000000 53 | Size.Height = 22.000000000000000000 54 | Size.PlatformDefault = False 55 | OnChange = edTextChange 56 | object Label3: TLabel 57 | Position.X = -32.000000000000000000 58 | Size.Width = 25.000000000000000000 59 | Size.Height = 22.000000000000000000 60 | Size.PlatformDefault = False 61 | Text = 'Size' 62 | TabOrder = 0 63 | end 64 | end 65 | end 66 | object Path: TPath 67 | Align = Client 68 | Margins.Left = 5.000000000000000000 69 | Margins.Top = 5.000000000000000000 70 | Margins.Right = 5.000000000000000000 71 | Margins.Bottom = 5.000000000000000000 72 | Size.Width = 464.000000000000000000 73 | Size.Height = 277.000000000000000000 74 | Size.PlatformDefault = False 75 | end 76 | object lbFonts: TListBox 77 | Align = Left 78 | Position.Y = 41.000000000000000000 79 | Size.Width = 153.000000000000000000 80 | Size.Height = 287.000000000000000000 81 | Size.PlatformDefault = False 82 | TabOrder = 3 83 | DisableFocusEffect = True 84 | DefaultItemStyles.ItemStyle = '' 85 | DefaultItemStyles.GroupHeaderStyle = '' 86 | DefaultItemStyles.GroupFooterStyle = '' 87 | OnChange = edTextChange 88 | Viewport.Width = 149.000000000000000000 89 | Viewport.Height = 283.000000000000000000 90 | end 91 | object Layout2: TLayout 92 | Align = Bottom 93 | Position.Y = 328.000000000000000000 94 | Size.Width = 627.000000000000000000 95 | Size.Height = 44.000000000000000000 96 | Size.PlatformDefault = False 97 | TabOrder = 4 98 | object Button1: TButton 99 | Align = Right 100 | ModalResult = 1 101 | Margins.Left = 5.000000000000000000 102 | Margins.Top = 5.000000000000000000 103 | Margins.Right = 5.000000000000000000 104 | Margins.Bottom = 5.000000000000000000 105 | Position.X = 419.000000000000000000 106 | Position.Y = 5.000000000000000000 107 | Size.Width = 105.000000000000000000 108 | Size.Height = 34.000000000000000000 109 | Size.PlatformDefault = False 110 | TabOrder = 0 111 | Text = 'OK' 112 | end 113 | object Button2: TButton 114 | Align = Right 115 | ModalResult = 2 116 | Margins.Left = 5.000000000000000000 117 | Margins.Top = 5.000000000000000000 118 | Margins.Right = 5.000000000000000000 119 | Margins.Bottom = 5.000000000000000000 120 | Position.X = 534.000000000000000000 121 | Position.Y = 5.000000000000000000 122 | Size.Width = 88.000000000000000000 123 | Size.Height = 34.000000000000000000 124 | Size.PlatformDefault = False 125 | TabOrder = 1 126 | Text = 'Cancel' 127 | end 128 | object cbBold: TCheckBox 129 | Position.X = 16.000000000000000000 130 | Position.Y = 16.000000000000000000 131 | Size.Width = 73.000000000000000000 132 | Size.Height = 19.000000000000000000 133 | Size.PlatformDefault = False 134 | TabOrder = 3 135 | Text = 'Bold' 136 | OnChange = edTextChange 137 | end 138 | object cbItalic: TCheckBox 139 | Position.X = 88.000000000000000000 140 | Position.Y = 16.000000000000000000 141 | Size.Width = 73.000000000000000000 142 | Size.Height = 19.000000000000000000 143 | Size.PlatformDefault = False 144 | TabOrder = 2 145 | Text = 'Italic' 146 | OnChange = edTextChange 147 | end 148 | end 149 | end 150 | -------------------------------------------------------------------------------- /TextPath/Execute.FMX.TextPath.pas: -------------------------------------------------------------------------------- 1 | unit Execute.FMX.TextPath; 2 | { 3 | Create a vectorial text in a FMX TPath (c)2017 Execute SARL 4 | http://www.execute.fr 5 | 6 | } 7 | interface 8 | 9 | uses 10 | System.Classes, 11 | System.SysUtils, 12 | System.UITypes, 13 | DesignEditors, 14 | DesignIntf, 15 | FMX.Forms, FMX.Layouts, FMX.Types, FMX.Controls, 16 | FMX.Edit, FMX.Controls.Presentation, FMX.StdCtrls, FMX.ListBox, FMX.Objects; 17 | 18 | type 19 | TPathEditor = class(TComponentEditor) 20 | function GetVerb(Index: Integer): string; override; 21 | function GetVerbCount: Integer; override; 22 | procedure ExecuteVerb(Index: Integer); override; 23 | end; 24 | 25 | TTextPathEditor = class(TForm) 26 | Layout1: TLayout; 27 | Label2: TLabel; 28 | edText: TEdit; 29 | Path: TPath; 30 | Label1: TLabel; 31 | lbFonts: TListBox; 32 | Layout2: TLayout; 33 | Button1: TButton; 34 | Button2: TButton; 35 | edSize: TEdit; 36 | Label3: TLabel; 37 | cbBold: TCheckBox; 38 | cbItalic: TCheckBox; 39 | procedure FormCreate(Sender: TObject); 40 | procedure edTextChange(Sender: TObject); 41 | public 42 | class procedure Edit(APath: TPath); 43 | end; 44 | 45 | procedure Register; 46 | 47 | implementation 48 | 49 | {$R *.fmx} 50 | 51 | uses 52 | Execute.FontBuilder; 53 | 54 | procedure Register; 55 | begin 56 | RegisterComponentEditor(TPath, TPathEditor); 57 | end; 58 | 59 | { TPathEditor } 60 | 61 | procedure TPathEditor.ExecuteVerb(Index: Integer); 62 | var 63 | Path: TPath; 64 | begin 65 | Path := GetComponent as TPath; 66 | TTextPathEditor.Edit(Path); 67 | end; 68 | 69 | function TPathEditor.GetVerb(Index: Integer): string; 70 | begin 71 | Result := 'TextPath ...'; 72 | end; 73 | 74 | function TPathEditor.GetVerbCount: Integer; 75 | begin 76 | Result := 1; 77 | end; 78 | 79 | { TTextPathEditor } 80 | 81 | class procedure TTextPathEditor.Edit(APath: TPath); 82 | var 83 | Editor: TTextPathEditor; 84 | begin 85 | Editor := TTextPathEditor.Create(nil); 86 | try 87 | if Editor.ShowModal() = mrOK then 88 | begin 89 | APath.Data.Assign(Editor.Path.Data); 90 | end; 91 | finally 92 | Editor.Free; 93 | end; 94 | end; 95 | 96 | procedure TTextPathEditor.edTextChange(Sender: TObject); 97 | var 98 | Size : Integer; 99 | Style: TFontStyles; 100 | begin 101 | if lbFonts.ItemIndex >= 0 then 102 | begin 103 | Size := StrToInt(edSize.Text); 104 | Style := []; 105 | if cbBold.IsChecked then 106 | Style := [TFontStyle.fsBold]; 107 | if cbItalic.IsChecked then 108 | Style := Style + [TFontStyle.fsItalic]; 109 | BuildText(edText.Text, lbFonts.Items[lbFonts.ItemIndex], Size, Style, Path.Data); 110 | end; 111 | end; 112 | 113 | procedure TTextPathEditor.FormCreate(Sender: TObject); 114 | begin 115 | GetFontList(lbFonts.Items); 116 | lbFonts.ItemIndex := 0; 117 | end; 118 | 119 | end. 120 | -------------------------------------------------------------------------------- /TextPath/Execute.FMX.TextPathDesigner.dpk: -------------------------------------------------------------------------------- 1 | package Execute.FMX.TextPathDesigner; 2 | 3 | { 4 | (c)2017 Execute SARL 5 | } 6 | 7 | {$R *.res} 8 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 9 | {$ALIGN 8} 10 | {$ASSERTIONS ON} 11 | {$BOOLEVAL OFF} 12 | {$DEBUGINFO OFF} 13 | {$EXTENDEDSYNTAX ON} 14 | {$IMPORTEDDATA ON} 15 | {$IOCHECKS ON} 16 | {$LOCALSYMBOLS ON} 17 | {$LONGSTRINGS ON} 18 | {$OPENSTRINGS ON} 19 | {$OPTIMIZATION OFF} 20 | {$OVERFLOWCHECKS OFF} 21 | {$RANGECHECKS OFF} 22 | {$REFERENCEINFO ON} 23 | {$SAFEDIVIDE OFF} 24 | {$STACKFRAMES ON} 25 | {$TYPEDADDRESS OFF} 26 | {$VARSTRINGCHECKS ON} 27 | {$WRITEABLECONST OFF} 28 | {$MINENUMSIZE 1} 29 | {$IMAGEBASE $400000} 30 | {$DEFINE DEBUG} 31 | {$ENDIF IMPLICITBUILDING} 32 | {$IMPLICITBUILD ON} 33 | 34 | requires 35 | rtl, 36 | DesignIDE, 37 | fmx; 38 | 39 | contains 40 | Execute.FMX.TextPath in 'Execute.FMX.TextPath.pas' {TextPathEditor}, 41 | Execute.FontBuilder in 'Execute.FontBuilder.pas'; 42 | 43 | end. 44 | -------------------------------------------------------------------------------- /TextPath/Execute.FMX.TextPathDesigner.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {44D81C8D-F975-4463-9001-8F0998AD9BED} 4 | Execute.FMX.TextPathDesigner.dpk 5 | 18.2 6 | FMX 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Package 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | true 38 | Base 39 | true 40 | 41 | 42 | true 43 | Base 44 | true 45 | 46 | 47 | true 48 | Base 49 | true 50 | 51 | 52 | true 53 | Base 54 | true 55 | 56 | 57 | true 58 | Base 59 | true 60 | 61 | 62 | true 63 | Cfg_1 64 | true 65 | true 66 | 67 | 68 | true 69 | Base 70 | true 71 | 72 | 73 | .\$(Platform)\$(Config) 74 | .\$(Platform)\$(Config) 75 | false 76 | false 77 | false 78 | false 79 | false 80 | true 81 | true 82 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 83 | All 84 | Execute_FMX_TextPathDesigner 85 | 86 | 87 | None 88 | android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar 89 | rtl;fmx;$(DCC_UsePackage) 90 | 91 | 92 | None 93 | rtl;fmx;$(DCC_UsePackage) 94 | 95 | 96 | None 97 | rtl;fmx;$(DCC_UsePackage) 98 | 99 | 100 | None 101 | rtl;fmx;$(DCC_UsePackage) 102 | 103 | 104 | rtl;$(DCC_UsePackage) 105 | 106 | 107 | rtl;fmx;$(DCC_UsePackage) 108 | 109 | 110 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 111 | Debug 112 | true 113 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 114 | 1033 115 | rtl;fmx;Execute.FMX;$(DCC_UsePackage) 116 | 117 | 118 | rtl;fmx;$(DCC_UsePackage) 119 | 120 | 121 | DEBUG;$(DCC_Define) 122 | true 123 | false 124 | true 125 | true 126 | true 127 | 128 | 129 | false 130 | 131 | 132 | false 133 | RELEASE;$(DCC_Define) 134 | 0 135 | 0 136 | 137 | 138 | 139 | MainSource 140 | 141 | 142 | 143 | 144 | 145 | 146 |
TextPathEditor
147 | 148 | 149 | 150 | Cfg_2 151 | Base 152 | 153 | 154 | Base 155 | 156 | 157 | Cfg_1 158 | Base 159 | 160 | 161 | 162 | Delphi.Personality.12 163 | Package 164 | 165 | 166 | 167 | Execute.FMX.TextPathDesigner.dpk 168 | 169 | 170 | 171 | 172 | 173 | true 174 | 175 | 176 | 177 | 178 | true 179 | 180 | 181 | 182 | 183 | true 184 | 185 | 186 | 187 | 188 | true 189 | 190 | 191 | 192 | 193 | Execute_FMX_TextPathDesigner.bpl 194 | true 195 | 196 | 197 | 198 | 199 | 1 200 | 201 | 202 | Contents\MacOS 203 | 0 204 | 205 | 206 | 207 | 208 | classes 209 | 1 210 | 211 | 212 | 213 | 214 | library\lib\armeabi-v7a 215 | 1 216 | 217 | 218 | 219 | 220 | library\lib\armeabi 221 | 1 222 | 223 | 224 | 225 | 226 | library\lib\mips 227 | 1 228 | 229 | 230 | 231 | 232 | library\lib\armeabi-v7a 233 | 1 234 | 235 | 236 | 237 | 238 | res\drawable 239 | 1 240 | 241 | 242 | 243 | 244 | res\values 245 | 1 246 | 247 | 248 | 249 | 250 | res\drawable 251 | 1 252 | 253 | 254 | 255 | 256 | res\drawable-xxhdpi 257 | 1 258 | 259 | 260 | 261 | 262 | res\drawable-ldpi 263 | 1 264 | 265 | 266 | 267 | 268 | res\drawable-mdpi 269 | 1 270 | 271 | 272 | 273 | 274 | res\drawable-hdpi 275 | 1 276 | 277 | 278 | 279 | 280 | res\drawable-xhdpi 281 | 1 282 | 283 | 284 | 285 | 286 | res\drawable-small 287 | 1 288 | 289 | 290 | 291 | 292 | res\drawable-normal 293 | 1 294 | 295 | 296 | 297 | 298 | res\drawable-large 299 | 1 300 | 301 | 302 | 303 | 304 | res\drawable-xlarge 305 | 1 306 | 307 | 308 | 309 | 310 | 1 311 | 312 | 313 | 1 314 | 315 | 316 | 0 317 | 318 | 319 | 320 | 321 | 1 322 | .framework 323 | 324 | 325 | 0 326 | 327 | 328 | 329 | 330 | 1 331 | .dylib 332 | 333 | 334 | 0 335 | .dll;.bpl 336 | 337 | 338 | 339 | 340 | 1 341 | .dylib 342 | 343 | 344 | 1 345 | .dylib 346 | 347 | 348 | 1 349 | .dylib 350 | 351 | 352 | 1 353 | .dylib 354 | 355 | 356 | 0 357 | .bpl 358 | 359 | 360 | 361 | 362 | 0 363 | 364 | 365 | 0 366 | 367 | 368 | 0 369 | 370 | 371 | 0 372 | 373 | 374 | 0 375 | 376 | 377 | 0 378 | 379 | 380 | 381 | 382 | 1 383 | 384 | 385 | 1 386 | 387 | 388 | 1 389 | 390 | 391 | 392 | 393 | 1 394 | 395 | 396 | 1 397 | 398 | 399 | 1 400 | 401 | 402 | 403 | 404 | 1 405 | 406 | 407 | 1 408 | 409 | 410 | 1 411 | 412 | 413 | 414 | 415 | 1 416 | 417 | 418 | 1 419 | 420 | 421 | 1 422 | 423 | 424 | 425 | 426 | 1 427 | 428 | 429 | 1 430 | 431 | 432 | 1 433 | 434 | 435 | 436 | 437 | 1 438 | 439 | 440 | 1 441 | 442 | 443 | 1 444 | 445 | 446 | 447 | 448 | 1 449 | 450 | 451 | 1 452 | 453 | 454 | 1 455 | 456 | 457 | 458 | 459 | 1 460 | 461 | 462 | 463 | 464 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 465 | 1 466 | 467 | 468 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 469 | 1 470 | 471 | 472 | 473 | 474 | 475 | 476 | 477 | 1 478 | 479 | 480 | 1 481 | 482 | 483 | 1 484 | 485 | 486 | 487 | 488 | 489 | 490 | Contents\Resources 491 | 1 492 | 493 | 494 | 495 | 496 | library\lib\armeabi-v7a 497 | 1 498 | 499 | 500 | 1 501 | 502 | 503 | 1 504 | 505 | 506 | 1 507 | 508 | 509 | 1 510 | 511 | 512 | 1 513 | 514 | 515 | 0 516 | 517 | 518 | 519 | 520 | 1 521 | 522 | 523 | 1 524 | 525 | 526 | 527 | 528 | Assets 529 | 1 530 | 531 | 532 | Assets 533 | 1 534 | 535 | 536 | 537 | 538 | Assets 539 | 1 540 | 541 | 542 | Assets 543 | 1 544 | 545 | 546 | 547 | 548 | 549 | 550 | 551 | 552 | 553 | 554 | 555 | 556 | False 557 | False 558 | False 559 | False 560 | False 561 | False 562 | True 563 | False 564 | 565 | 566 | 12 567 | 568 | 569 | 570 | 571 | 572 | -------------------------------------------------------------------------------- /TextPath/Execute.FontBuilder.pas: -------------------------------------------------------------------------------- 1 | unit Execute.FontBuilder; 2 | 3 | { 4 | Create a vectorial text in a FMX TPath (c)2017 Execute SARL 5 | http://www.execute.fr 6 | 7 | 8 | NB: this font builder works only under Windows, but the generated Path can be used on any plateform 9 | } 10 | 11 | interface 12 | 13 | uses 14 | System.Classes, 15 | System.UITypes, 16 | Fmx.Graphics; 17 | 18 | procedure GetFontList(List: TStrings); 19 | procedure BuildText(const Text, FontName: string; Size: Integer; Style: TFontStyles; Path: TPathData); 20 | 21 | implementation 22 | 23 | uses 24 | System.SysUtils, 25 | System.Types, 26 | Winapi.Windows; 27 | 28 | function FixToX(const AFix: TFixed): Double; 29 | begin 30 | Result := (AFix.fract/65536.0 + AFix.value); 31 | end; 32 | 33 | function FixToY(const AFix: TFixed): Double; 34 | begin 35 | Result := - (AFix.fract/65536.0 + AFix.value); 36 | end; 37 | 38 | procedure BuildGlyph(DC: HDC; var x, y: Single; Ch: Char; Path: TPathData; const TextMetric: TTextMetric); 39 | var 40 | Matrix : TMAT2; 41 | Size : Cardinal; 42 | Metrics: TGLYPHMETRICS; 43 | Buffer : TBytes; 44 | Index : Integer; 45 | Header : PTTPolygonHeader; 46 | p : TPointF; 47 | Len : Integer; 48 | Curve : PTTPolyCurve; 49 | Point : PPointfx; 50 | Count : Integer; 51 | c : TPointF; 52 | begin 53 | if Ch = ' ' then 54 | begin 55 | GetCharWidth(DC, 32 , 32, Len); 56 | x := x + Len; 57 | Exit; 58 | end; 59 | 60 | FillChar(Matrix, SizeOf(Matrix), 0); 61 | Matrix.eM11.Value := 1; 62 | Matrix.eM22.Value := 1; 63 | 64 | Size := GetGlyphOutline(DC, Ord(Ch), GGO_NATIVE, Metrics, 0, nil, Matrix); 65 | if (Size = 0) or (Size = GDI_ERROR) then 66 | Exit; 67 | 68 | SetLength(Buffer, Size); 69 | Size := GetGlyphOutline(DC, Ord(Ch), GGO_NATIVE, Metrics, Size, Buffer, Matrix); 70 | if (Size = 0) or (Size = GDI_ERROR) then 71 | Exit; 72 | 73 | Index := 0; 74 | while Index < Size do 75 | begin 76 | Header := @Buffer[Index]; 77 | if Header.dwType <> TT_POLYGON_TYPE then 78 | Exit; 79 | p.x := x + FixToX(Header.pfxStart.x); 80 | p.y := y + FixToY(Header.pfxStart.y); 81 | if Index > 0 then 82 | Path.ClosePath; 83 | Path.MoveTo(p); 84 | Len := Index + Header.cb; 85 | Inc(Index, SizeOf(TTPOLYGONHEADER)); 86 | while Index < Len do 87 | begin 88 | Curve := @Buffer[Index]; 89 | Point := @Curve.apfx; 90 | case Curve.wType of 91 | TT_PRIM_LINE: 92 | for Count := 1 to Curve.cpfx do 93 | begin 94 | p.X := x + FixToX(Point.x); 95 | p.Y := y + FixToY(Point.y); 96 | Inc(Point); 97 | Path.LineTo(P); 98 | end; 99 | TT_PRIM_QSPLINE: 100 | for Count := 1 to Curve.cpfx - 1 do 101 | begin 102 | p.X := x + FixToX(Point.x); 103 | p.Y := y + FixToY(Point.y); 104 | Inc(Point); 105 | c.X := x + FixToX(Point.x); 106 | c.Y := y + FixToY(Point.y); 107 | if Count < Curve.cpfx - 1 then 108 | begin 109 | c.x := (p.X + c.X) / 2; 110 | c.y := (p.Y + c.Y) / 2; 111 | end; 112 | Path.QuadCurveTo(p, c); 113 | end; 114 | else 115 | Exit; 116 | end; 117 | Inc(Index, SizeOf(TTPOLYCURVE) + Pred(Curve.cpfx) * SizeOf(TPOINTFX)); 118 | end; 119 | end; 120 | 121 | x := x + Metrics.gmCellIncX; 122 | y := y + Metrics.gmCellIncY; 123 | 124 | Path.ClosePath; 125 | end; 126 | 127 | procedure BuildText(const Text, FontName: string; Size: Integer; Style: TFontStyles; Path: TPathData); 128 | var 129 | LogFont : TLogFont; 130 | Font : HFont; 131 | DC : HDC; 132 | OldFont : HFont; 133 | TextMetric: TTextMetric; 134 | Index : Integer; 135 | x, y : Single; 136 | begin 137 | Path.Clear; 138 | FillChar(LogFont, SizeOf(LogFont), 0); 139 | LogFont.lfHeight := -Size; 140 | LogFont.lfCharSet := DEFAULT_CHARSET; 141 | if TFontStyle.fsBold in Style then 142 | LogFont.lfWeight := FW_BOLD 143 | else 144 | LogFont.lfWeight := FW_NORMAL; 145 | LogFont.lfItalic := Byte(TFontStyle.fsItalic in Style); 146 | StrPLCopy(LogFont.lfFaceName, UTF8ToString(FontName), Length(LogFont.lfFaceName) - 1); 147 | Font := CreateFontIndirect(LogFont); 148 | DC := CreateCompatibleDC(GetDC(0)); 149 | try 150 | OldFont := SelectObject(DC, Font); 151 | GetTextMetrics(DC, TextMetric); 152 | x := 0; 153 | y := 0; 154 | for Index := 1 to Length(Text) do 155 | begin 156 | BuildGlyph(DC, x, y, Text[Index], Path, TextMetric); 157 | end; 158 | SelectObject(DC, OldFont); 159 | 160 | DeleteObject(Font); 161 | finally 162 | DeleteDC(DC); 163 | end; 164 | end; 165 | 166 | function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric; 167 | FontType: Integer; Data: Pointer): Integer; stdcall; 168 | var 169 | S: TStrings; 170 | Temp: string; 171 | begin 172 | if FontType and TRUETYPE_FONTTYPE <> 0 then 173 | begin 174 | S := TStrings(Data); 175 | Temp := LogFont.lfFaceName; 176 | if (S.Count = 0) or (Temp <> S[S.Count-1]) then 177 | S.Add(Temp); 178 | end; 179 | Result := 1; 180 | end; 181 | 182 | procedure GetFontList(List: TStrings); 183 | var 184 | DC: HDC; 185 | LList: TStringList; 186 | LFont: TLogFont; 187 | begin 188 | DC := GetDC(0); 189 | FillChar(LFont, sizeof(LFont), 0); 190 | LFont.lfCharset := DEFAULT_CHARSET; 191 | LList := TStringList.Create; 192 | try 193 | LList.Sorted := True; 194 | EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, Winapi.Windows.LPARAM(LList), 0); 195 | List.Assign(LList); 196 | finally 197 | LList.Free; 198 | end; 199 | ReleaseDC(0, DC); 200 | end; 201 | 202 | end. 203 | 204 | -------------------------------------------------------------------------------- /TextPath/TextPath.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/TextPath/TextPath.png -------------------------------------------------------------------------------- /TextPath/TextPath2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/TextPath/TextPath2.png -------------------------------------------------------------------------------- /TextPath/readme.md: -------------------------------------------------------------------------------- 1 | # TextPath 2 | 3 | Execute.FMX.TextPathDesigner is a Delphi package that add a "Text Path..." popup option to the FMX TPath component. 4 | 5 | This let you create a vectorial text for any plateform from the Windows True Type Fonts. 6 | 7 | ![screenshot](TextPath.png) 8 | 9 | Fill free to add FMX Effects :) 10 | 11 | ![screenshot](TextPath2.png) 12 | -------------------------------------------------------------------------------- /WoodTexture/NathaanTFM.AS3Perlin.pas: -------------------------------------------------------------------------------- 1 | unit NathaanTFM.AS3Perlin; 2 | 3 | // Delphi translation of https://github.com/NathaanTFM/as3-perlin 4 | // (c)2024 Execute SARL 5 | 6 | interface 7 | {$POINTERMATH ON} 8 | {.$DEFINE OFFSETS} 9 | {$Q-} 10 | uses 11 | System.Math; 12 | 13 | type 14 | TPerlinVector2 = record 15 | x: Double; 16 | y: Double; 17 | end; 18 | PPerlinVector2 = ^TPerlinVector2; 19 | 20 | TAS3PerlinNoise = record 21 | private 22 | baseX: Double; 23 | baseY: Double; 24 | 25 | numOctaves: Cardinal; 26 | 27 | permutations: array[0..255] of Byte; 28 | vectors: array[0..3, 0..255] of TPerlinVector2; 29 | 30 | stitch: Boolean; 31 | stitchArr: array[0..1] of Cardinal; 32 | 33 | fractalNoise: Boolean; 34 | 35 | channelOptions: Byte; 36 | channelCount: Byte; 37 | grayScale: Boolean; 38 | 39 | {$IFDEF OFFSETS} 40 | offsets: TArray; 41 | {$ENDIF} 42 | procedure generateRandom(randomSeed: Integer); 43 | public 44 | constructor Create(Width, height: Integer; baseX, baseY: Double; numOctaves, randomSeed: Integer; stitch, fractalNoise: Boolean; channelOptions: Cardinal = 0; grayScale: Boolean = False; offsets: PPerlinVector2 = nil); 45 | function generatePerlinNoise(x, y: Integer): Cardinal; 46 | end; 47 | 48 | implementation 49 | 50 | const 51 | Epsilon = 0.001; 52 | 53 | function getNextRandomSeed(randomSeed: Integer): Integer; 54 | begin 55 | Result := -2836 * (randomSeed div 127773) + 16807 * (randomSeed mod 127773); 56 | if Result <= 0 then 57 | Inc(Result, $7FFFFFFF); // what if it's equals to -0x80000000?? 58 | end; 59 | 60 | function interpolate(a0, a1, w: Double): Double; inline; 61 | begin 62 | Result := (a1 - a0) * (3.0 - w * 2.0) * w * w + a0; 63 | end; 64 | 65 | function unmultiplyColor(red, green, blue, alpha: Byte): Cardinal; 66 | begin 67 | if alpha <> 255 then 68 | begin 69 | var val: Cardinal := 0; 70 | if alpha <> 0 then 71 | val := $FF00 div alpha; 72 | red := (val * red + $7F) shr 8; 73 | green := (val * green + $7F) shr 8; 74 | blue := (val * blue + $7F) shr 8; 75 | end; 76 | Result := (alpha shl 24) or (red shl 16) or (green shl 8) or blue; 77 | end; 78 | 79 | { TAS3PerlinNoise } 80 | 81 | constructor TAS3PerlinNoise.Create(Width, height: Integer; baseX, baseY: Double; numOctaves, 82 | randomSeed: Integer; stitch, fractalNoise: Boolean; channelOptions: Cardinal; 83 | grayScale: Boolean; offsets: PPerlinVector2); 84 | begin 85 | 86 | if Abs(baseX) > Epsilon then 87 | baseX := 1/Abs(baseX); 88 | 89 | if Abs(baseY) > Epsilon then 90 | baseY := 1/Abs(baseY); 91 | 92 | Self.numOctaves := numOctaves; 93 | 94 | generateRandom(randomSeed); 95 | 96 | Self.stitch := stitch; 97 | 98 | if stitch then 99 | begin 100 | if Abs(baseX) > Epsilon then 101 | begin 102 | var tmp1 := Floor(baseX * width) / width; 103 | var tmp2 := Ceil(baseX * width) / width; 104 | 105 | if (Abs(tmp1) < Epsilon) or (baseX / tmp1 >= tmp2 / baseX) then 106 | baseX := tmp2 107 | else 108 | baseX := tmp1; 109 | end; 110 | 111 | if Abs(baseY) > Epsilon then 112 | begin 113 | var tmp1 := Floor(baseY * height) / height; 114 | var tmp2 := Ceil(baseY * height) / height; 115 | 116 | if (Abs(tmp1) < Epsilon) or (baseX / tmp1 >= tmp2 / baseX) then 117 | baseY := tmp2 118 | else 119 | baseY := tmp1; 120 | end; 121 | 122 | stitchArr[0] := Round(Width * baseX); 123 | stitchArr[1] := Round(height * baseY); 124 | end; 125 | 126 | Self.baseX := baseX; 127 | Self.baseY := baseY; 128 | Self.fractalNoise := fractalNoise; 129 | 130 | Self.channelOptions := channelOptions; 131 | Self.grayScale := grayScale; 132 | 133 | if grayScale then 134 | channelCount := 1 135 | else 136 | channelCount := Ord(channelOptions and 1 <> 0) + Ord(channelOptions and 2 <> 0) + Ord(channelOptions and 4 <> 0); 137 | 138 | Inc(channelCount, Ord(channelOptions and 8 <> 0)); 139 | 140 | {$IFDEF OFFSETS} 141 | SetLength(Self.offsets, numOctaves); 142 | 143 | if offsets <> nil then 144 | Move(offsets^, Self.offsets[0], numOctaves * SizeOf(TPerlinVector2)); 145 | {$ENDIF} 146 | end; 147 | 148 | procedure TAS3PerlinNoise.generateRandom(randomSeed: Integer); 149 | begin 150 | if randomSeed <= 0 then 151 | randomSeed := Abs(randomSeed - 1) 152 | else 153 | if randomSeed = $7FFFFFFF then 154 | Dec(randomSeed); 155 | 156 | for var i := 0 to 3 do 157 | begin 158 | for var j := 0 to 255 do 159 | begin 160 | var vector: PPerlinVector2 := @vectors[i, j]; 161 | 162 | randomSeed := getNextRandomSeed(randomSeed); 163 | vector.x := (randomSeed mod 512 - 256) / 256.0; 164 | 165 | randomSeed := getNextRandomSeed(randomSeed); 166 | vector.y := (randomSeed mod 512 - 256) / 256.0; 167 | 168 | var dist := sqrt(Power(vector.x, 2) + Power(vector.y, 2)); 169 | 170 | if dist < Epsilon then 171 | begin 172 | vector.x := 0; 173 | vector.y := 0; 174 | end else begin 175 | vector.x := vector.x / dist; 176 | vector.y := vector.y / dist; 177 | end; 178 | end; 179 | end; 180 | 181 | for var i := 0 to 255 do 182 | permutations[i] := i; 183 | 184 | for var i := 255 downto 1 do 185 | begin 186 | randomSeed := getNextRandomSeed(randomSeed); 187 | 188 | var j := randomSeed and $FF; 189 | var temp := permutations[j]; 190 | permutations[j] := permutations[i]; 191 | permutations[i] := temp; 192 | end; 193 | end; 194 | 195 | 196 | function TAS3PerlinNoise.generatePerlinNoise(x, y: Integer): Cardinal; 197 | var 198 | red, green, blue, alpha: Cardinal; 199 | channelAlpha: Double; 200 | channels: array[0..3] of Double; 201 | begin 202 | red := 0; green := 0; blue := 0; alpha := 255; 203 | 204 | var baseX := Self.baseX; 205 | var baseY := Self.baseY; 206 | 207 | channelAlpha := 255; 208 | 209 | FillChar(channels, SizeOf(channels), 0); 210 | 211 | for var octave := 0 to numOctaves - 1 do 212 | begin 213 | var offsetX := ({$IFDEF OFFSETS}offsets[octave].x +{$ENDIF} x) * baseX + 4096.0; 214 | var offsetY := ({$IFDEF OFFSETS}offsets[octave].y +{$ENDIF} y) * baseY + 4096.0; 215 | 216 | var x0 := Floor(offsetX); 217 | var x1 := x0 + 1; 218 | 219 | var y0 := Floor(offsetY); 220 | var y1 := y0 + 1; 221 | 222 | var dx0 := offsetX - x0; // Floor(offsetX); 223 | var dx1 := dx0 - 1.0; 224 | 225 | var dy0 := offsetY - y0; // Floor(offsetY); 226 | var dy1 := dy0 - 1.0; 227 | 228 | if stitch then 229 | begin 230 | var tmp1 := stitchArr[0] + 4096; 231 | var tmp2 := stitchArr[1] + 4096; 232 | 233 | if x0 >= tmp1 then 234 | x0 := x0 - stitchArr[0]; 235 | 236 | if x1 >= tmp1 then 237 | x1 := x1 - stitchArr[0]; 238 | 239 | if y0 >= tmp2 then 240 | y0 := y0 - stitchArr[1]; 241 | 242 | if y1 >= tmp2 then 243 | y1 := y1 - stitchArr[1]; 244 | end; 245 | 246 | var idx1 := permutations[x0 and 255]; 247 | var idx2 := permutations[x1 and 255]; 248 | 249 | var v1 := permutations[(y0 + idx1) and 255]; 250 | var v2 := permutations[(y0 + idx2) and 255]; 251 | var v3 := permutations[(y1 + idx1) and 255]; 252 | var v4 := permutations[(y1 + idx2) and 255]; 253 | 254 | for var channel := 0 to channelCount - 1 do 255 | begin 256 | var n0, n1: Double; 257 | var vectorArray: PPerlinVector2 := @vectors[channel]; 258 | 259 | n0 := vectorArray[v1].x * dx0 + vectorArray[v1].y * dy0; 260 | n1 := vectorArray[v2].x * dx1 + vectorArray[v2].y * dy0; 261 | var ix1 := interpolate(n0, n1, dx0); 262 | 263 | n0 := vectorArray[v3].x * dx0 + vectorArray[v3].y * dy1; 264 | n1 := vectorArray[v4].x * dx1 + vectorArray[v4].y * dy1; 265 | var ix2 := interpolate(n0, n1, dx0); 266 | 267 | var value := interpolate(ix1, ix2, dy0); 268 | if fractalNoise then 269 | channels[channel] := channels[channel] + value * channelAlpha 270 | else 271 | channels[channel] := channels[channel] + Abs(value) * channelAlpha 272 | end; 273 | 274 | channelAlpha := channelAlpha * 0.5; 275 | baseX := baseX * 2.0; 276 | baseY := baseY * 2.0; 277 | 278 | if stitch then 279 | begin 280 | stitchArr[0] := stitchArr[0] * 2; 281 | stitchArr[1] := stitchArr[1] * 2; 282 | end; 283 | end; 284 | 285 | var nextChannel := 0; 286 | if fractalNoise then 287 | begin 288 | if grayScale then 289 | begin 290 | red := Cardinal(Round(channels[nextChannel] + 255.0) shr 1); Inc(nextChannel); 291 | green := red; 292 | blue := red; 293 | end else begin 294 | if channelOptions and 1 <> 0 then begin red := Cardinal(round(channels[nextChannel] + 255.0) shr 1); Inc(nextChannel); end; 295 | if channelOptions and 2 <> 0 then begin green := Cardinal(round(channels[nextChannel] + 255.0) shr 1); Inc(nextChannel); end; 296 | if channelOptions and 4 <> 0 then begin blue := Cardinal(round(channels[nextChannel] + 255.0) shr 1); Inc(nextChannel); end; 297 | end; 298 | if channelOptions and 8 <> 0 then alpha := round(channels[nextChannel] + 255.0) shr 1; 299 | end else begin 300 | if grayScale then 301 | begin 302 | red := round(channels[nextChannel]); Inc(nextChannel); 303 | green := red; 304 | blue := red; 305 | end else begin 306 | if channelOptions and 1 <> 0 then begin red := round(channels[nextChannel]); Inc(nextChannel); end; 307 | if channelOptions and 2 <> 0 then begin green := round(channels[nextChannel]); Inc(nextChannel); end; 308 | if channelOptions and 4 <> 0 then begin blue := round(channels[nextChannel]); Inc(nextChannel); end; 309 | end; 310 | if channelOptions and 8 <> 0 then alpha := round(channels[nextChannel]); 311 | end; 312 | 313 | alpha := Min(Max(alpha, 0), 255); 314 | red := Min(Max(red, 0), alpha); 315 | green := Min(Max(green, 0), alpha); 316 | blue := Min(Max(blue, 0), alpha); 317 | 318 | Result := unmultiplyColor(red, green, blue, alpha); 319 | end; 320 | 321 | end. 322 | -------------------------------------------------------------------------------- /WoodTexture/Wood.FlashLike.pas: -------------------------------------------------------------------------------- 1 | unit Wood.FlashLike; 2 | 3 | { 4 | Delphi implementation of some of Flash (AS3) function (c) 2024 Execute SARL 5 | 6 | } 7 | 8 | interface 9 | {$POINTERMATH ON} 10 | uses 11 | System.Types, 12 | System.UITypes, 13 | System.Math, 14 | FMX.Types, 15 | FMX.Surfaces, 16 | NathaanTFM.AS3Perlin; 17 | 18 | type 19 | Number = Integer; 20 | 21 | BitmapData = class; 22 | 23 | BitmapFilter = interface 24 | procedure Filter(source: BitmapData; x, y: Integer; var pixel: Cardinal); 25 | end; 26 | 27 | BitmapData = class(TBitmapSurface) 28 | constructor Create(w, h: Integer); 29 | procedure perlinNoise(baseX, baseY: Double; numOctaves, randomSeed: Number; stitch, fractalNoise: Boolean; channelOptions: Number = 0; grayScale: Boolean = False; offsets: Pointer = nil); 30 | function Clone: BitmapData; 31 | function rectangle: TRect; 32 | procedure applyFilter(sourceBitmapData: BitmapData; const sourceRec: TRect; const destPoint: TPoint; filter: BitmapFilter); 33 | procedure fillRect(const R: TRect; color: Cardinal); 34 | procedure merge(sourceBitmapData: BitmapData; const sourceRect: TRect; const destPoint: TPoint; redMultiplier, greenMultiplier, blueMultiplier, alphaMultiplier: Integer); 35 | end; 36 | 37 | TDisplacementMapFilterMode = (clamp, color, ignore, wrap); 38 | 39 | DisplacementMapFilter = class(TInterfacedObject, BitmapFilter) 40 | protected 41 | mapBitmap: BitmapData; 42 | mapPoint: TPoint; 43 | componentX, componentY: Integer; 44 | scaleX, scaleY: Double; 45 | mode: TDisplacementMapFilterMode; 46 | color: Cardinal; 47 | alpha: Double; 48 | procedure Filter(source: BitmapData; x, y: Integer; var pixel: Cardinal); 49 | function getColor(x, y: Integer; source: BitmapData): Cardinal; 50 | public 51 | constructor Create(mapBitmap: BitmapData; mapPoint: TPoint; componentX, componentY: Integer; scaleX, scaleY: Double; mode: string = 'wrap'; color: Cardinal = 0; alpha: Double = 0); 52 | end; 53 | 54 | ColorMatrixFilter = class(TInterfacedObject, BitmapFilter) 55 | private 56 | Matrix: TArray; 57 | procedure Filter(source: BitmapData; x, y: Integer; var pixel: Cardinal); 58 | public 59 | constructor Create(const Matrix: TArray); 60 | end; 61 | 62 | ConvolutionFilter = class(TInterfacedObject, BitmapFilter) 63 | private 64 | MatrixX: Integer; 65 | MatrixY: Integer; 66 | Matrix: TArray; 67 | Bias: Integer; 68 | procedure Filter(source: BitmapData; x, y: Integer; var pixel: Cardinal); 69 | public 70 | constructor Create(MatrixX, MatrixY: Integer; const Matrix: TArray; Bias: Integer); 71 | end; 72 | 73 | type 74 | Rectangle = class 75 | class function Create(l, t, w, h: Integer): TRect; 76 | end; 77 | 78 | implementation 79 | 80 | function clampByte(color: Single): Byte; 81 | begin 82 | Result := Round(Min(Max(0, color), 255)); 83 | end; 84 | 85 | { Rectangle } 86 | 87 | class function Rectangle.Create(l: Integer; t: Integer; w: Integer; h: Integer): TRect; 88 | begin 89 | Result.Left := l; 90 | Result.Top := t; 91 | Result.Width := w - 1; 92 | Result.Height := h - 1; 93 | end; 94 | 95 | { BitmapData } 96 | 97 | procedure BitmapData.applyFilter(sourceBitmapData: BitmapData; 98 | const sourceRec: TRect; const destPoint: TPoint; filter: BitmapFilter); 99 | begin 100 | var source := sourceBitmapData; 101 | if source = Self then 102 | source := Clone(); 103 | var x1 := Min(Max(0, destPoint.X), Width); 104 | var X2 := Min(Max(0, destPoint.X + sourceRec.Width), Width); 105 | var y1 := Min(Max(0, destPoint.Y), Height); 106 | var y2 := Min(Max(0, destPoint.Y + sourcerec.Height), Height); 107 | var dx := x2 - x1 - 1; 108 | var dy := y2 - y1 - 1; 109 | 110 | for var y := 0 to dy do 111 | begin 112 | var p: PCardinal := ScanLine[y1 + y]; 113 | for var x := 0 to dx do 114 | begin 115 | filter.Filter(source, x + sourceRec.Left, y + sourceRec.Top, p[x1 + x]); 116 | end; 117 | end; 118 | if source <> sourceBitmapData then 119 | source.Free; 120 | end; 121 | 122 | function BitmapData.Clone: BitmapData; 123 | begin 124 | Result := BitmapData.Create(Width, Height); 125 | Result.Assign(Self); 126 | end; 127 | 128 | constructor BitmapData.Create(w, h: Integer); 129 | begin 130 | inherited Create; 131 | SetSize(w, h, TPixelFormat.BGRA); 132 | FillRect(TRect.Create(0, 0, w, h), $ff000000); 133 | end; 134 | 135 | procedure BitmapData.fillRect(const R: TRect; color: Cardinal); 136 | begin 137 | var x1 := Min(Max(0, R.Left), Width - 1); 138 | var x2 := Min(Max(0, R.Right), Width - 1); 139 | var y1 := Min(Max(0, R.Top), Height - 1); 140 | var y2 := Min(Max(0, R.Bottom), Height - 1); 141 | for var y := y1 to y2 do 142 | begin 143 | var p: PCardinal := ScanLine[y]; 144 | for var x := x1 to x2 do 145 | begin 146 | p[x] := color; 147 | end; 148 | end; 149 | 150 | end; 151 | 152 | procedure BitmapData.merge(sourceBitmapData: BitmapData; 153 | const sourceRect: TRect; const destPoint: TPoint; redMultiplier, 154 | greenMultiplier, blueMultiplier, alphaMultiplier: Integer); 155 | begin 156 | var x1 := Min(Max(0, destPoint.X), Width - 1); 157 | var x2 := Min(Max(0, destPoint.X + sourceRect.Width), Width - 1); 158 | var y1 := Min(Max(0, destPoint.Y), Height - 1); 159 | var y2 := Min(Max(0, destPoint.Y + sourceRect.Height), Height - 1); 160 | var dx := x2 - x1 - 1; 161 | var dy := y2 - y1 - 1; 162 | for var y := 0 to dy do 163 | begin 164 | var sy := sourceRect.Top + y; 165 | if sy < 0 then 166 | Continue; 167 | if sy > sourceBitmapData.Height then 168 | Exit; 169 | var P: PColorRec := ScanLine[y1 + y]; 170 | var S: PColorRec := sourceBitmapData.ScanLine[sy]; 171 | for var x := 0 to dx do 172 | begin 173 | var sx := sourceRect.Left + x; 174 | if sx < 0 then 175 | Continue; 176 | if sx > sourceBitmapData.Width then 177 | break; 178 | var PC: PColorRec := @P[x1 + x]; 179 | var PS: PColorRec := @S[sx]; 180 | PC.B := ClampByte(((PS.B * blueMultiplier) + (PC.B * (256 - blueMultiplier))) / 256); 181 | PC.G := ClampByte(((PS.G * greenMultiplier) + (PC.G * (256 - greenMultiplier))) / 256); 182 | PC.R := ClampByte(((PS.R * redMultiplier) + (PC.R * (256 - redMultiplier))) / 256); 183 | PC.A := ClampByte(((PS.A * alphaMultiplier) + (PC.A * (256 - alphaMultiplier))) / 256); 184 | end; 185 | end; 186 | end; 187 | 188 | procedure BitmapData.perlinNoise(baseX, baseY: Double; numOctaves, randomSeed: Number; stitch, fractalNoise: Boolean; channelOptions: Number = 0; grayScale: Boolean = False; offsets: Pointer = nil); 189 | var 190 | v: Cardinal; 191 | begin 192 | var perlin := TAS3PerlinNoise.Create(Width, Height, baseX, baseY, numOctaves, randomSeed, stitch, fractalNoise, channelOptions, grayScale, offsets); 193 | for var y := 0 to Height - 1 do 194 | begin 195 | var p: PCardinal := ScanLine[y]; 196 | for var x := 0 to Width - 1 do 197 | begin 198 | p[x]:= perlin.generatePerlinNoise(x, y); 199 | end; 200 | end; 201 | 202 | end; 203 | 204 | function BitmapData.rectangle: TRect; 205 | begin 206 | Result.Left := 0; 207 | Result.Top := 0; 208 | Result.Width := Width; 209 | Result.Height := Height; 210 | end; 211 | 212 | { DisplacementMapFilter } 213 | 214 | function getComponent(component: Integer; color: Cardinal): Integer; 215 | begin 216 | case component of 217 | 1: // RED 218 | Result := color and $FF; 219 | 2: // GREEN 220 | Result := (color shr 8) and $FF; 221 | 4: // BLUE 222 | Result := (color shr 16) and $FF; 223 | 8: // ALPHA 224 | Result := (color shr 24); 225 | end; 226 | end; 227 | 228 | procedure WrapValue(var x: Integer; max: Integer); 229 | begin 230 | while x < 0 do Inc(x, max); 231 | while x >= max do Dec(x, max); 232 | end; 233 | 234 | constructor DisplacementMapFilter.Create(mapBitmap: BitmapData; 235 | mapPoint: TPoint; componentX, componentY: Integer; scaleX, scaleY: Double; 236 | mode: string; color: Cardinal; alpha: Double); 237 | begin 238 | Self.mapBitmap := mapBitmap; 239 | Self.mapPoint := mapPoint; 240 | Self.componentX := componentX; 241 | Self.componentY := componentY; 242 | Self.scaleX := ScaleX; 243 | Self.scaleY := scaleY; 244 | if mode = 'clamp' then 245 | Self.mode := TDisplacementMapFilterMode.clamp 246 | else 247 | if mode = 'color' then 248 | Self.mode := TDisplacementMapFilterMode.color 249 | else 250 | if mode = 'ignore' then 251 | Self.mode := TDisplacementMapFilterMode.ignore 252 | else 253 | Self.mode := TDisplacementMapFilterMode.wrap; 254 | Self.color := color; 255 | Self.alpha := alpha; 256 | end; 257 | 258 | procedure DisplacementMapFilter.Filter(source: BitmapData; x, y: Integer; var pixel: Cardinal); 259 | begin 260 | // dstPixel[x, y] = srcPixel[x + ((componentX(x, y) - 128) * scaleX) / 256, y + ((componentY(x, y) - 128) *scaleY) / 256) 261 | if (x < 0) 262 | or (y < 0) 263 | or (x >= mapBitmap.Width) 264 | or (y >= mapBitmap.Height) then 265 | begin 266 | Exit; 267 | end; 268 | 269 | var l: PCardinal := mapBitmap.ScanLine[y]; 270 | var c := l[x]; 271 | 272 | {$IFDEF NO_SMOOTH} 273 | var sx: Integer := x + Round(((getComponent(componentX, c) - 128) * scaleX) / 256); 274 | var sy: Integer := y + Round(((getComponent(componentY, c) - 128) * scaleY) / 256); 275 | 276 | Pixel := getColor(sx, sy, source); 277 | {$ELSE} 278 | // I've tried to implement a smoothing but the result is poor 279 | 280 | var sx: Double := x + ((getComponent(componentX, c) - 128) * scaleX) / 256; 281 | var sy: Double := y + ((getComponent(componentY, c) - 128) * scaleY) / 256; 282 | 283 | var tx: Integer := Round(sx); 284 | var ty: Integer := Round(sy); 285 | 286 | var fx := sx - tx; 287 | var fy := sy - ty; 288 | 289 | var c1 := getColor(tx, ty, source); 290 | var c2 := getColor(tx + 1, ty, source); 291 | var c3 := getColor(tx, ty + 1, source); 292 | var c4 := getColor(tx + 1, ty + 1, source); 293 | 294 | var f2 := 1 - fx; 295 | 296 | var r1 := TColorRec(c1).R * f2 + TColorRec(c2).R * fx; 297 | var g1 := TColorRec(c1).G * f2 + TColorRec(c2).G * fx; 298 | var b1 := TColorRec(c1).B * f2 + TColorRec(c2).B * fx; 299 | var a1 := TColorRec(c1).A * f2 + TColorRec(c2).A * fx; 300 | 301 | var r2 := TColorRec(c3).R * f2 + TColorRec(c4).R * fx; 302 | var g2 := TColorRec(c3).G * f2 + TColorRec(c4).G * fx; 303 | var b2 := TColorRec(c3).B * f2 + TColorRec(c4).B * fx; 304 | var a2 := TColorRec(c3).A * f2 + TColorRec(c4).A * fx; 305 | 306 | f2 := 1 - fy; 307 | 308 | with TColorRec(pixel) do 309 | begin 310 | R := ClampByte(r1 * f2 + r2 * fy); 311 | G := ClampByte(g1 * f2 + g2 * fy); 312 | B := ClampByte(b1 * f2 + b2 * fy); 313 | A := ClampByte(a1 * f2 + a2 * fy); 314 | end; 315 | {$ENDIF} 316 | end; 317 | 318 | function DisplacementMapFilter.getColor(x, y: Integer; source: BitmapData): Cardinal; 319 | begin 320 | var cx := Min(Max(0, x), source.Width - 1); 321 | var cy := Min(Max(0, y), source.Height - 1); 322 | var clamped := (cx <> x) or (cy <> y); 323 | if clamped then 324 | begin 325 | case Mode of 326 | TDisplacementMapFilterMode.clamp: 327 | begin 328 | x := cx; 329 | y := cy; 330 | end; 331 | TDisplacementMapFilterMode.color: 332 | begin 333 | Result := Color; 334 | Exit; 335 | end; 336 | TDisplacementMapFilterMode.ignore: 337 | begin 338 | Result := 0; // ? 339 | Exit; 340 | end; 341 | TDisplacementMapFilterMode.wrap: 342 | begin 343 | WrapValue(x, source.Width); 344 | WrapValue(y, source.Height); 345 | end; 346 | end; 347 | end; 348 | var L: PCardinal := source.ScanLine[y]; 349 | Result := L[x]; 350 | end; 351 | 352 | { ColorMatrixFilter } 353 | 354 | constructor ColorMatrixFilter.Create(const Matrix: TArray); 355 | begin 356 | Self.Matrix := Matrix; 357 | end; 358 | 359 | procedure ColorMatrixFilter.Filter(source: BitmapData; x, y: Integer; 360 | var pixel: Cardinal); 361 | begin 362 | if (x < 0) 363 | or (y < 0) 364 | or (x >= source.Width) 365 | or (y >= source.Height) then 366 | begin 367 | Exit; 368 | end; 369 | var l: PColorRec := source.ScanLine[y]; 370 | var c: TColorRec := l[x]; 371 | with TColorRec(pixel) do 372 | begin 373 | B := clampByte(c.R * Matrix[ 0] + c.G * Matrix[ 1] + c.B * Matrix[ 2] + c.A * Matrix[ 3] + Matrix[ 4]); 374 | G := clampByte(c.R * Matrix[ 5] + c.G * Matrix[ 6] + c.B * Matrix[ 7] + c.A * Matrix[ 8] + Matrix[ 9]); 375 | R := clampByte(c.R * Matrix[10] + c.G * Matrix[11] + c.B * Matrix[12] + c.A * Matrix[13] + Matrix[14]); 376 | A := clampByte(c.R * Matrix[15] + c.G * Matrix[16] + c.B * Matrix[17] + c.A * Matrix[18] + Matrix[19]); 377 | end; 378 | end; 379 | 380 | { ConvolutionFilter } 381 | 382 | constructor ConvolutionFilter.Create(MatrixX, MatrixY: Integer; const Matrix: TArray; Bias: Integer); 383 | begin 384 | Self.MatrixX := MatrixX; 385 | Self.MatrixY := MatrixY; 386 | Self.Matrix := Matrix; 387 | Self.Bias := Bias; 388 | end; 389 | 390 | procedure ConvolutionFilter.Filter(source: BitmapData; x, y: Integer; 391 | var pixel: Cardinal); 392 | var 393 | ar, ag, ab, aa: Single; 394 | sum: Single; 395 | begin 396 | ar := 0; 397 | ag := 0; 398 | ab := 0; 399 | aa := 0; 400 | sum := 0; 401 | var oy := y - MatrixY div 2; 402 | var m := 0; 403 | for var my := 0 to MatrixY - 1 do 404 | begin 405 | if oy >= source.Height then 406 | Break; 407 | if oy >= 0 then 408 | begin 409 | var P: PColorRec := source.ScanLine[oy]; 410 | var ox := x - MatrixX div 2; 411 | for var mx := 0 to MatrixX - 1 do 412 | begin 413 | if ox >= source.Width then 414 | Break; 415 | var f := Matrix[m]; 416 | if ox >= 0 then 417 | begin 418 | ar := ar + p[ox].R * f; 419 | ag := ag + p[ox].G * f; 420 | ab := ab + p[ox].B * f; 421 | aa := aa + p[ox].A * f; 422 | sum := sum + f; 423 | end; 424 | Inc(ox); 425 | Inc(m); 426 | end; 427 | end else begin 428 | Inc(m, MatrixX); 429 | end; 430 | Inc(oy); 431 | end; 432 | if sum = 0 then 433 | Exit; 434 | with TColorRec(pixel) do 435 | begin 436 | var f := 1/sum; 437 | R := ClampByte(ar * f + bias); // bias ?! 438 | G := ClampByte(ag * f + bias); 439 | B := ClampByte(ab * f + bias); 440 | A := ClampByte(aa * f + bias); 441 | end; 442 | end; 443 | 444 | end. 445 | -------------------------------------------------------------------------------- /WoodTexture/Wood.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/WoodTexture/Wood.gif -------------------------------------------------------------------------------- /WoodTexture/WoodTexture.Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/WoodTexture/WoodTexture.Main.pas -------------------------------------------------------------------------------- /WoodTexture/WoodTexture.dpr: -------------------------------------------------------------------------------- 1 | program WoodTexture; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | WoodTexture.Main in 'WoodTexture.Main.pas' {Main}, 7 | NathaanTFM.AS3Perlin in 'NathaanTFM.AS3Perlin.pas', 8 | Wood.FlashLike in 'Wood.FlashLike.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.CreateForm(TMain, Main); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /WoodTexture/WoodTexture.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/Firemonkey/9b9fef14bc608da041e8b64abbb4adde561eec22/WoodTexture/WoodTexture.res -------------------------------------------------------------------------------- /WoodTexture/readme.md: -------------------------------------------------------------------------------- 1 | # Wood Texture 2 | 3 | This is a Delphi FMX version of my [FlashPascal](https://github.com/tothpaul/FlashPascal) Wood demo 4 | 5 | The purpose is to create a procedural texture that looks like wood planks 6 | 7 | the Wood.FlashLike implements some of the ActionScript BitmapData functions used on the original demo 8 | 9 | ![screenshot](Wood.gif) 10 | 11 | 12 | --------------------------------------------------------------------------------