├── BitUnit.pas ├── CameraClass.pas ├── ColObject.pas ├── EliRT.obj ├── FrustumCulling.pas ├── Geometry.pas ├── Newton.pas ├── OpenGL12.pas ├── README.md ├── Struct ├── ColObject.pas ├── GTADLL.PAS ├── RenderWareDFF.pas ├── rwtxd.pas ├── textparser.pas └── u_txdrecords.pas ├── ThdTimer.pas ├── U_main.dfm ├── U_main.pas ├── VectorTypes.pas ├── compiler.inc ├── components ├── DNK_Panel.pas ├── DNK_RoundSlider.pas ├── DNK_designpanel.pas ├── DNK_edit.pas ├── Trackbar_32.pas └── checkbox_32.pas ├── editor.dpr ├── editor.ico ├── editor.res ├── mapviewerstuff ├── FileTypes.pas ├── MapLoader.pas ├── RequiredTypes.pas └── TextureStuff.pas ├── uHashedStringList.pas ├── u_Objects.pas ├── u_addide.dfm ├── u_addide.pas ├── u_advedit.dfm ├── u_advedit.pas ├── u_carcolors.dfm ├── u_carcolors.pas ├── u_edit.dfm ├── u_edit.pas ├── u_report.dfm ├── u_report.pas ├── u_sowcode.dfm └── u_sowcode.pas /BitUnit.pas: -------------------------------------------------------------------------------- 1 | {**********************************************************************} 2 | {* *} 3 | {* Bit Unit, a unit for easy bit manipulation *} 4 | {* Author: *} 5 | {* Theodoros Bebekis *} 6 | {* Thessaloniki, Greece *} 7 | {* bebekis@mail.otenet.gr *} 8 | {* *} 9 | {* Delfi's 2003 update *} 10 | {* 3 new functions: *} 11 | {* setbit, getbit, bitcopy *} 12 | {* delfi_2_4@yahoo.com *} 13 | {* *} 14 | {**********************************************************************} 15 | 16 | unit BitUnit; 17 | 18 | interface 19 | 20 | function IsBitSet(const i, Nth: integer): boolean; 21 | function BitToOn(const i, Nth: integer): integer; 22 | function BitToOff(const i, Nth: integer): integer; 23 | function BitToggle(const i, Nth: integer): integer; 24 | function ReverseAllBits(const i: integer): integer; 25 | 26 | // new 27 | function bitcopy(source, dest, start, count, deststart: integer): integer; 28 | function getbit(source, index: integer): boolean; 29 | function setbit(source, index: integer; to_: boolean): integer; 30 | 31 | 32 | implementation 33 | 34 | // IsBitSet 35 | // returns True if a bit is ON (1) 36 | // Nth can have any bit order value in [0..31] 37 | 38 | function IsBitSet(const i, Nth: integer): boolean; 39 | begin 40 | Result:= (i and (1 shl Nth)) <> 0; 41 | end; 42 | 43 | 44 | // BitToOn 45 | // sets a bit in number to on and returns new number 46 | 47 | function BitToOn(const i, Nth: integer): integer; 48 | begin 49 | if not IsBitSet(i, Nth) 50 | then Result := i or (1 shl Nth) else Result:=i; 51 | end; 52 | 53 | // BitToOff 54 | // sets a bit in number to off and returns new number 55 | function BitToOff(const i, Nth: integer): integer; 56 | begin 57 | if IsBitSet(i, Nth) 58 | then Result := i and ((1 shl Nth) xor $FFFFFFFF) 59 | else Result:=i; 60 | end; 61 | 62 | // BitToggle 63 | // toggles the state of a bit 64 | 65 | function BitToggle(const i, Nth: integer): integer; 66 | begin 67 | Result := i xor (1 shl Nth); 68 | end; 69 | 70 | // ReverseAllBits 71 | // reverses all bits (all zeroes to ones and ones to zeroes) 72 | 73 | function ReverseAllBits(const i: integer): integer; 74 | var N:integer; 75 | begin 76 | Result:= i; 77 | for N:=0 to 31 do Result:= Result xor (1 shl N); 78 | end; 79 | 80 | // Added Delfi's functions 81 | 82 | // setbit 83 | // 84 | 85 | function setbit(source, index: integer; to_: boolean): integer; 86 | begin 87 | case to_ of 88 | true: result:= bittoon(source, index); 89 | false: result:= bittooff(source, index); 90 | end; 91 | end; 92 | 93 | // getbit 94 | // same as isbitset with a name that makes more sense in the code where you use it. 95 | 96 | function getbit(source, index: integer): boolean; 97 | begin 98 | Result:= (source and (1 shl index)) <> 0; 99 | end; 100 | 101 | // bitcopy 102 | // copies a range of bits from source to dest 103 | 104 | function bitcopy(source, dest, start, count, deststart: integer): integer; 105 | var 106 | N: integer; 107 | begin 108 | result:= dest; 109 | 110 | for n:= start to start + count do begin 111 | dest:= setbit(dest, deststart + n, getbit(source, n)); 112 | // if isbitset(source, n) then dest:= bittoon(dest, deststart + n) else dest:= bittooff(dest, deststart + n); 113 | end; 114 | 115 | result:= dest; 116 | end; 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /CameraClass.pas: -------------------------------------------------------------------------------- 1 | unit CameraClass; 2 | 3 | interface 4 | 5 | Uses OpenGL, vectortypes, Windows, math; 6 | 7 | type TCamera = Object 8 | Position : TVector3f; // The camera's position 9 | View : TVector3f; // The camera's View 10 | UpVector : TVector3f; // The camera's UpVector 11 | 12 | fovy, aspect, zNear, zFar: double; 13 | is_ortho: boolean; 14 | 15 | public 16 | Constructor Create; 17 | 18 | procedure PositionCamera(positionX, positionY, positionZ : glFloat; 19 | viewX, viewY, viewZ : glFloat; 20 | upVectorX, upVectorY, upVectorZ : glFloat); 21 | procedure RotateView(const X, Y, Z : glFloat); 22 | procedure MoveCameraByMouse(); 23 | procedure RotateAroundPoint(const Center : TVector3f; const X, Y, Z : glFloat); 24 | procedure StrafeCamera(speed : glFloat); 25 | procedure MoveCamera(speed : glFloat); 26 | function getheading(): single; 27 | end; 28 | 29 | var 30 | thispanel: hwnd; 31 | 32 | const 33 | Fradtodeg = 57.29577951308232286465; // Radians to Degrees 34 | 35 | implementation 36 | 37 | 38 | { TCamera } 39 | 40 | 41 | {------------------------------------------------------------------------} 42 | {--- This function sets the camera's position and view and up vVector ---} 43 | {------------------------------------------------------------------------} 44 | procedure TCamera.PositionCamera(positionX, positionY, positionZ, viewX, 45 | viewY, viewZ, upVectorX, upVectorY, upVectorZ: glFloat); 46 | begin 47 | Position[0] := PositionX; 48 | Position[2] := PositionY; 49 | Position[1] := PositionZ; 50 | 51 | View[0] := ViewX; 52 | View[2] := ViewY; 53 | View[1] := ViewZ; 54 | 55 | UpVector[0] := UpVectorX; 56 | UpVector[2] := UpVectorY; 57 | UpVector[1] := UpVectorZ; 58 | end; 59 | 60 | 61 | {-----------------------------------------------------------------------------} 62 | {--- This will move the camera forward or backward depending on the speed ---} 63 | {-----------------------------------------------------------------------------} 64 | procedure TCamera.MoveCamera(speed: glFloat); 65 | var V : TVector3f; 66 | begin 67 | // Get our view vVector (The direciton we are facing) 68 | V[0] := View[0] - Position[0]; // This gets the direction of the X 69 | V[2] := View[2] - Position[2]; // This gets the direction of the Y 70 | V[1] := View[1] - Position[1]; // This gets the direction of the Z 71 | 72 | Position[0] := Position[0] + V[0] * speed; // Add our acceleration to our position's X 73 | Position[2] := Position[2] + V[2] * speed; // Add our acceleration to our position's Y 74 | Position[1] := Position[1] + V[1] * speed; // Add our acceleration to our position's Z 75 | View[0] := View[0] + V[0] * speed; // Add our acceleration to our view's X 76 | View[2] := View[2] + V[2] * speed; // Add our acceleration to our view's Y 77 | View[1] := View[1] + V[1] * speed; // Add our acceleration to our view's Z 78 | end; 79 | 80 | {-----------------------------------------------------------} 81 | {--- The mouse look function. Use mouse to look around ---} 82 | {-----------------------------------------------------------} 83 | procedure TCamera.MoveCameraByMouse; 84 | var mousePos : TPoint; 85 | middleX, middleY : Integer; 86 | deltaY, rotateY : glFloat; 87 | rect: Trect; 88 | begin 89 | GetWindowRect(thispanel, rect); 90 | 91 | middleX := rect.Left + ((rect.right - rect.left) div 2); 92 | middleY := rect.top + ((rect.bottom - rect.top) div 2); 93 | 94 | // Get the mouse's current X,Y position 95 | GetCursorPos(mousePos); 96 | 97 | // If our cursor is still in the middle, we never moved... so don't update the screen 98 | if (mousePos.x = middleX) AND (mousePos.y = middleY) then 99 | exit; 100 | 101 | // Set the mouse position to the middle of our window 102 | SetCursorPos(middleX, middleY); 103 | 104 | // Get the direction the mouse moved in, but bring the number down to a reasonable amount 105 | rotateY := (middleX - mousePos.x)/500; 106 | deltaY := (middleY - mousePos.y)/1000; 107 | 108 | // Multiply the direction vVector for Y by an acceleration (The higher the faster is goes). 109 | View[2] := View[2] + deltaY*5; 110 | 111 | // Check if the distance of our view exceeds 60 from our position, if so, stop it. (UP) 112 | if View[2] - Position[2] > 10 then 113 | View[2] := Position[2] + 10; 114 | 115 | // Check if the distance of our view exceeds -60 from our position, if so, stop it. (DOWN) 116 | if View[2] - Position[2] < -10 then 117 | View[2] := Position[2] - 10; 118 | 119 | // Here we rotate the view along the X avis depending on the direction (Left of Right) 120 | RotateView(0, rotateY, 0); 121 | end; 122 | 123 | 124 | 125 | 126 | {---------------------------------------------------------------------} 127 | {--- This strafes the camera left and right depending on the speed ---} 128 | {---------------------------------------------------------------------} 129 | procedure TCamera.StrafeCamera(speed: glFloat); 130 | var Cross, ViewVector : TVector3f; 131 | begin 132 | // Initialize a variable for the cross product result 133 | Cross[0] :=0; 134 | Cross[2] :=0; 135 | Cross[1] :=0; 136 | 137 | // Get the view vVector of our camera and store it in a local variable 138 | ViewVector[0] := View[0] - Position[0]; 139 | ViewVector[2] := View[2] - Position[2]; 140 | ViewVector[1] := View[1] - Position[1]; 141 | 142 | // Calculate the cross product of our up vVector and view vVector 143 | Cross[0] := (UpVector[2] * ViewVector[1]) - (UpVector[1] * ViewVector[2]); // (V1[2] * V2[1]) - (V1[1] * V2[2]) 144 | Cross[2] := (UpVector[1] * ViewVector[0]) - (UpVector[0] * ViewVector[1]); // (V1[1] * V2[0]) - (V1[0] * V2[1]) 145 | Cross[1] := (UpVector[0] * ViewVector[2]) - (UpVector[2] * ViewVector[0]); // (V1[0] * V2[2]) - (V1[2] * V2[0]) 146 | 147 | // Add the resultant vVector to our position 148 | Position[0] := Position[0] + Cross[0] * speed; 149 | Position[1] := Position[1] + Cross[1] * speed; 150 | 151 | // Add the resultant vVector to our view 152 | View[0] := View[0] + Cross[0] * speed; 153 | View[1] := View[1] + Cross[1] * speed; 154 | end; 155 | 156 | 157 | {-----------------------------------------------------------} 158 | {--- This rotates the view around the position ---} 159 | {-----------------------------------------------------------} 160 | procedure TCamera.RotateView(const X, Y, Z: glFloat); 161 | var vVector : TVector3f; 162 | begin 163 | // Get our view vVector (The direction we are facing) 164 | vVector[0] := View[0] - Position[0]; // This gets the direction of the X 165 | vVector[2] := View[2] - Position[2]; // This gets the direction of the Y 166 | vVector[1] := View[1] - Position[1]; // This gets the direction of the Z 167 | 168 | // If we pass in a negative X Y or Z, it will rotate the opposite way, 169 | // so we only need one function for a left and right, up or down rotation. 170 | if X <> 0 then 171 | begin 172 | View[1] := Position[1] + sin(X)*vVector[2] + cos(X)*vVector[1]; 173 | View[2] := Position[2] + cos(X)*vVector[2] - sin(X)*vVector[1]; 174 | end; 175 | 176 | if Y <> 0 then 177 | begin 178 | View[1] := Position[1] + sin(Y)*vVector[0] + cos(Y)*vVector[1]; 179 | View[0] := Position[0] + cos(Y)*vVector[0] - sin(Y)*vVector[1]; 180 | end; 181 | 182 | if Z <> 0 then 183 | begin 184 | View[0] := Position[0] + sin(Z)*vVector[2] + cos(Z)*vVector[0]; 185 | View[2] := Position[2] + cos(Z)*vVector[2] - sin(Z)*vVector[0] 186 | end; 187 | end; 188 | 189 | 190 | {-------------------------------------------------------------} 191 | {--- This rotates the camera position around a given point ---} 192 | {-------------------------------------------------------------} 193 | procedure TCamera.RotateAroundPoint(const Center: TVector3f; const X, Y, Z: glFloat); 194 | var viewVector : TVector3f; 195 | begin 196 | // Get the viewVector from our position to the center we are rotating around 197 | viewVector[0] := Position[0] - Center[0]; // This gets the direction of the X 198 | viewVector[2] := Position[2] - Center[2]; // This gets the direction of the Y 199 | viewVector[1] := Position[1] - Center[1]; // This gets the direction of the Z 200 | 201 | // Rotate the position up or down, then add it to the center point 202 | if X <> 0 then 203 | begin 204 | Position[1] := Center[1] + sin(X)*viewVector[2] + cos(X)*viewVector[1]; 205 | Position[2] := Center[2] + cos(X)*viewVector[2] - sin(X)*viewVector[1]; 206 | end; 207 | 208 | if Y <> 0 then 209 | begin 210 | Position[1] := Center[1] + sin(Y)*viewVector[0] + cos(Y)*viewVector[1]; 211 | Position[0] := Center[0] + cos(Y)*viewVector[0] - sin(Y)*viewVector[1]; 212 | end; 213 | 214 | if Z <> 0 then 215 | begin 216 | Position[0] := Center[0] + sin(Z)*viewVector[2] + cos(Z)*viewVector[0]; 217 | Position[2] := Center[2] + cos(Z)*viewVector[2] - sin(Z)*viewVector[0] 218 | end; 219 | end; 220 | 221 | function vectordirection(const v1: TVector3f): single; 222 | begin 223 | if ((v1[0] = 0) and (v1[1] < 0)) then 224 | Result := 270 225 | else 226 | if ((v1[0] = 0) and (v1[1] > 0)) then 227 | Result := 90 228 | else 229 | if ((v1[0] > 0) and (v1[1] >= 0)) then 230 | Result := (ArcTan(v1[1] / v1[0]) * fradtodeg) 231 | else 232 | if ((v1[0] < 0) and (v1[1] > 0)) then 233 | Result := 180 - (ArcTan(v1[1] / Abs(v1[0])) * fradtodeg) 234 | else 235 | if ((v1[0] < 0) and (v1[1] <= 0)) then 236 | Result := 180 + (ArcTan(v1[1] / v1[0]) * fradtodeg) 237 | else 238 | if ((v1[0] > 0) and (v1[1] < 0)) then 239 | Result := 360 - (ArcTan(Abs(v1[1]) / v1[0]) * fradtodeg) 240 | else 241 | Result := 0; 242 | end; 243 | 244 | function TCamera.getheading: single; 245 | var 246 | tmp: TVector3f; 247 | begin 248 | tmp[0] := view[0] - position[0]; 249 | tmp[1] := view[1] - position[1]; 250 | tmp[2] := view[2] - position[2]; 251 | 252 | Result := degtorad(vectordirection(tmp)); 253 | 254 | {if ((tmp.x = 0) and (tmp.y < 0)) then Result:= 270 else 255 | if ((tmp.x = 0) and (tmp.y > 0)) then Result:= 90 else 256 | if ((tmp.x > 0) and (tmp.y >= 0)) then Result:= (ArcTan(tmp.y / tmp.x) * fradtodeg) else 257 | if ((tmp.x < 0) And (tmp.y > 0)) then Result:= 180 - (ArcTan(tmp.y / Abs(tmp.x)) * fradtodeg) else 258 | if ((tmp.x < 0) And (tmp.y <= 0)) then Result:= 180 + (ArcTan(tmp.y / tmp.x) * fradtodeg) else 259 | if ((tmp.x > 0) and (tmp.y < 0)) then Result:= 360 - (ArcTan(Abs(tmp.y) / tmp.x) * fradtodeg) else 260 | Result:=0; } 261 | end; 262 | 263 | constructor TCamera.Create(); 264 | begin 265 | 266 | //is_ortho:= true; //todo: test 267 | 268 | fovy:= 45.0; 269 | //aspect:= 270 | zNear:= 0.2; 271 | zFar:= 10000.0; 272 | 273 | end; 274 | 275 | end. 276 | -------------------------------------------------------------------------------- /ColObject.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/ColObject.pas -------------------------------------------------------------------------------- /EliRT.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/EliRT.obj -------------------------------------------------------------------------------- /FrustumCulling.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/FrustumCulling.pas -------------------------------------------------------------------------------- /Geometry.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/Geometry.pas -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # samp-map-editor 2 | Sa-mp map editor 3 | -------------------------------------------------------------------------------- /Struct/ColObject.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/Struct/ColObject.pas -------------------------------------------------------------------------------- /Struct/GTADLL.PAS: -------------------------------------------------------------------------------- 1 | unit gtadll; 2 | 3 | interface 4 | 5 | const 6 | gtainterface = 'gtainterface.dll'; 7 | 8 | // IMG utils 9 | 10 | type 11 | Tdirentry = packed record 12 | startblock: Longword; 13 | sizeblocks: Longword; 14 | Name: array[0..23] of char; // null terminated, there is possible garbage after the null terminator 15 | end; // 32 bytes 16 | 17 | Tdefragcallbackproc = procedure(const txt: pchar); stdcall; 18 | 19 | function IMGLoadImg(const filename: pchar): integer; stdcall; external gtainterface; // loads a img file, must be called before anything else 20 | 21 | function IMGISV2: boolean; stdcall; external gtainterface; // tells you the img format version. 22 | 23 | procedure IMGReDoDir; stdcall; external gtainterface; // recreates the img directory, neccesary by some functions 24 | 25 | procedure IMGDelete(const index: integer); stdcall; external gtainterface; // removes the file from the directory and updates the directory 26 | procedure IMGRemoveFile(const index: integer); stdcall; external gtainterface; // use if you have to remove several files at once, after you are done you must call IMGReDoDir otherwise img's directory is not updated. 27 | procedure IMGReplaceFile(const index: integer; const filen: pchar; ForceToEnd: boolean); stdcall; external gtainterface; // replaces file with another bigger or smaller file, bigger files will be written at the end of img but the directory will stay on same place 28 | Procedure IMGAddFile(const filename: pchar); stdcall; external gtainterface; 29 | procedure IMGExportFile(const index: integer; const filen: pchar); stdcall; external gtainterface; // exports a file to disk 30 | procedure IMGExportBuffer(const index: integer; buffer: pointer); stdcall; external gtainterface; // exports a file to buffer 31 | 32 | // returns img directory file count 33 | function IMGFileCount: integer; stdcall; external gtainterface; 34 | 35 | function IMGGetFileName(const index: integer): pchar; stdcall; external gtainterface; 36 | 37 | // retrieves / sets the file dir record for any file, use this to list / rename files in your apps. 38 | function IMGGetThisFile(const index: integer): Tdirentry; stdcall; external gtainterface; 39 | procedure IMGSetThisFile(const index: integer; const dir: Tdirentry); stdcall; external gtainterface; // after you call this 40 | 41 | // writes / read data ftom / to img file at any file offset, application is responsible for alocating buffer memory 42 | // the dll will only read it, you can also write beyond file end 43 | procedure IMGReadBuffer(buffer: pchar; buffsize, fileofs: longword); stdcall; external gtainterface; 44 | procedure IMGWriteBuffer(buffer: pchar; buffsize, fileofs: longword); stdcall; external gtainterface; 45 | 46 | // fragmenter / defragmenter functions 47 | function IMGHowMuchFragmented: integer; stdcall; external gtainterface; 48 | 49 | procedure IMGDefrag(callback: Tdefragcallbackproc); stdcall; external gtainterface; 50 | 51 | // IDE utils 52 | 53 | // RWstrean utils 54 | 55 | // TXD utils 56 | 57 | implementation 58 | 59 | end. -------------------------------------------------------------------------------- /Struct/RenderWareDFF.pas: -------------------------------------------------------------------------------- 1 | // Written by KCow (Alastair Burr) as part of moomapper. 2 | 3 | unit RenderWareDFF; 4 | 5 | interface 6 | 7 | uses 8 | Classes, Controls, Dialogs, 9 | ExtCtrls, Forms, Graphics, Messages, OpenGL12, rwtxd, StdCtrls, SysUtils, vectortypes, Windows; 10 | 11 | const 12 | // sections 13 | rwDATA = 1; 14 | rwSTRING = 2; 15 | rwEXTENSION = 3; 16 | rwTEXTURE = 6; 17 | rwMATERIALLIST = 8; 18 | rwMATERIAL = 7; 19 | rwFRAMELIST = 14; 20 | rwGEOMETRY = 15; 21 | rwCLUMP = 16; 22 | rwATOMIC = 20; 23 | rwGEOMETRYLIST = 26; 24 | rwAnimPlugin = 286; 25 | rwMATERIALEFFECTS = 288; // xvehicleenv128 26 | rwMATERIALSPLIT = 1294; // bin mesh plg 27 | rwFRAME = $253F2FE; 28 | nvcolors = $253F2F9; 29 | 30 | // constants for geometry data 31 | rwOBJECT_VERTEX_TRISTRIP = $1; 32 | rwOBJECT_VERTEX_POSITIONS = $2; 33 | rwOBJECT_VERTEX_UV = $4; 34 | rwOBJECT_VERTEX_COLOR = $8; 35 | rwOBJECT_VERTEX_NORMAL = $10; 36 | rwOBJECT_VERTEX_LIGHT = $20; 37 | rwOBJECT_VERTEX_MODULATE = $40; 38 | rwOBJECT_VERTEX_TEXTURED = $80; 39 | 40 | // rockstar north extensions 41 | rnmultitexturespeca = $253F2F6; 42 | col3 = $253F2FA; 43 | particles = $253F2F8; 44 | 45 | 46 | type 47 | TVector3i = array [0..2] of longint; 48 | // TVector3f = array [0..2] of Single; 49 | //TMatrix3f = array [0..2] of TVector3f; 50 | TMatrix3f = array [0..2, 0..2] of single;//TVector3f; 51 | 52 | TMatrix4f = array [0..3, 0..3] of single;//TVector4f; 53 | 54 | // big part collision info here is based on research of Steve M and Kam. 55 | TVector3W = array [0..2] of word; // float:= vector[n] / 128; 56 | 57 | Tcollbox = packed record 58 | box_min, box_max: TVector3f; 59 | end; 60 | 61 | Tcollsphere = packed record 62 | sphere_center: TVector3f; 63 | sphere_radius: single; 64 | SurfaceA, SurfaceB: word; 65 | end; // 40 bytes needed 66 | 67 | Tcolface = packed record 68 | A, B, C: word; 69 | SurfaceA, SurfaceB: word; 70 | end; 71 | 72 | Tcollisionmodel = packed record 73 | col3: array[0..3] of char; 74 | size: longword; 75 | Name: array[0..23] of char; 76 | box_min, box_max, sphere_center: TVector3f; 77 | sphere_radius: single; 78 | Spherec: byte; 79 | a: array[0..3] of byte; // wtf. 80 | ColFacec, 81 | LW12, 82 | OFSspheres, 83 | LW0_0, 84 | LW0_1, 85 | OFS_VERT, 86 | OFS_Faces, 87 | LW0_2, 88 | ShadowFacec, 89 | OFSShadowvert, 90 | OFSShadowFace: longword; 91 | 92 | Dspheres: array of Tcollsphere; 93 | 94 | // collision mesh 95 | ColVerts: array of TVector3W; 96 | ColFaces: array of Tcolface; 97 | 98 | ColShadeVerts: array of TVector3W; 99 | ColShadeFaces: array of Tcolface; 100 | 101 | end; // 120 bytes 102 | 103 | TDFFFace = record 104 | V2: word; 105 | V1: word; 106 | material: word; 107 | V3: word; 108 | end; 109 | 110 | TDFFUV = record 111 | U, V: single; 112 | end; 113 | 114 | TDFFUVMAP = array of TDFFUV; 115 | 116 | TDFFFrame = record 117 | Name: string; 118 | 119 | matrix4: TMatrix4f; 120 | 121 | Matrix: TMatrix3f; 122 | Coord: TVector3f; 123 | 124 | Parent: longint; 125 | Other1, Other2: word; 126 | internaldata: pointer; // used by GGMM 127 | end; 128 | 129 | // data parts 130 | 131 | TDFFDataClump = record 132 | ObjectCount: longword; 133 | end; 134 | 135 | TDFFDataFrameList = record 136 | FrameCount: longword; 137 | Frame: array of TDFFFrame; 138 | end; 139 | 140 | TDFFDataGeometryList = record 141 | GeometryCount: longword; 142 | end; 143 | 144 | TDFFDataAtomic = record 145 | FrameNum: longword; 146 | GeometryNum: longword; 147 | Other1: longword; //D: 5 148 | Other2: longword; //D: 0 149 | end; 150 | 151 | TDFFHeaderDataGeometry = record 152 | Flags: word; 153 | UVmaps, unknown: byte; 154 | 155 | TriangleCount: longword; 156 | VertexCount: longword; 157 | MorphCount: longword; // was OtherCount 158 | end; 159 | 160 | TDFFLightHeaderDataGeometry = record 161 | Ambient: single; 162 | Diffuse: single; 163 | Specular: single; 164 | end; 165 | 166 | TDFFDataGeometryBoundingSphere = record 167 | boundingsphere: TVector3f; 168 | BoundingRadius: single; 169 | Other1, Other2: longword; //D: 1 170 | end; 171 | 172 | TDFFDataGeometry = record 173 | Header: TDFFHeaderDataGeometry; 174 | 175 | LightHeader: TDFFLightHeaderDataGeometry; 176 | 177 | VertexColors: array of longword; 178 | NightColors: array of longword; 179 | 180 | UVmaps: array of TDFFUVMAP; 181 | 182 | Face: array of TDFFFace; 183 | 184 | BoundingSphere: TDFFDataGeometryBoundingSphere; 185 | 186 | Vertex: array of TVector3f; 187 | 188 | Normal: array of TVector3f; 189 | end; 190 | 191 | TDFFDataMaterialList = record 192 | MaterialCount: longword; 193 | Other: longword; //D: FF 194 | end; 195 | 196 | TDFFColor = packed array[0..4] of byte; 197 | 198 | TDFFDataMaterial = packed record 199 | Other1: longword; //D: 0 // alpha params? 200 | Color: TDFFColor; 201 | Other3: longword; 202 | TextureCount: longword; //D: 1 203 | 204 | Other5: single; //D: 1.0 // shine? 205 | Other6: single; // size? 206 | Other7: single; //D: 1.0 // opacity? 207 | end; 208 | 209 | TDFFDataTexture = record 210 | end; 211 | 212 | // level 5 213 | 214 | TDFFExtensionTexture = record 215 | Data: array[0..59] of byte; 216 | x: array[0..47] of char; 217 | end; 218 | 219 | TDFFTextureMatPlugin = packed record 220 | lw2a: longword; 221 | lw2b: longword; 222 | flags: longword; 223 | lw0a: longword; 224 | 225 | stuff: array[0..31] of byte; 226 | maptype: longword; // 16 = san andreas xvehicleenv (second uv map thing), 20 = sphere mapping (like chrome) 227 | FFFFthing: longword; 228 | vehicleenv: array[0..15] of char; 229 | morestuff: array[0..300] of byte; 230 | 231 | // no speca: 232 | // 2 233 | // 2 234 | // 0 235 | // 0 236 | // 0 237 | // 0 238 | 239 | // with speca: 240 | // 2 241 | // 2 242 | // bit flags? (1065353216) (-------- -------- *------- --******) 243 | // 0 244 | // 1 245 | // 6 246 | // 72 -> some kind of section size indicator, add to position 4 bytes (data seem to belong to this header) and the data size will be at this number + 8 247 | // FF FF 03 18 248 | // 1 249 | // 4 250 | // FF FF 03 18 251 | // flags (69894) 252 | // 2 253 | // 1 254 | // FF FF 03 18 255 | // 26 bytes text padded with zeroes to 4 byte alignment (xvehicleenv128) 256 | // 2 257 | // 4 258 | // FF FF 03 18 259 | // 0 260 | // 3 261 | // 0 262 | // FF FF 03 18 263 | // 0 264 | 265 | // ..up to 288 bytes of garbage.. 266 | end; 267 | 268 | TDFFTexture = record 269 | Data: TDFFDataTexture; 270 | Name: string; 271 | Desc: string; 272 | GotName: boolean; 273 | 274 | // delfi's hack for san andreas reflections 275 | speca: array[0..255] of char; 276 | 277 | matpluginsize: integer; 278 | 279 | matplugin: TDFFTextureMatPlugin; 280 | 281 | // Extension: TDFFExtensionTexture; 282 | end; 283 | 284 | // level 4 285 | 286 | TDFFMaterial = record 287 | Data: TDFFDataMaterial; 288 | _test_Offset: integer; 289 | Texture: TDFFTexture; 290 | //Extension: TDFFExtensionMaterial; 291 | end; 292 | 293 | // level 3 294 | 295 | TDFFHeaderMaterialSplit = record 296 | TriagleFormat: longword; // 0 = triangles, 1= trianglestrip 297 | SplitCount: longword; 298 | FaceCount: longword; 299 | end; 300 | 301 | TDFFSplit = record 302 | FaceIndex: longword; 303 | MaterialIndex: longword; 304 | 305 | Index: array of longword; 306 | end; 307 | 308 | TDFFMaterialSplit = record 309 | Header: TDFFHeaderMaterialSplit; 310 | Split: array of TDFFSplit; 311 | end; 312 | 313 | TDFFMaterialList = record 314 | Data: TDFFDataMaterialList; 315 | Material: array of TDFFMaterial; 316 | MaterialCount: word; 317 | end; 318 | 319 | // level 2 320 | 321 | Tparticleemitter = packed record 322 | entrytype: longword; 323 | Position: TVector3f; 324 | fuckknows: longword; 325 | particlenamebufflen: longword; 326 | particlename: string[24]; 327 | end; 328 | 329 | 330 | TDFFGeometry = record 331 | Data: TDFFDataGeometry; 332 | MaterialList: TDFFMaterialList; 333 | MaterialSplit: TDFFMaterialSplit; 334 | pems: array of Tparticleemitter; 335 | end; 336 | 337 | // level 1 338 | 339 | TDFFFrameList = record 340 | Data: TDFFDataFrameList; 341 | end; 342 | 343 | TDFFGeometryList = record 344 | Data: TDFFDataGeometryList; 345 | Geometry: array of TDFFGeometry; 346 | GeometryCount: longword; 347 | end; 348 | 349 | TDFFAtomic = record 350 | Data: TDFFDataAtomic; 351 | //Extension: TDFFExtensionAtomic; 352 | end; 353 | 354 | // level 0 355 | TDFFClump = record 356 | Data: TDFFDataClump; 357 | FrameList: TDFFFrameList; 358 | GeometryList: TDFFGeometryList; 359 | Atomic: array of TDFFAtomic; 360 | AtomicCount: word; 361 | col3: TMemorystream; 362 | // col3: Tcollisionmodel; 363 | RadiusSphere: single; 364 | end; 365 | 366 | // header 367 | 368 | TDFFHeader = record 369 | Start: longword; 370 | Back: longword; 371 | 372 | Tag: longword; 373 | Size: longword; 374 | renderversion: longword; 375 | // Data: Word; //D: 784 376 | // Version: Word; 377 | end; 378 | 379 | TDffLoader = class 380 | private 381 | function GetNextHeader(Stream: TStream; Level, Parent: longint): TDFFHeader; 382 | procedure ParseData(Stream: TStream; ParseHeader: TDFFHeader; Parent: longint); 383 | procedure ParseMaterialSplit(Stream: TStream; ParseHeader: TDFFHeader; Parent: longint); 384 | procedure ParseHeaders(Stream: TStream; ParseHeader: TDFFHeader; Level, Parent: longint); 385 | procedure ParseString(Stream: TStream; ParseHeader: TDFFHeader; Level, Parent: longint); 386 | public 387 | Clump: array of TDFFClump; 388 | FrameUpTo: longint; 389 | lastofs: integer; 390 | loaded: boolean; 391 | filenint: string; 392 | DLID: longword; 393 | wheelrenders: boolean; 394 | used: boolean; 395 | primcolor: Tcolor; 396 | seccolor: Tcolor; 397 | procedure ResetClump; 398 | procedure LoadFromFile(FileName: string); 399 | procedure LoadFromStream(Stream: TStream); 400 | procedure DropDL; 401 | procedure Unload; 402 | 403 | procedure glDraw(texture: Ttxdloader; sectexture: Ttxdloader; texreportonly: boolean; highlight: integer; nightcolors: boolean; plzdontinstance: boolean); 404 | procedure glDrawRecurse(in_clump: longword; in_frame: longint; texture: Ttxdloader; sectexture: Ttxdloader; TheParent: boolean; texreportonly: boolean; highlight: integer; nightcolors: boolean; plzdontinstance: boolean); 405 | procedure renderawheel(parent: string; texture: Ttxdloader; sectexture: Ttxdloader; plzdontinstance: boolean); 406 | end; 407 | 408 | var 409 | GTA_TEXTURE_MODE: boolean = False; 410 | 411 | implementation 412 | 413 | {$IFDEF map_editor} 414 | uses u_edit; 415 | {$ENDIF} 416 | 417 | function min(a, b: single): single; 418 | begin 419 | result:= a; 420 | if b < a then result:= b; 421 | end; 422 | 423 | function max(a, b: single): single; 424 | begin 425 | result:= a; 426 | if b > a then result:= b; 427 | end; 428 | 429 | function isprim(col: TDFFColor): boolean; 430 | begin 431 | Result := False; 432 | if col[0] = 60 then 433 | if col[1] = 255 then 434 | if col[2] = 0 then 435 | if col[3] = 255 then 436 | Result := True; 437 | end; 438 | 439 | function isterc(col: TDFFColor): boolean; 440 | begin 441 | Result := False; 442 | if col[0] = 0 then 443 | if col[1] = 255 then 444 | if col[2] = 255 then 445 | Result := True; 446 | end; 447 | 448 | function islightcolor(col: TDFFColor): boolean; 449 | begin 450 | Result := False; 451 | // for lights alpha is not important at all, just a RGB match is enough 452 | if col[0] = 255 then 453 | if col[1] = 175 then 454 | if col[2] = 0 then 455 | Result := True; // left front 456 | if col[0] = 0 then 457 | if col[1] = 255 then 458 | if col[2] = 200 then 459 | Result := True; // right front 460 | if col[0] = 185 then 461 | if col[1] = 255 then 462 | if col[2] = 200 then 463 | Result := True; // right front (COPCARRU BUG?) 464 | if col[0] = 255 then 465 | if col[1] = 0 then 466 | if col[2] = 175 then 467 | Result := True; // ? 468 | if col[0] = 255 then 469 | if col[1] = 0 then 470 | if col[2] = 175 then 471 | if col[3] = 255 then 472 | Result := True; // ? 473 | end; 474 | 475 | function issec(col: TDFFColor): boolean; 476 | begin 477 | Result := False; 478 | if col[0] = 255 then 479 | if col[1] = 0 then 480 | if col[2] = 175 then 481 | if col[3] = 255 then 482 | Result := True; 483 | end; 484 | 485 | function GetRWVersion(ver: cardinal): cardinal; // Steve M. 486 | var 487 | b: byte; 488 | begin 489 | b := ver shr 24; 490 | Result := (3 + b shr 6) shl 16 + ((b shr 2) and $0F) shl 12 + (b and $03) shl 8 + byte(ver shr 16); 491 | end; 492 | 493 | function DecompressVector(v: TVector3W): TVector3F; // Steve M. 494 | begin 495 | Result[0] := (smallint(v[0]) / 128); 496 | Result[1] := (smallint(v[1]) / 128); 497 | Result[2] := (smallint(v[2]) / 128); 498 | end; 499 | 500 | procedure TDffLoader.ResetClump; 501 | var 502 | i: integer; 503 | begin 504 | for i := 0 to High(Clump) do 505 | begin 506 | SetLength(Clump[i].Atomic, 0); 507 | SetLength(Clump[i].GeometryList.Geometry, 0); 508 | SetLength(Clump[i].FrameList.Data.Frame, 0); 509 | end; 510 | Clump := nil; 511 | end; 512 | 513 | procedure TDffLoader.LoadFromStream(Stream: TStream); 514 | var 515 | MainHeader: TDFFHeader; 516 | begin 517 | ResetClump; 518 | MainHeader.Start := 16; 519 | MainHeader.Tag := 0; 520 | MainHeader.Size := Stream.Size; 521 | MainHeader.renderversion := 0;//Data := 0; 522 | // MainHeader.Version := 0; 523 | MainHeader.Back := 0; 524 | loaded := False; 525 | wheelrenders:= false; 526 | 527 | ParseHeaders(Stream, MainHeader, 0, 16); 528 | loaded := True; 529 | 530 | // lastofs:= stream.position; 531 | end; 532 | 533 | procedure TDffLoader.LoadFromFile(FileName: string); 534 | var 535 | Stream: Tmemorystream; 536 | begin 537 | DLID := 0; 538 | Stream := Tmemorystream.Create; 539 | filenint := filename; 540 | stream.loadfromfile(FileName); 541 | // application.processmessages; 542 | LoadFromStream(Stream); 543 | // application.processmessages; 544 | Stream.Free; 545 | end; 546 | 547 | procedure TDffLoader.ParseMaterialSplit(Stream: TStream; ParseHeader: TDFFHeader; Parent: longint); 548 | var 549 | I: longint; 550 | begin 551 | with Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].MaterialSplit do 552 | begin 553 | // ShowMessage(IntToStr(Stream.Position)); 554 | Stream.Read(Header, SizeOf(Header)); 555 | 556 | SetLength(Split, Header.SplitCount); 557 | 558 | for I := 0 to Header.SplitCount - 1 do 559 | begin 560 | Stream.Read(Split[I].FaceIndex, 4); 561 | Stream.Read(Split[I].MaterialIndex, 4); 562 | 563 | SetLength(Split[I].Index, Split[I].FaceIndex); 564 | Stream.Read(Split[I].Index[0], 4 * Split[I].FaceIndex); 565 | end; 566 | end; 567 | end; 568 | 569 | procedure TDffLoader.ParseData(Stream: TStream; ParseHeader: TDFFHeader; Parent: longint); 570 | var 571 | I, J, fix: longword; 572 | f: file; 573 | c: integer; 574 | begin 575 | 576 | case Parent of 577 | 578 | rwCLUMP: 579 | begin 580 | Stream.Read(Clump[High(Clump)].Data.ObjectCount, 4); 581 | end; 582 | 583 | rwMATERIALLIST: 584 | begin 585 | with Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].MaterialList.Data do 586 | begin 587 | Stream.Read(MaterialCount, 4); 588 | Stream.Read(Other, 4); 589 | end; 590 | end; 591 | 592 | rwMATERIAL: 593 | begin 594 | with Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].MaterialList.Material[Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].MaterialList.MaterialCount - 1] do 595 | begin 596 | Texture.GotName := False; 597 | _test_Offset := Stream.Position; 598 | //showmessage(inttostr(Stream.Position)); 599 | Stream.Read(Data, SizeOf(Data)); 600 | 601 | // output colors 602 | {// outputdebugstring( 603 | pchar( 604 | format('color: %d %d %d %d', [Data.Color[0], Data.Color[1], Data.Color[2], Data.Color[3] 605 | ]) 606 | ) 607 | );} 608 | end; 609 | end; 610 | 611 | rwGEOMETRYLIST: 612 | begin 613 | Stream.Read(Clump[High(Clump)].GeometryList.Data.GeometryCount, 4); 614 | end; 615 | 616 | rwATOMIC: 617 | begin 618 | with Clump[High(Clump)].Atomic[Clump[High(Clump)].AtomicCount - 1].Data do 619 | begin 620 | Stream.Read(FrameNum, 4); 621 | Stream.Read(GeometryNum, 4); 622 | Stream.Read(Other1, 4); 623 | Stream.Read(Other2, 4); 624 | end; 625 | end; 626 | 627 | rwFRAMELIST: 628 | begin 629 | with Clump[High(Clump)].FrameList.Data do 630 | begin 631 | Stream.Read(FrameCount, 4); 632 | SetLength(Frame, FrameCount); 633 | FrameUpTo := 0; 634 | 635 | for I := 0 to FrameCount - 1 do 636 | begin 637 | 638 | for J := 0 to 2 do 639 | begin 640 | Stream.Read(Frame[I].Matrix[J], 12); 641 | end; 642 | begin 643 | Stream.Read(Frame[I].Coord, 12); 644 | end; 645 | 646 | fillchar(Frame[I].Matrix4, sizeof(Frame[I].Matrix4), 0); 647 | 648 | Frame[I].Matrix4[0, 0] := 1; 649 | Frame[I].Matrix4[1, 1] := 1; 650 | Frame[I].Matrix4[2, 2] := 1; 651 | 652 | Frame[I].Matrix4[0, 0] := Frame[I].Matrix[0, 0]; 653 | Frame[I].Matrix4[0, 1] := Frame[I].Matrix[0, 1]; 654 | Frame[I].Matrix4[0, 2] := Frame[I].Matrix[0, 2]; 655 | 656 | Frame[I].Matrix4[1, 0] := Frame[I].Matrix[1, 0]; 657 | Frame[I].Matrix4[1, 1] := Frame[I].Matrix[1, 1]; 658 | Frame[I].Matrix4[1, 2] := Frame[I].Matrix[1, 2]; 659 | 660 | Frame[I].Matrix4[2, 0] := Frame[I].Matrix[2, 0]; 661 | Frame[I].Matrix4[2, 1] := Frame[I].Matrix[2, 1]; 662 | Frame[I].Matrix4[2, 2] := Frame[I].Matrix[2, 2]; 663 | 664 | Frame[I].Matrix4[3, 0] := frame[I].Coord[0]; 665 | Frame[I].Matrix4[3, 1] := frame[I].Coord[1]; 666 | Frame[I].Matrix4[3, 2] := frame[I].Coord[2]; 667 | 668 | Frame[I].Matrix4[3, 3] := 1; 669 | 670 | Stream.Read(Frame[I].Parent, 4); 671 | Stream.Read(Frame[I].Other1, 2); 672 | Stream.Read(Frame[I].Other2, 2); 673 | end; 674 | end; 675 | end; 676 | 677 | rwGEOMETRY: 678 | begin 679 | with Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].Data do 680 | begin 681 | 682 | fix := stream.position; 683 | 684 | Stream.Read(Header, SizeOf(Header)); 685 | 686 | // Scene colors only for RW versions before 3.4 (GTA3) 687 | if GetRWVersion(ParseHeader.renderversion) < $34000 then 688 | Stream.Read(LightHeader, SizeOf(LightHeader)) 689 | else 690 | FillChar(LightHeader, SizeOf(LightHeader), 0); 691 | 692 | // outputdebugstring(pchar('Start: ' + inttostr(fix))); 693 | // outputdebugstring(pchar('Flags: ' + inttostr(Header.Flags))); 694 | // outputdebugstring(pchar('UVmaps: ' + inttostr(Header.UVmaps))); 695 | // outputdebugstring(pchar('unknown: ' + inttostr(Header.unknown))); 696 | // outputdebugstring(pchar('TriangleCount: ' + inttostr(Header.TriangleCount))); 697 | // outputdebugstring(pchar('VertexCount: ' + inttostr(Header.VertexCount))); 698 | // outputdebugstring(pchar('MorphCount: ' + inttostr(Header.MorphCount))); 699 | 700 | { 701 | rwOBJECT_VERTEX_TRISTRIP = $1; 702 | rwOBJECT_VERTEX_POSITIONS = $2; 703 | rwOBJECT_VERTEX_UV = $4; 704 | rwOBJECT_VERTEX_COLOR = $8; 705 | rwOBJECT_VERTEX_NORMAL = $10; // 16 706 | rwOBJECT_VERTEX_LIGHT = $20; 707 | rwOBJECT_VERTEX_MODULATE = $40; 708 | rwOBJECT_VERTEX_TEXTURED = $80; 709 | } 710 | 711 | // read vertex colors 712 | if (rwOBJECT_VERTEX_COLOR and Header.Flags) = rwOBJECT_VERTEX_COLOR then 713 | begin 714 | // outputdebugstring('READING: VERTEX COLORS'); 715 | SetLength(VertexColors, Header.VertexCount); 716 | Stream.Read(Pointer(VertexColors)^, 4 * Header.VertexCount); 717 | end 718 | else 719 | SetLength(VertexColors, 0); 720 | 721 | // zmodeler2 compatibility - zmodeler2 doesn't set the flags properly. 722 | // we can aniway find if uv channels are present from uv channel count (as gta seem to do this as well) 723 | 724 | // if (rwOBJECT_VERTEX_UV and Header.Flags) = rwOBJECT_VERTEX_UV then 725 | // If ((Header.Flags and rwOBJECT_VERTEX_UV) <> 0) or ((Header.Flags and 128) <> 0) then 726 | // begin 727 | 728 | if header.UVmaps <> 0 then 729 | begin 730 | setlength(uvmaps, header.UVmaps); 731 | // outputdebugstring('READING: UV data'); 732 | 733 | for i := 0 to header.UVmaps - 1 do 734 | begin 735 | setlength(uvmaps[i], Header.VertexCount); 736 | Stream.Read(UVmaps[i][0], 8 * Header.VertexCount); 737 | end; 738 | end 739 | else 740 | SetLength(UVmaps, 0); 741 | 742 | { If ((Header.Flags and rwOBJECT_VERTEX_UV) <> 0) or ((Header.Flags and 128) <> 0) then 743 | begin 744 | SetLength(UV, Header.VertexCount); 745 | Stream.Read(UV[0], 8 * Header.VertexCount); // read first uv map 746 | 747 | if header.UVmaps = 2 then // read second uv map 748 | Stream.Read(UV2[0], 8 * Header.VertexCount); 749 | 750 | stream.Seek((8 * Header.VertexCount) * (header.UVmaps - 1), sofromcurrent); 751 | end else 752 | SetLength(UV, 0);} 753 | 754 | // outputdebugstring('READING: FACE INDICES'); 755 | SetLength(Face, Header.TriangleCount); 756 | Stream.Read(Pointer(Face)^, 8 * Header.TriangleCount); 757 | 758 | // outputdebugstring('READING: Bounding Sphere'); 759 | Stream.Read(BoundingSphere, SizeOf(BoundingSphere)); 760 | 761 | // outputdebugstring('READING: VERTICES'); 762 | SetLength(Vertex, Header.VertexCount); 763 | Stream.Read(Pointer(Vertex)^, 12 * Header.VertexCount); 764 | 765 | Clump[High(Clump)].RadiusSphere := 0; 766 | 767 | for c := 0 to high(Vertex) do 768 | begin 769 | if vertex[c][0] > Clump[High(Clump)].RadiusSphere then 770 | Clump[High(Clump)].RadiusSphere := vertex[c][0]; 771 | if vertex[c][1] > Clump[High(Clump)].RadiusSphere then 772 | Clump[High(Clump)].RadiusSphere := vertex[c][1]; 773 | if vertex[c][2] > Clump[High(Clump)].RadiusSphere then 774 | Clump[High(Clump)].RadiusSphere := vertex[c][2]; 775 | end; 776 | 777 | // Clump[High(Clump)].FrameList.Data.Frame[0].matrix4 778 | 779 | if (rwOBJECT_VERTEX_NORMAL and Header.Flags) = rwOBJECT_VERTEX_NORMAL then 780 | begin 781 | // outputdebugstring('READING: Normals'); 782 | SetLength(Normal, Header.VertexCount); 783 | Stream.Read(Pointer(Normal)^, 12 * Header.VertexCount); 784 | end 785 | else 786 | SetLength(Normal, 0); 787 | 788 | stream.position := fix + parseheader.Size; 789 | 790 | // outputdebugstring(pchar('Color: ' + inttostr(high(Color)))); 791 | // outputdebugstring(pchar('UVmaps: ' + inttostr(high(UVmaps)))); 792 | // outputdebugstring(pchar('Face: ' + inttostr(high(Face)))); 793 | // outputdebugstring(pchar('Vertex: ' + inttostr(high(Vertex)))); 794 | // outputdebugstring(pchar('Normal: ' + inttostr(high(Normal)))); 795 | 796 | end; 797 | end; 798 | end; 799 | end; 800 | 801 | procedure TDffLoader.ParseString(Stream: TStream; ParseHeader: TDFFHeader; Level, Parent: longint); 802 | var 803 | Buf: PChar; 804 | PreString: string; 805 | I: integer; 806 | begin 807 | PreString := ''; 808 | for I := 0 to Level do 809 | PreString := PreString + ' '; 810 | 811 | GetMem(Buf, ParseHeader.Size + 1); 812 | Buf[ParseHeader.Size] := #0; 813 | Stream.Read(Pointer(Buf)^, ParseHeader.Size); 814 | 815 | case Parent of 816 | 817 | rwTEXTURE: 818 | begin 819 | with Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].MaterialList.Material[Clump[High(Clump)].GeometryList.Geometry[Clump[High(Clump)].GeometryList.GeometryCount - 1].MaterialList.MaterialCount - 1].Texture do 820 | begin 821 | if GotName then 822 | Desc := Trim(Buf) 823 | else 824 | Name := Trim(Buf); 825 | GotName := True; 826 | end; 827 | end; 828 | 829 | rwFRAMELIST: 830 | begin 831 | Clump[High(Clump)].FrameList.Data.Frame[FrameUpTo].Name := Trim(Buf); 832 | Inc(FrameUpTo); 833 | end; 834 | end; 835 | 836 | FreeMem(Buf); 837 | end; 838 | 839 | procedure TDffLoader.ParseHeaders(Stream: TStream; ParseHeader: TDFFHeader; Level, Parent: longint); 840 | var 841 | InHeader: TDFFHeader; 842 | MoreData: boolean; 843 | pre: integer; 844 | i, j: integer; 845 | thisclump: integer; 846 | buffer: pchar; 847 | begin 848 | MoreData := True; 849 | thisclump:= High(Clump); 850 | 851 | while MoreData do 852 | begin 853 | InHeader := GetNextHeader(Stream, Level, Parent); 854 | 855 | // if length(Clump) = 1 then exit; 856 | 857 | if (InHeader.Tag = rwClump) then 858 | begin 859 | SetLength(Clump, Length(Clump) + 1); 860 | Level := 0; 861 | end; 862 | 863 | case InHeader.Tag of 864 | rwATOMIC: 865 | begin 866 | Inc(Clump[thisclump].AtomicCount); 867 | SetLength(Clump[thisclump].Atomic, Clump[thisclump].AtomicCount); 868 | FillChar(Clump[thisclump].Atomic[High(Clump[thisclump].Atomic)], SizeOf(TDFFAtomic), 0); 869 | end; 870 | rwGEOMETRY: 871 | begin 872 | Inc(Clump[thisclump].GeometryList.GeometryCount); 873 | SetLength(Clump[thisclump].GeometryList.Geometry, Clump[thisclump].GeometryList.GeometryCount); 874 | FillChar(Clump[thisclump].GeometryList.Geometry[High(Clump[thisclump].GeometryList.Geometry)], SizeOf(TDFFGeometry), 0); 875 | 876 | end; 877 | rwMATERIAL: 878 | begin 879 | Inc(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.MaterialCount); 880 | SetLength(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.Material, Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.MaterialCount); 881 | // read speca? 882 | 883 | // showmessage('found material extension at ' + inttostr(stream.position)); 884 | end; 885 | col3: 886 | begin 887 | 888 | pre := stream.position; 889 | 890 | Clump[thisclump].col3:= TMemoryStream.create; 891 | Clump[thisclump].col3.Size:= 0; 892 | Clump[thisclump].col3.CopyFrom(Stream, inheader.size); 893 | 894 | stream.position := pre; 895 | 896 | end; 897 | 898 | rnmultitexturespeca: 899 | begin 900 | pre := stream.position; 901 | stream.seek(4, sofromcurrent); // skip 4 bytes 902 | stream.Read( 903 | 904 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.Material[ 905 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.MaterialCount - 1 906 | ].Texture.speca 907 | 908 | , InHeader.Size - 4); 909 | stream.position := pre; 910 | end; 911 | rwMATERIALEFFECTS: 912 | begin 913 | 914 | pre := stream.position; 915 | stream.seek(4, sofromcurrent); // skip 4 bytes 916 | 917 | fillchar(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.Material[ 918 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.MaterialCount - 1 919 | ].Texture.matplugin, inheader.Size, 0); 920 | 921 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.Material[ 922 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.MaterialCount - 1 923 | ].Texture.matpluginsize := InHeader.Size; 924 | 925 | stream.Read( 926 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.Material[ 927 | Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].MaterialList.MaterialCount - 1 928 | ].Texture.matplugin 929 | , InHeader.Size); 930 | 931 | stream.position := pre; 932 | end; 933 | 934 | rwCLUMP: 935 | begin 936 | 937 | end; 938 | 939 | end; 940 | 941 | case InHeader.Tag of 942 | rwTEXTURE, 943 | rwMATERIALLIST, 944 | rwMATERIAL, 945 | rwCLUMP, 946 | rwFRAMELIST, 947 | rwGEOMETRYLIST, 948 | rwGEOMETRY, 949 | rwATOMIC: 950 | ParseHeaders(Stream, InHeader, Level + 1, InHeader.Tag); 951 | rwMATERIALSPLIT: 952 | ParseMaterialSplit(Stream, InHeader, Parent); 953 | 954 | particles: begin 955 | pre := stream.position; 956 | 957 | setlength(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].pems, InHeader.Size div 48); 958 | 959 | if length(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].pems) > 0 then 960 | for i:= 0 to high(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].pems) do begin 961 | stream.read(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].pems[i].entrytype, 48); 962 | //showmessage(Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].pems[i].particlename); 963 | end; 964 | 965 | stream.position := pre; 966 | end; 967 | rwDATA: 968 | begin 969 | // // outputdebugstring(pchar(inttostr(InHeader.Start))); 970 | try 971 | ParseData(Stream, InHeader, Parent); 972 | except 973 | end; 974 | end; 975 | rwEXTENSION: 976 | if (InHeader.Size > 0) then 977 | ParseHeaders(Stream, InHeader, Level + 1, Parent); 978 | rwFRAME,rwSTRING: 979 | ParseString(Stream, InHeader, Level + 1, Parent); 980 | // rwAnimPlugin: 981 | 982 | nvcolors: 983 | begin 984 | 985 | if length(Clump[thisclump].GeometryList.Geometry) > 0 then begin 986 | 987 | with Clump[thisclump].GeometryList.Geometry[Clump[thisclump].GeometryList.GeometryCount - 1].Data do 988 | begin 989 | SetLength(NightColors, Header.VertexCount); 990 | stream.seek(4, sofromcurrent); // skip 4 991 | Stream.Read(Pointer(NightColors)^, 4 * Header.VertexCount); 992 | end; 993 | 994 | end; 995 | 996 | end; 997 | else 998 | begin 999 | // showmessage(Self.filenint + #13 + inttostr(inheader.Tag) + #13 + ' @ ' + inttostr(stream.position) + ' size ' + inttostr(InHeader.Size)); 1000 | stream.seek(4, sofromcurrent); 1001 | stream.seek(InHeader.Size, sofromcurrent); 1002 | end; 1003 | 1004 | end; 1005 | 1006 | 1007 | 1008 | 1009 | { 1010 | $253F2F9: if (lvl>1) and (sec[lvl-1].ID=$03) and (sec[lvl-2].ID=$0F) then with Geometry[nGeometry] do begin // SA second vertex colors 1011 | $253F2FE: begin // Frame 1012 | $11E: begin // Bone 1013 | $50E: begin // Bin Mesh PLG 1014 | $510: if RWVer>=$36000 then begin // Native Data PLG (SA PS2, RW 3.5+) 1015 | } 1016 | 1017 | Stream.Seek(InHeader.Back + InHeader.Size, soFromBeginning); 1018 | 1019 | if (Stream.Position >= (ParseHeader.Back + ParseHeader.Size)) or (InHeader.Tag = 0) then 1020 | MoreData := False; 1021 | 1022 | end; 1023 | end; 1024 | 1025 | function TDffLoader.GetNextHeader(Stream: TStream; Level, Parent: longint): TDFFHeader; 1026 | var 1027 | OutHeader: TDFFHeader; 1028 | begin 1029 | with OutHeader do 1030 | begin 1031 | Start := Stream.position; 1032 | 1033 | Stream.Read(Tag, 4); 1034 | Stream.Read(Size, 4); 1035 | Stream.Read(renderversion, 4); //(Data, 2); 1036 | // Stream.Read(Version, 2); 1037 | Back := Stream.position; 1038 | end; 1039 | Result := OutHeader; 1040 | end; 1041 | 1042 | procedure Tdffloader.glDraw(texture: Ttxdloader; sectexture: Ttxdloader; texreportonly: boolean; highlight: integer; nightcolors: boolean; plzdontinstance: boolean); 1043 | var 1044 | J: longword; 1045 | 1046 | procedure makeinstance(highlight: integer); 1047 | var 1048 | I: longword; 1049 | begin 1050 | dlid := glGenLists(1); 1051 | glNewList(dlid, GL_COMPILE); 1052 | 1053 | if Clump <> nil then 1054 | if (Clump[0].FrameList.Data.FrameCount > 0) then 1055 | for I := 0 to Clump[0].FrameList.Data.FrameCount - 1 do 1056 | if (Clump[0].FrameList.Data.Frame[I].Parent = -1) then 1057 | glDrawRecurse(0, I, texture, sectexture, True, false, highlight, nightcolors, plzdontinstance); 1058 | 1059 | glEndList; 1060 | end; 1061 | 1062 | begin 1063 | 1064 | used:= true; 1065 | 1066 | {$IFDEF map_editor} 1067 | 1068 | if (DLID = 0) and (texreportonly = false) and (highlight <> hl_selected) then 1069 | begin 1070 | makeinstance(highlight); 1071 | end; 1072 | 1073 | if ((highlight = hl_normal) or (highlight = hl_novertexl)) and (texreportonly = false) and (plzdontinstance = false) then 1074 | begin 1075 | 1076 | if DLID <> 0 then 1077 | glCallList(dlid); 1078 | 1079 | end 1080 | else 1081 | begin 1082 | 1083 | if Clump <> nil then 1084 | if (Clump[0].FrameList.Data.FrameCount > 0) then 1085 | for J := 0 to Clump[0].FrameList.Data.FrameCount - 1 do 1086 | if (Clump[0].FrameList.Data.Frame[J].Parent = -1) then 1087 | glDrawRecurse(0, J, texture, sectexture, True, texreportonly, highlight, nightcolors, plzdontinstance); 1088 | 1089 | end; 1090 | 1091 | {$ENDIF} 1092 | 1093 | used:= false; 1094 | 1095 | end; 1096 | 1097 | procedure Tdffloader.glDrawRecurse(in_clump: longword; in_frame: longint; texture: Ttxdloader; sectexture: Ttxdloader; TheParent: boolean; texreportonly: boolean; highlight: integer; nightcolors: boolean; plzdontinstance: boolean); 1098 | var 1099 | I: integer; 1100 | Gn, OnC: longint; 1101 | N: array[0..15] of single; 1102 | UV, Alp: boolean; 1103 | ttex: gluint; 1104 | Normals: byte; 1105 | begin 1106 | 1107 | {$IFDEF map_editor} 1108 | 1109 | // filter out car lods. 1110 | if (lowercase(Clump[in_clump].FrameList.Data.Frame[in_frame].Name) <> '') then begin 1111 | if pos('_dam', lowercase(Clump[in_clump].FrameList.Data.Frame[in_frame].Name)) > 0 then exit; 1112 | if pos('_vlo', lowercase(Clump[in_clump].FrameList.Data.Frame[in_frame].Name)) > 0 then exit; 1113 | end; 1114 | 1115 | glPushMatrix; 1116 | 1117 | glColor4f(1.0, 1.0, 1.0, 1.0); 1118 | 1119 | Gn := -1; 1120 | if (Clump[in_clump].AtomicCount > 0) then 1121 | for I := 0 to Clump[in_clump].AtomicCount - 1 do 1122 | begin 1123 | if Clump[in_clump].Atomic[i].Data.FrameNum = longword(in_frame) then 1124 | Gn := Clump[in_clump].Atomic[i].Data.GeometryNum; 1125 | end; 1126 | 1127 | if wheelrenders = false then begin 1128 | 1129 | // multiply matrix if not root object 1130 | glMultMatrixf(@Clump[in_clump].FrameList.Data.Frame[in_frame].matrix4); 1131 | 1132 | if ((Clump[in_clump].FrameList.Data.Frame[in_frame].Name = 'wheel') or (Clump[in_clump].FrameList.Data.Frame[in_frame].Name = 'wheel2')) 1133 | and (Clump[in_clump].FrameList.Data.FrameCount > 5) // hack so we dont break modding wheels 1134 | then exit; 1135 | 1136 | if (pos('wheel_', Clump[in_clump].FrameList.Data.Frame[in_frame].Name) > 0) and (Clump[in_clump].FrameList.Data.FrameCount > 5) and ((Clump[in_clump].FrameList.Data.Frame[in_frame].Name <> 'wheel_front') and (Clump[in_clump].FrameList.Data.Frame[in_frame].Name <> 'wheel_rear')) then 1137 | begin 1138 | 1139 | // todo.. DON'T DO THIS ON BIKES!!!!!!!!!!!!! 1140 | 1141 | renderawheel(Clump[in_clump].FrameList.Data.Frame[in_frame].Name, texture, sectexture, plzdontinstance); 1142 | glpopmatrix; 1143 | exit; 1144 | end; 1145 | end else begin 1146 | 1147 | end; 1148 | 1149 | if (Gn < longint(Clump[in_clump].FrameList.Data.FrameCount)) and not (Gn = -1) then 1150 | begin 1151 | 1152 | // draw all frames 1153 | if True then 1154 | begin 1155 | 1156 | // draw object in local coordinate system 1157 | with Clump[in_clump].GeometryList.Geometry[Gn] do 1158 | begin 1159 | 1160 | UV := Length(Data.UVmaps) > 0; 1161 | for i := 0 to MaterialSplit.Header.SplitCount - 1 do 1162 | begin 1163 | 1164 | //u_edit.GtaEditor.Memo1.Lines.add(inttostr(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Other1)); 1165 | //u_edit.GtaEditor.Memo1.Lines.add(inttostr(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Other3)); 1166 | 1167 | if texreportonly = True then 1168 | begin 1169 | {$IFDEF map_editor} 1170 | // if MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Name <> '' then 1171 | gtaeditor.list_dfftextures.Lines.add(format('Material: %d split: %d Tex: %s', [ MaterialSplit.Split[i].MaterialIndex, i, MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Name ]) ); 1172 | // if MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Desc <> '' then 1173 | gtaeditor.list_dfftextures.Lines.add(format('Material: %d split: %d Alp: %s', [ MaterialSplit.Split[i].MaterialIndex, i, MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Name ]) ); 1174 | {$ENDIF} 1175 | end 1176 | else 1177 | begin 1178 | 1179 | gldisable(GL_TEXTURE_2D); 1180 | gldisable(GL_ALPHA_TEST); 1181 | 1182 | if MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Name <> '' then 1183 | begin 1184 | 1185 | glenable(gl_texture_2d); // got texture! 1186 | 1187 | if MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Desc <> '' then 1188 | begin 1189 | // got alpha! 1190 | glEnable(GL_BLEND); 1191 | glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); 1192 | glenable(GL_ALPHA_TEST); 1193 | glAlphaFunc(GL_GREATER, 0); 1194 | end; 1195 | end; 1196 | 1197 | if texture <> nil then 1198 | begin 1199 | glenable(GL_TEXTURE_2D); 1200 | ttex := texture.findglid(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Name); 1201 | 1202 | if ttex = 0 then // haven't found it.. look for more. 1203 | ttex := sectexture.findglid(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Texture.Name); 1204 | 1205 | glBindTexture(GL_TEXTURE_2D, ttex); 1206 | end; 1207 | 1208 | if isprim(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color) or isterc(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color) or islightcolor(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color) or issec(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color) 1209 | then begin 1210 | 1211 | if isprim(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color) = True then 1212 | glcolor3ubv(@primcolor) 1213 | else if issec(MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color) = True then 1214 | glcolor3ubv(@seccolor) 1215 | else 1216 | glColor4f(1,1,1,1) 1217 | 1218 | end else 1219 | glColor3ubv(@MaterialList.Material[MaterialSplit.Split[i].MaterialIndex].Data.Color); 1220 | 1221 | glEnableClientState(GL_VERTEX_ARRAY); 1222 | glVertexPointer(3, GL_FLOAT, 0, @Data.Vertex[0]); 1223 | 1224 | { 1225 | if Normals <> 0 then 1226 | begin 1227 | glEnableClientState(GL_NORMAL_ARRAY); 1228 | glNormalPointer(GL_FLOAT, 0, @Data.Normal[0]); 1229 | end else 1230 | glDisableClientState(GL_NORMAL_ARRAY); 1231 | } 1232 | if length(Data.UVmaps) > 0 then 1233 | begin 1234 | glEnableClientState(GL_TEXTURE_COORD_ARRAY); 1235 | glTexCoordPointer(2, GL_FLOAT, 0, @Data.UVmaps[0][0]); 1236 | end 1237 | else 1238 | glDisableClientState(GL_TEXTURE_COORD_ARRAY); 1239 | 1240 | if (highlight = hl_normal) then 1241 | begin 1242 | if length(Data.VertexColors) > 0 then 1243 | begin 1244 | glEnableClientState(GL_COLOR_ARRAY); 1245 | 1246 | if (length(Data.NightColors) <> length(Data.VertexColors)) then 1247 | nightcolors:= false; // precaution. 1248 | 1249 | if nightcolors = false then 1250 | glColorPointer(4, GL_UNSIGNED_BYTE, 0, @Data.VertexColors[0]) 1251 | else 1252 | glColorPointer(4, GL_UNSIGNED_BYTE, 0, @Data.NightColors[0]); 1253 | 1254 | end 1255 | else 1256 | glDisableClientState(GL_COLOR_ARRAY); 1257 | end 1258 | else 1259 | begin 1260 | glDisableClientState(GL_COLOR_ARRAY); 1261 | 1262 | if highlight = hl_selected then 1263 | glColor4f(1.0 - (sin(application.Tag * 0.1) * 0.1) , 0.0, 0.0, 1.0); 1264 | 1265 | if highlight = hl_novertexl then 1266 | glColor4f(1.0, 1.0, 1.0, 1.0); 1267 | end; 1268 | 1269 | 1270 | 1271 | if (MaterialSplit.Header.TriagleFormat = 0) then 1272 | glDrawElements(GL_TRIANGLES, High(MaterialSplit.Split[i].Index) + 1, GL_UNSIGNED_INT, @MaterialSplit.Split[i].Index[0]) 1273 | else 1274 | glDrawElements(GL_TRIANGLE_STRIP, High(MaterialSplit.Split[i].Index) + 1, GL_UNSIGNED_INT, @MaterialSplit.Split[i].Index[0]); 1275 | 1276 | end; 1277 | end; 1278 | 1279 | // experimental - particle emitters 1280 | 1281 | if length(Clump[in_clump].GeometryList.Geometry[Gn].pems) > 0 then 1282 | 1283 | for i:= 0 to high(Clump[in_clump].GeometryList.Geometry[Gn].pems) do begin 1284 | 1285 | if (Clump[in_clump].GeometryList.Geometry[Gn].pems[i].entrytype = 1) then begin 1286 | { 1287 | glDisable(GL_DEPTH_TEST); 1288 | gldisable(gl_texture_2d); 1289 | glpointsize(20); 1290 | glcolor4f(0, 0.5, 0.5, 1); 1291 | 1292 | glBegin(GL_POINTS); 1293 | glvertex3fv(@Clump[in_clump].GeometryList.Geometry[Gn].pems[i].Position); 1294 | glend; 1295 | glEnable(GL_DEPTH_TEST); 1296 | } 1297 | end; 1298 | end; 1299 | 1300 | end; 1301 | 1302 | end; 1303 | 1304 | end; 1305 | 1306 | // Draw all frames that has the current frame as parent.. 1307 | if (Clump[in_clump].FrameList.Data.FrameCount > 0) then 1308 | for Onc := 0 to Clump[in_clump].FrameList.Data.FrameCount - 1 do 1309 | begin 1310 | if (Clump[in_clump].FrameList.Data.Frame[Onc].Parent = in_frame) then 1311 | begin 1312 | I := Length(Clump[in_clump].FrameList.Data.Frame[Onc].Name); 1313 | if (I >= 3) then 1314 | begin 1315 | if (Clump[in_clump].FrameList.Data.Frame[Onc].Name[I - 2] = '_') and ((Clump[in_clump].FrameList.Data.Frame[Onc].Name[I - 1] = 'L') or (Clump[in_clump].FrameList.Data.Frame[Onc].Name[I - 1] = 'l')) then 1316 | begin 1317 | if (StrToIntDef(Clump[in_clump].FrameList.Data.Frame[Onc].Name[I], -1) <= 0) then 1318 | glDrawRecurse(in_clump, OnC, texture, sectexture, True, texreportonly, highlight, nightcolors, plzdontinstance); 1319 | end 1320 | else if not ((Clump[in_clump].FrameList.Data.Frame[Onc].Name[1] = 'C') and (Clump[in_clump].FrameList.Data.Frame[Onc].Name[2] = 'o') and (Clump[in_clump].FrameList.Data.Frame[Onc].Name[3] = 'l')) then 1321 | glDrawRecurse(in_clump, OnC, texture, sectexture, False, texreportonly, highlight, nightcolors, plzdontinstance); 1322 | end 1323 | else 1324 | glDrawRecurse(in_clump, OnC, texture, sectexture, False, texreportonly, highlight, nightcolors, plzdontinstance); 1325 | end; 1326 | end; 1327 | 1328 | // now pop the matrix, so we don't affect siblings 1329 | glPopMatrix; 1330 | {$ENDIF} 1331 | end; 1332 | 1333 | 1334 | procedure Tdffloader.Unload; 1335 | begin 1336 | DropDL(); 1337 | ResetClump; 1338 | end; 1339 | 1340 | procedure TDffLoader.DropDL; 1341 | begin 1342 | 1343 | if DLID <> 0 then 1344 | glDeleteLists(DLID, 1); 1345 | 1346 | end; 1347 | 1348 | procedure TDffLoader.renderawheel(parent: string; texture: Ttxdloader; sectexture: Ttxdloader; plzdontinstance: boolean); 1349 | var 1350 | i, y: integer; 1351 | wheelparent: integer; 1352 | wheelmodel: integer; 1353 | wantedmodel: string; 1354 | fi: boolean; 1355 | begin 1356 | {$IFDEF map_editor} 1357 | 1358 | // the IDE vehicle tire size or something? 1359 | // glTranslatef(0, 0, wheelzchange / 2); // -> looks bad (not really) 1360 | 1361 | if pos('dummy', parent) = 0 then 1362 | exit; // not a wheel dummy 1363 | 1364 | // workaround for san andreas tractor 1365 | { 1366 | if carclass = 531 then 1367 | if (pos('b', parent) <> 0) then 1368 | glscalef(2, 2, 2); 1369 | // and combine harvester 1370 | if carclass = 532 then 1371 | if (pos('m_', parent) <> 0) then 1372 | glscalef(2, 2, 2); 1373 | } 1374 | { 1375 | if (pos('_lf_', parent) <> 0) or (pos('_rf_', parent) <> 0) then 1376 | begin 1377 | glrotatef(180 + wnd_info.fronttireheading.position, 0, 0, 1); // i think that this the way game renders wheels, it doesn't work correctly for monster truck wheel grips 1378 | end; 1379 | } 1380 | if pos('wheel_l', parent) <> 0 then 1381 | begin // left wheels should be rotated / mirrored 1382 | glrotatef(180, 0, 0, 1); // i think that this the way game renders wheels, it doesn't work correctly for monster truck wheel grips 1383 | // if (animate = True) or (showanimate = True) then 1384 | // glrotatef(gettickcount div 5, 1, 0, 0); // rotate forward 1385 | end; 1386 | // else 1387 | // if (animate = True) or (showanimate = True) then 1388 | // glrotatef(gettickcount div 5, -1, 0, 0); // rotate into other direction 1389 | 1390 | 1391 | if (pos('steer', parent) = 0) then 1392 | begin // check for steeringwheel dummy in sa cars too, some ported cars may still have it... 1393 | 1394 | wheelrenders := True; 1395 | 1396 | // the wheel to render is object that its parent is 'wheel_rf_dummy' 1397 | 1398 | for i := 0 to clump[0].FrameList.Data.FrameCount - 1 do 1399 | for y := 0 to clump[0].FrameList.Data.FrameCount - 1 do 1400 | if lowercase(clump[0].FrameList.Data.Frame[i].Name) = 'wheel_rf_dummy' then 1401 | if clump[0].FrameList.Data.Frame[y].Parent = i then 1402 | begin 1403 | gldrawrecurse(0, i, texture, sectexture, True, false, hl_normal, false, plzdontinstance); 1404 | break; // we rendered it already, don't render yosemite / feltzer odd wheels 1405 | end; 1406 | 1407 | wheelrenders := False; 1408 | 1409 | end; 1410 | 1411 | {$ENDIF} 1412 | end; 1413 | 1414 | end. 1415 | 1416 | -------------------------------------------------------------------------------- /Struct/rwtxd.pas: -------------------------------------------------------------------------------- 1 | unit rwtxd; 2 | 3 | interface 4 | 5 | uses sysutils, dialogs, classes, opengl12, u_txdrecords; 6 | 7 | const 8 | GL_RGBA4 = $8056; 9 | GL_RGB4 = $804F; 10 | 11 | // savage S3 texture compression 12 | GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0; 13 | GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; // this one is rare, AVOID IT! 14 | GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; 15 | GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; 16 | 17 | type 18 | 19 | Tnamedtexture = packed record 20 | gltex: gluint; 21 | Name: array[0..31] of char; 22 | end; 23 | 24 | Ttxdloader = class 25 | public 26 | Texturecount: integer; 27 | is_loaded: boolean; 28 | textures: array of Tnamedtexture; 29 | procedure unload; 30 | procedure loadfromfile(filen: string); 31 | procedure loadfromstream(ms: Tmemorystream; filen: string); 32 | function findglid(Name: string): gluint; 33 | end; 34 | 35 | implementation 36 | 37 | {$IFDEF map_editor} 38 | uses u_edit; 39 | {$ENDIF} 40 | 41 | 42 | { Ttxdloader } 43 | 44 | function Ttxdloader.findglid(Name: string): gluint; 45 | var 46 | i: integer; 47 | begin 48 | Result := 0; 49 | 50 | for i := 0 to high(textures) do 51 | begin 52 | if lowercase(textures[i].Name) = lowercase(Name) then 53 | begin 54 | Result := textures[i].gltex; 55 | exit; 56 | end; 57 | end; 58 | 59 | end; 60 | 61 | procedure Ttxdloader.loadfromfile(filen: string); 62 | var 63 | ms: Tmemorystream; 64 | begin 65 | ms := Tmemorystream.Create; 66 | ms.LoadFromFile(filen); 67 | loadfromstream(ms, filen); 68 | ms.Free; 69 | end; 70 | 71 | procedure Ttxdloader.loadfromstream(ms: Tmemorystream; filen: string); 72 | var 73 | header: TTXD_file_header; 74 | texheader: TTXD_image_header; 75 | texcount: byte; 76 | i, j: integer; 77 | imgptr: pointer; 78 | lw: longword; 79 | begin 80 | 81 | is_loaded := False; 82 | 83 | ms.position := 24; 84 | ms.Read(texcount, 1); 85 | 86 | ms.position := sizeof(header); 87 | 88 | if (texcount > 200) then begin 89 | showmessage(format('%s contains unusual number of textures: %d - please investigate.', [filen, texcount])); 90 | end; 91 | 92 | // if filen = 'balloon_texts.txd' then 93 | // ms.SaveToFile('c:\dmp.txd'); 94 | //showmessage('balloon'); 95 | 96 | setlength(textures, texcount); 97 | 98 | for i := 0 to texcount - 1 do 99 | begin 100 | 101 | ms.Read(texheader, sizeof(texheader) - 4); 102 | fillchar(textures[i].Name, sizeof(textures[i].Name), 0); 103 | //textures[i].Name:= lowercase(textures[i].Name); 104 | move(texheader.Name, textures[i].Name, sizeof(texheader.Name)); 105 | 106 | //glGetError) 107 | 108 | glGenTextures(1, @textures[i].gltex); 109 | glBindTexture(GL_TEXTURE_2D, textures[i].gltex); 110 | 111 | glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); 112 | glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); 113 | glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); 114 | 115 | if texheader.bitsperpixel = 0 then 116 | continue; 117 | //if texheader.bitsperpixel <> 16 then showmessage(inttostr(texheader.bitsperpixel)); 118 | 119 | { txdversion: 9 bitsperpixel: 16 dxtcompression: 8 } 120 | // GL_BGRA_EXT, GL_BGR_EXT, GL_RGBA, GL_RGB 121 | 122 | if copy(texheader.alpha_used, 0, 3) = 'DXT' then 123 | begin 124 | for j := 0 to texheader.mipmaps - 1 do 125 | begin 126 | ms.Read(lw, sizeof(lw)); 127 | 128 | if j = 0 then // read ONLY main image, ignore the mipmaps. 129 | begin 130 | imgptr := ms.Memory; 131 | imgptr := ptr(longword(imgptr) + ms.position); 132 | 133 | case texheader.alpha_used[3] of 134 | '1': 135 | begin 136 | if (texheader.alphaname <> '') then 137 | glCompressedTexImage2DARB(GL_TEXTURE_2D, j, GL_COMPRESSED_RGBA_S3TC_DXT1_EXT, texheader.Width, texheader.Height, 0, lw, imgptr) 138 | else 139 | glCompressedTexImage2DARB(GL_TEXTURE_2D, j, GL_COMPRESSED_RGB_S3TC_DXT1_EXT, texheader.Width, texheader.Height, 0, lw, imgptr); 140 | end; 141 | '3': glCompressedTexImage2DARB(GL_TEXTURE_2D, j, GL_COMPRESSED_RGBA_S3TC_DXT3_EXT, texheader.Width, texheader.Height, 0, lw, imgptr); 142 | else 143 | begin 144 | ShowMessage(texheader.alpha_used); 145 | end; 146 | end; 147 | 148 | end; 149 | 150 | ms.seek(lw, sofromcurrent); 151 | end; // 16 bit dxt 152 | end 153 | else 154 | begin 155 | 156 | if texheader.mipmaps = 0 then texheader.mipmaps:= 1; 157 | 158 | if (texheader.bitsperpixel = 32) or (texheader.bitsperpixel = 24) then 159 | for j := 0 to texheader.mipmaps - 1 do 160 | begin 161 | ms.Read(lw, sizeof(lw)); 162 | 163 | if j = 0 then // read ONLY main image, ignore the mipmaps. 164 | begin 165 | imgptr := ms.Memory; 166 | imgptr := ptr(longword(imgptr) + ms.position); 167 | 168 | if texheader.bitsperpixel = 32 then 169 | //if texheader.data_size > (texheader.width * texheader.height * 3) then 170 | glTexImage2D(GL_TEXTURE_2D, j, 4, texheader.Width, texheader.Height, 0, GL_BGRA_EXT, GL_UNSIGNED_BYTE, imgptr) 171 | else 172 | glTexImage2D(GL_TEXTURE_2D, j, 3, texheader.Width, texheader.Height, 0, GL_BGR_EXT, GL_UNSIGNED_BYTE, imgptr); 173 | 174 | end; 175 | 176 | ms.seek(lw, sofromcurrent); 177 | end; // 32 / 24 bit dxt 178 | end; 179 | end; 180 | 181 | is_loaded := True; 182 | 183 | end; 184 | 185 | procedure Ttxdloader.unload; 186 | var 187 | i: integer; 188 | texuint: array[0..255] of gluint; 189 | begin 190 | 191 | for i := 0 to high(textures) do 192 | begin 193 | texuint[i] := textures[i].gltex; 194 | end; 195 | 196 | glDeleteTextures(high(textures), @texuint[0]); 197 | 198 | setlength(textures, 0); 199 | 200 | end; 201 | 202 | end. 203 | 204 | -------------------------------------------------------------------------------- /Struct/textparser.pas: -------------------------------------------------------------------------------- 1 | unit textparser; 2 | 3 | interface 4 | 5 | uses dialogs, classes, sysutils; 6 | 7 | procedure setworkspace(str: string); 8 | procedure setworkspacesafe(str: string); 9 | function indexed(n: integer): string; 10 | function intindex(n: integer): integer; 11 | function fltindex(n: integer): single; 12 | function stripcomments(const commenttxt, fulltext: string): string; 13 | function reformat(sep: string): string; 14 | 15 | var 16 | foo: Tstringlist; 17 | 18 | implementation 19 | 20 | function textreplace(asource, afind, areplace: string): string; 21 | var p :integer; 22 | begin 23 | result:=''; 24 | p:=pos(lowercase(AFind),lowercase(ASource)); 25 | while p > 0 do begin 26 | result:= result+Copy(ASource, 1, p - 1) + AReplace; 27 | Delete(ASource, 1, p + Length(AFind) - 1); 28 | p:= pos(lowercase(AFind),lowercase(ASource)); 29 | end; 30 | Result:=Result + ASource; 31 | end; 32 | 33 | procedure setworkspacesafe(str: string); 34 | var i: integer; 35 | begin 36 | if foo = nil then foo:= Tstringlist.create; 37 | foo.clear; 38 | foo.settext(pchar(textreplace(textreplace(str,'<', #13), '&', #13))); 39 | end; 40 | 41 | procedure setworkspace(str: string); 42 | var 43 | i: integer; 44 | facts: integer; 45 | isspacer: boolean; 46 | begin 47 | if foo = nil then foo:= Tstringlist.create; 48 | foo.clear; 49 | 50 | facts:= -1; 51 | isspacer:= true; 52 | 53 | for i:= 1 to length(str) do begin 54 | 55 | isspacer:= ((str[i] = ',') or (str[i] = ' ') or (str[i] = ' ')); 56 | 57 | if (facts = -1) then begin 58 | if isspacer = false then facts:= i; // found beginning 59 | end else begin 60 | if (facts <> -1) and (isspacer = true) then begin 61 | 62 | foo.Add(copy(str, facts, i - facts)); 63 | 64 | facts:= -1; 65 | 66 | end; 67 | 68 | end; 69 | 70 | end; 71 | 72 | if (isspacer = false) then // it ended with a character, add last item. 73 | foo.Add(copy(str, facts, i - facts)); 74 | 75 | end; 76 | 77 | function indexed(n: integer): string; 78 | begin 79 | if n < foo.count then 80 | result:= foo[n] else result:= ''; 81 | end; 82 | 83 | function intindex(n: integer): integer; 84 | var 85 | c: integer; 86 | begin 87 | val(indexed(n), result, c); 88 | end; 89 | 90 | function fltindex(n: integer): single; 91 | begin 92 | if foo <> nil then 93 | if n <= foo.Count then 94 | result:= strtofloat(foo[n]); 95 | end; 96 | 97 | function stripcomments(const commenttxt, fulltext: string): string; 98 | var 99 | p: integer; 100 | begin 101 | p:= pos(commenttxt, fulltext); 102 | 103 | if p <> 0 then 104 | result:= copy(fulltext, 0, p-1) 105 | else 106 | result:= fulltext; 107 | 108 | end; 109 | 110 | function reformat(sep: string): string; 111 | var 112 | i: integer; 113 | begin 114 | for i:= 0 to foo.Count-1 do 115 | if i = 0 then result:= foo[i] 116 | else result:= result + sep + foo[i] 117 | end; 118 | 119 | end. 120 | -------------------------------------------------------------------------------- /Struct/u_txdrecords.pas: -------------------------------------------------------------------------------- 1 | { 2 | 3 | special: Longword; // 4354= 16bit <- SET IF XBOX 4 | // 4358= 8bpp 5 | // 4353= 32bpp * 6 | // 4353= DXT3 7 | // 4353= DXT1 8 | // 4354= NONRECOMPRESIBLE DXT - hud and such images. 9 | 10 | } 11 | 12 | unit u_txdrecords; 13 | 14 | interface 15 | 16 | type 17 | 18 | TTXD_file_header = packed record 19 | filetype: Longword; // 22 - txd 20 | size: Longword; // filesize - 12 21 | gametype: Longword; // 134283263 = GTA3, 22 | // 67239935 = gta3 frontend 23 | // 268697599 = GTAVC 24 | // 201523199 = gtavc frontend 25 | // 335609855 = xbox vc 26 | split: Longword; // 1 27 | end; // 16 28 | 29 | TTXD_image_header = packed record // 124 bytes 30 | // txd image info header 31 | RwTxdExt: Longword; // 4 = extension 32 | RWVersion: Longword; // Renderware version number 33 | texturecount: word; // texture count if this is the first image! 34 | // otherwise Renderware version number 35 | dummy: word; // part 2 of renderware version 36 | 37 | TextureNative: Longword; // 21 38 | 39 | SizeOfTextureNative: Longword; // size of data + 116 40 | RWVersiona: Longword; // Renderware version number 41 | 42 | TxdStruct: Longword; // always 1, what could it be... 43 | SizeOfTxdStruct: Longword; // size of data + 92 44 | 45 | RWVersionb: Longword; // Renderware version number 46 | TXDVersion: Longword; // 8 for vice city pc, 5 for vicecity XBOX, 9 for san andreas pc 47 | 48 | FilterFlags: Longword; // 4354= 16bit <- ALWAYS IF XBOX 49 | // 4358= 8bpp 50 | // 4354= 32bpp 51 | // 4358= DXT3 52 | // 0000= DXT1 53 | // 4354= NONRECOMPRESIBLE DXT - hud and such images. 54 | 55 | 56 | Name: array[0..31] of char; // name for image, null terminated 57 | alphaname: array[0..31] of char; // name for alpha / mask, null terminated, format 9 stores something else here 58 | 59 | 60 | image_flags: Longword; // alpha flags 61 | // 512 = 16bpp no alpha 62 | // 768 = 16bpp with alpha 63 | 64 | // 9728= 8bpp no alpha 65 | // 9472= 8bpp with alpha 66 | 67 | // 1536= 32bpp no alpha < -+- SET IF ANY XBOX 68 | // 1280= 32bpp with alpha < / 69 | 70 | // 512? = dxt1 no alpha 71 | // 768 = dxt3 with alpha 72 | // ? = dxt3 no alpha 73 | 74 | // 256 = used in generic.txd (first of 2 duplicates in img file) 75 | // and in hud.txd too 76 | 77 | 78 | // 6 = was used for body in ashdexx's sample 79 | // custom xbox working txd 80 | 81 | 82 | alpha_used: array[0..3] of char; // alpha used flag: 1 or 0 note: very very long boolean value 83 | // format 9 uses fourcc codes for dxt compression here 84 | width: word; // width of image 85 | height: word; // height of image 86 | BitsPerPixel: Byte; // image data type 87 | mipmaps: Byte; // usualy 1. some vice city txds had mipmaps but game didn't use them. 88 | // san andreas makes full use of mipmaps. 89 | set_to_4: Byte; // 4 90 | dxtcompression: Byte; // directx compression= DXT + this number 91 | // 15 = DXT3 XBOX 92 | // 12 = DXT1 XBOX 93 | 94 | data_size: Longword; // size of image data if image is 8 bpp then there is a palette before this! 95 | end; 96 | 97 | implementation 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /ThdTimer.pas: -------------------------------------------------------------------------------- 1 | { ThreadedTimer found in "Delphi Developer's Journal" of May 1996 Vol. 2 No. 5 } 2 | 3 | unit ThdTimer; 4 | 5 | interface 6 | 7 | uses 8 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 9 | 10 | type 11 | TThreadedTimer = class; 12 | 13 | TTimerThread = class(TThread) 14 | OwnerTimer: TThreadedTimer; 15 | procedure Execute; override; 16 | end; 17 | 18 | TThreadedTimer = class(TComponent) 19 | private 20 | FEnabled: boolean; 21 | FInterval: word; 22 | FOnTimer: TNotifyEvent; 23 | FTimerThread: TTimerThread; 24 | FThreadPriority: TThreadPriority; 25 | protected 26 | procedure UpdateTimer; 27 | procedure SetEnabled(value: boolean); 28 | procedure SetInterval(value: word); 29 | procedure SetOnTimer(value: TNotifyEvent); 30 | procedure SetThreadPriority(value: TThreadPriority); 31 | procedure Timer; dynamic; 32 | public 33 | constructor Create(AOwner: TComponent); override; 34 | destructor Destroy; override; 35 | published 36 | property Enabled: boolean read FEnabled write SetEnabled default true; 37 | property Interval: word read FInterval write SetInterval default 1000; 38 | property Priority: TThreadPriority read FThreadPriority write SetThreadPriority default tpNormal; 39 | property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; 40 | end; 41 | 42 | procedure Register; 43 | 44 | implementation 45 | 46 | procedure TTimerThread.Execute; 47 | begin 48 | Priority := OwnerTimer.FThreadPriority; 49 | repeat 50 | SleepEx(OwnerTimer.FInterval, False); 51 | Synchronize(OwnerTimer.Timer); 52 | until Terminated; 53 | end; 54 | 55 | constructor TThreadedTimer.Create(AOwner: TComponent); 56 | begin 57 | inherited Create(AOwner); 58 | FEnabled := True; 59 | FInterval := 1000; 60 | FThreadPriority := tpNormal; 61 | FTimerThread := TTimerThread.Create(False); 62 | FTimerThread.OwnerTimer := Self; 63 | end; 64 | 65 | destructor TThreadedTimer.Destroy; 66 | begin 67 | FEnabled := False; 68 | UpdateTimer; 69 | FTimerThread.Free; 70 | inherited Destroy; 71 | end; 72 | 73 | procedure TThreadedTimer.UpdateTimer; 74 | begin 75 | if not FTimerThread.Suspended then FTimerThread.Suspend; 76 | if (FInterval <> 0) and FEnabled then 77 | if FTimerThread.Suspended then FTimerThread.Resume; 78 | end; 79 | 80 | procedure TThreadedTimer.SetEnabled(value: boolean); 81 | begin 82 | if value <> FEnabled then 83 | begin 84 | FEnabled := value; 85 | UpdateTimer; 86 | end; 87 | end; 88 | 89 | procedure TThreadedTimer.SetInterval(value: Word); 90 | begin 91 | if value <> FInterval then 92 | begin 93 | FInterval := value; 94 | UpdateTimer; 95 | end; 96 | end; 97 | 98 | procedure TThreadedTimer.SetOnTimer(value: TNotifyEvent); 99 | begin 100 | FOnTimer := value; 101 | UpdateTimer; 102 | end; 103 | 104 | procedure TThreadedTimer.SetThreadPriority(value: TThreadPriority); 105 | begin 106 | if value <> FThreadPriority then 107 | begin 108 | FThreadPriority := value; 109 | UpdateTimer; 110 | end; 111 | end; 112 | 113 | procedure TThreadedTimer.Timer; 114 | begin 115 | if Assigned(FOnTimer) then FOnTimer(Self); 116 | end; 117 | 118 | procedure Register; 119 | begin 120 | RegisterComponents('!', [TThreadedTimer]); 121 | end; 122 | 123 | end. 124 | -------------------------------------------------------------------------------- /U_main.pas: -------------------------------------------------------------------------------- 1 | unit U_main; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, ExtCtrls, jpeg; 8 | 9 | type 10 | Twnd_about = class(TForm) 11 | Label1: TLabel; 12 | Label2: TLabel; 13 | Label3: TLabel; 14 | Panel5: TPanel; 15 | Image4: TImage; 16 | btn_clear: TSpeedButton; 17 | Label4: TLabel; 18 | Label5: TLabel; 19 | Image1: TImage; 20 | Label6: TLabel; 21 | procedure btn_clearClick(Sender: TObject); 22 | private 23 | { Private declarations } 24 | public 25 | { Public declarations } 26 | end; 27 | 28 | var 29 | wnd_about: Twnd_about; 30 | 31 | implementation 32 | 33 | {$R *.dfm} 34 | 35 | procedure Twnd_about.btn_clearClick(Sender: TObject); 36 | begin 37 | modalresult:= mrok; 38 | end; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /VectorTypes.pas: -------------------------------------------------------------------------------- 1 | {: VectorTypes unit.

2 | 3 | Defines base vector types for use in Geometry.pas and OpenGL12.pas.

4 | 5 | The sole aim of this unit is to limit dependency between the Geometry 6 | and OpenGL12 units by introducing the base compatibility types 7 | (and only the *base* types).

8 | 9 | Conventions:

14 | 15 | Note : D3D types untested.

16 | 17 | Historique :

20 | } 21 | unit VectorTypes; 22 | 23 | interface 24 | 25 | type 26 | 27 | TVector3i = array [0..2] of Longint; 28 | TVector3f = array [0..2] of Single; 29 | TVector3d = array [0..2] of Double; 30 | 31 | TVector4i = array [0..3] of Longint; 32 | TVector4f = array [0..3] of Single; 33 | TVector4d = array [0..3] of Double; 34 | 35 | TMatrix3i = array [0..2] of TVector3i; 36 | TMatrix3f = array [0..2] of TVector3f; 37 | TMatrix3d = array [0..2] of TVector3d; 38 | 39 | TMatrix4i = array [0..3] of TVector4i; 40 | TMatrix4f = array [0..3] of TVector4f; 41 | TMatrix4d = array [0..3] of TVector4d; 42 | 43 | TD3DVector = packed record 44 | case Integer of 45 | 0 : ( x : Single; 46 | y : Single; 47 | z : Single); 48 | 1 : ( v : TVector3f); 49 | end; 50 | 51 | TD3DMatrix = packed record 52 | case Integer of 53 | 0 : (_11, _12, _13, _14: Single; 54 | _21, _22, _23, _24: Single; 55 | _31, _32, _33, _34: Single; 56 | _41, _42, _43, _44: Single); 57 | 1 : (m : TMatrix4f); 58 | end; 59 | 60 | implementation 61 | 62 | // nothing implemented in this unit 63 | 64 | end. 65 | 66 | -------------------------------------------------------------------------------- /compiler.inc: -------------------------------------------------------------------------------- 1 | {$define TDC} 2 | 3 | {$define Delphi} 4 | 5 | {$ifdef fpc} 6 | {$undef Delphi} 7 | {$endif} 8 | 9 | // delphi 10 | 11 | {$ifdef Delphi} 12 | {$B-} // enables short-circuit bitwise evaluation. 13 | 14 | {.$A+} 15 | {.$DEBUGINFO OFF} // will prevent placing Debug info to your code. 16 | {.$LOCALSYMBOLS OFF} // will prevent placing local symbols to your code. 17 | {.$O+} // optimize code, remove unnecessary variables etc. 18 | {.$STACKFRAMES OFF} 19 | {.$REFERENCEINFO OFF} 20 | {.$ASSERTIONS OFF} 21 | {.$Q-} // removes code for Integer overflow-checking. 22 | {.$R-} // removes code for range checking of strings, arrays etc. 23 | {.$S-} // removes code for stack-checking. 24 | {.$Y-} // will prevent placing smybol information to your code. 25 | {.$WRITEABLECONST OFF} // Writeable typed constants OFF 26 | {.$IOCHECKS OFF} 27 | {.$REFERENCEINFO OFF} 28 | {.$LOCALSYMBOLS OFF} 29 | {.$TYPEINFO OFF} 30 | 31 | {$SAFEDIVIDE OFF} // FDIV bug on old pentiums is repaired already by OS 32 | {$endif} 33 | 34 | // freepascal 35 | 36 | {$ifdef fpc} 37 | 38 | // switch to delphi compatible mode 39 | {$asmmode intel} 40 | {$mode delphi} 41 | 42 | {$DEBUGINFO OFF} // will prevent placing Debug info to your code. 43 | {.$LOCALSYMBOLS OFF} // will prevent placing local symbols to your code. 44 | {$ASSERTIONS OFF} 45 | {$Q-} // removes code for Integer overflow-checking. 46 | {$R-} // removes code for range checking of strings, arrays etc. 47 | {$S-} // removes code for stack-checking. 48 | {.$Y-} // will prevent placing smybol information to your code. 49 | {$B-} // enables short-circuit bitwise evaluation. // ?? 50 | {$WRITEABLECONST OFF} // Writeable typed constants OFF 51 | {$IOCHECKS OFF} 52 | {.$REFERENCEINFO OFF} 53 | {.$LOCALSYMBOLS OFF} 54 | {$TYPEINFO OFF} 55 | {$M+} 56 | {$endif} 57 | -------------------------------------------------------------------------------- /components/DNK_Panel.pas: -------------------------------------------------------------------------------- 1 | // uses some code from forms.pas 2 | 3 | // there are problems with components that use mouse events like Tedit or memo if you place them on this component ... 4 | 5 | unit DNK_Panel; 6 | 7 | interface 8 | 9 | uses 10 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 11 | ExtCtrls; 12 | 13 | type 14 | Tbordericons_ = (smsystem_menu, smMaximize, smMinimize); 15 | Tbordericons = set of Tbordericons_; 16 | TDNK_Panel = class(Tpanel) 17 | private 18 | { Private declarations } 19 | Fsizable:boolean; 20 | FTitleBar:boolean; 21 | Ftoolwindow:boolean; 22 | Fbordericons: Tbordericons; 23 | fIcon : TIcon; 24 | fonclosequery : TNotifyEvent; 25 | procedure Setsizable(value:boolean); 26 | procedure SetTitleBar(value:boolean); 27 | procedure Settoolwindow(value:boolean); 28 | procedure Setbordericons(value:Tbordericons); 29 | procedure SetIcon(Value : TIcon); 30 | procedure IconChanged(Sender: TObject); 31 | procedure WMClose(var Message: TWMClose); message WM_CLOSE; 32 | procedure WMIconEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ICONERASEBKGND; 33 | protected 34 | { Protected declarations } 35 | procedure CreateParams(var Params: TCreateParams); override; 36 | public 37 | { Public declarations } 38 | constructor Create(AOwner: TComponent); override; 39 | destructor Destroy; override; 40 | published 41 | { Published declarations } 42 | property sizable:boolean read fsizable write Setsizable; 43 | property TitleBar:boolean read fTitleBar write SetTitleBar; 44 | property toolwindow:boolean read ftoolwindow write Settoolwindow; 45 | property Bordericons: Tbordericons read Fbordericons write Setbordericons; 46 | property Icon : TIcon read fIcon write SetIcon; 47 | property onclosequery : TNotifyEvent read Fonclosequery write Fonclosequery; 48 | property ShowHint; 49 | property OnMouseMove; 50 | property OnDragDrop; 51 | property OnDragOver; 52 | property OnEndDock; 53 | property OnEndDrag; 54 | property OnExit; 55 | property OnEnter; 56 | property OnKeyDown; 57 | property OnKeyPress; 58 | property OnKeyUp; 59 | property TabOrder; 60 | property TabStop; 61 | property OnstartDock; 62 | property OnstartDrag; 63 | property Visible; 64 | property Popupmenu; 65 | property helpcontext; 66 | property cursor; 67 | property dragkind; 68 | property dragmode; 69 | property dragcursor; 70 | 71 | end; 72 | 73 | procedure Register; 74 | 75 | implementation 76 | 77 | // WM_ERASEBKGND: 78 | // WM_ICONERASEBKGND; 79 | 80 | procedure TDNK_Panel.WMIconEraseBkgnd(var Message: TWMEraseBkgnd); 81 | begin 82 | SendMessage(Handle, WM_SETICON, 1, ficon.Handle); 83 | end; 84 | 85 | {procedure TCustomForm.WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd); 86 | begin 87 | FillRect(Message.DC, ClientRect, Application.MainForm.Brush.Handle) 88 | end; } 89 | 90 | procedure TDNK_Panel.IconChanged(Sender: TObject); 91 | begin 92 | SendMessage(Handle, WM_SETICON, 1, ficon.Handle); 93 | end; 94 | 95 | procedure TDNK_Panel.SetIcon(Value : Ticon); 96 | begin 97 | if Value <> fIcon then 98 | begin 99 | fIcon.Assign(value); 100 | end; 101 | end; 102 | 103 | procedure TDNK_Panel.WMClose(var Message: TWMClose); 104 | begin 105 | if assigned(Fonclosequery)then Fonclosequery(self); 106 | visible:=false; 107 | end; 108 | 109 | procedure TDNK_Panel.CreateParams(var Params: TCreateParams); 110 | begin 111 | inherited; 112 | Params.Style := Params.Style and not (WS_GROUP or WS_TABSTOP); 113 | 114 | if fsizable = true then Params.Style:=Params.Style or WS_THICKFRAME; 115 | if fsizable = false then Params.Style:=Params.Style AND NOT WS_THICKFRAME; 116 | 117 | if fTitleBar = true then Params.Style:=Params.Style or WS_CAPTION; 118 | if fTitleBar = false then Params.Style:=Params.Style and not WS_CAPTION; 119 | 120 | if (smsystem_menu in Fbordericons) then 121 | Params.Style:=Params.Style or WS_SYSMENU 122 | else begin 123 | Params.Style:=Params.Style AND NOT WS_SYSMENU; 124 | 125 | end; 126 | if (smMaximize in Fbordericons) then 127 | Params.Style:=Params.Style or WS_MAXIMIZEBOX 128 | else 129 | Params.Style:=Params.Style AND NOT WS_MAXIMIZEBOX; 130 | 131 | if (smMinimize in Fbordericons) then 132 | Params.Style:=Params.Style or WS_GROUP 133 | else 134 | Params.Style:=Params.Style AND NOT WS_GROUP; 135 | 136 | if ftoolwindow = true then Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW; 137 | if ftoolwindow = false then Params.ExStyle := Params.ExStyle and not WS_EX_TOOLWINDOW; 138 | 139 | //SendMessage(Handle, WM_SETICON, 1, ficon.Handle); 140 | end; 141 | 142 | constructor TDNK_Panel.Create(AOwner: TComponent); 143 | begin 144 | inherited Create(AOwner); 145 | controlStyle:=ControlStyle+[csOpaque, csReplicatable, csCaptureMouse, csAcceptsControls]; 146 | TitleBar:=true; 147 | bordericons:=bordericons+[smsystem_menu]+[smMaximize]+[smMinimize]; 148 | sizable:=true; 149 | width:=188; 150 | height:=130; 151 | fIcon:= ticon.create; 152 | FIcon.OnChange := IconChanged; 153 | end; 154 | 155 | destructor TDNK_Panel.Destroy; 156 | begin 157 | fIcon.free; 158 | inherited Destroy; 159 | end; 160 | 161 | procedure TDNK_Panel.Setsizable(Value: boolean); 162 | begin 163 | Fsizable:=Value; 164 | RecreateWnd; 165 | end; 166 | 167 | procedure TDNK_Panel.setTitleBar(Value: boolean); 168 | begin 169 | FTitleBar:=Value; 170 | RecreateWnd; 171 | end; 172 | 173 | procedure TDNK_Panel.settoolwindow(Value: boolean); 174 | begin 175 | Ftoolwindow:=Value; 176 | RecreateWnd; 177 | SendMessage(Handle, WM_SETICON, 1, ficon.Handle); 178 | end; 179 | 180 | procedure TDNK_Panel.Setbordericons(value:Tbordericons); 181 | begin 182 | Fbordericons:=value; 183 | RecreateWnd; 184 | end; 185 | 186 | procedure Register; 187 | begin 188 | RegisterComponents('DNK components', [TDNK_Panel]); 189 | end; 190 | 191 | end. 192 | -------------------------------------------------------------------------------- /components/DNK_RoundSlider.pas: -------------------------------------------------------------------------------- 1 | // unit DNK_RoundSlider 2 | // 3 | // round slider with 3d and flat appearace 4 | // it is almost fully customizable, except you can't specify background bitmap. 5 | // 6 | // !WARNING! the control is subclassed from Timage, because drawing on Timage's canvas 7 | // is 'FLICKER FREE', because of that there are 2 problems and 2 advantages: 8 | // - the control won't repaint if resized at design or runtime excpt if you manualy call paint procedure 9 | // - the control has additional peoperties and events 10 | // from Timage (like center and stretch) please LEAVE those peoperties set to default 11 | // it will cause strange behaviour... 12 | // - the transparent property can be used as with normal Timage component 13 | // - the control is flicker free 14 | 15 | unit DNK_RoundSlider; 16 | 17 | interface 18 | 19 | uses 20 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math, 21 | extctrls; 22 | 23 | type 24 | TDNK_Roundslider = class(Timage) 25 | private 26 | { Private declarations } 27 | fcolor : TColor; 28 | fcolor_light : TColor; 29 | fcolor_shadow : TColor; 30 | fbordercolor : TColor; 31 | MDown: TMouseEvent; 32 | MUp: TMouseEvent; 33 | Enab: Boolean; 34 | fflat:boolean; 35 | Fspacer: integer; 36 | Flinesize: integer; 37 | Fbordersize: integer; 38 | fposition: integer; 39 | fmax: integer; 40 | fmin: integer; 41 | fbarcolor: tcolor; 42 | fonchange : TNotifyEvent; 43 | procedure Setposition(Value: integer); 44 | procedure Setmax(Value: integer); 45 | procedure Setmin(Value: integer); 46 | procedure Setbarcolor(Value: tcolor); 47 | procedure setspacer(Value: integer); 48 | procedure setbordersize(Value: integer); 49 | procedure setlinesize(Value: integer); 50 | procedure SetCol(Value: TColor); 51 | procedure set_color_light(Value: TColor); 52 | procedure set_color_shadow(Value: TColor); 53 | procedure set_bordercolor(Value: TColor); 54 | procedure setflat(Value: boolean); 55 | procedure setEnab(value:boolean); 56 | protected 57 | { Protected declarations } 58 | updating: boolean; 59 | procedure translatecoordinates(x, y: integer); 60 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 61 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 62 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 63 | public 64 | { Public declarations } 65 | constructor Create(AOwner: TComponent); override; 66 | destructor Destroy; override; 67 | procedure Paint;// override; 68 | procedure Resize;// override; 69 | published 70 | { Published declarations } 71 | property OnChange : TNotifyEvent index 0 read fonchange write fonchange; 72 | property Spacer : integer read Fspacer write setspacer; 73 | property BorderSize : integer read Fbordersize write setbordersize; //[ doesn't work yet! ] 74 | property LineSize : integer read flinesize write setlinesize; 75 | property Color : TColor read fColor write SetCol; 76 | property Color_light : TColor read fcolor_light write set_color_light default clwhite ; 77 | property Color_shadow : TColor read fcolor_shadow write set_color_shadow default clgray ; 78 | property Bordercolor : TColor read fbordercolor write set_bordercolor default clgray ; 79 | property Enabled : Boolean read Enab write setEnab; 80 | property Flat : Boolean read fflat write setflat; 81 | property OnMouseDown: TMouseEvent read MDown write MDown; 82 | property OnMouseUp: TMouseEvent read MUp write MUp; 83 | property barcolor: tcolor read fbarcolor write Setbarcolor; 84 | property position: integer read fposition write Setposition; 85 | property max: integer read fmax write Setmax; 86 | property min: integer read fmin write Setmin; 87 | property ShowHint; 88 | property OnMouseMove; 89 | property OnDragDrop; 90 | property OnDragOver; 91 | property OnEndDock; 92 | property OnEndDrag; 93 | property Visible; 94 | property Popupmenu; 95 | property Cursor; 96 | property Dragkind; 97 | property Dragmode; 98 | property Dragcursor; 99 | 100 | { property Autosize index -1; 101 | property Center index -1; 102 | property Incrementaldisplay index -1; 103 | property Stretch index -1;} 104 | end; 105 | 106 | procedure Register; 107 | 108 | implementation 109 | 110 | procedure TDNK_Roundslider.Resize; 111 | begin 112 | paint; 113 | end; 114 | 115 | procedure TDNK_Roundslider.translatecoordinates(x, y: integer); 116 | var 117 | angle: integer; 118 | xcoord: integer; 119 | ycoord: integer; 120 | radius: integer; 121 | begin 122 | radius:= height div 2; 123 | xcoord:= x- radius; 124 | ycoord:= y- radius; 125 | 126 | angle:= round(max + (max div 2)* arctan2(- ycoord, xcoord)/ pi); 127 | 128 | if angle < min then angle:= angle+ max else if angle > max then angle:= angle- max; 129 | 130 | position:= angle; 131 | if Assigned (fonchange) then Onchange (self); 132 | paint; 133 | end; 134 | 135 | procedure TDNK_Roundslider.setspacer(Value: integer); 136 | begin 137 | Fspacer:= value; 138 | Paint; 139 | end; 140 | 141 | procedure TDNK_Roundslider.setlinesize(Value: integer); 142 | begin 143 | Flinesize:= value; 144 | Paint; 145 | end; 146 | 147 | procedure TDNK_Roundslider.setbordersize(Value: integer); 148 | begin 149 | //showmessage(inttostr(value mod 2)); 150 | Fbordersize:= value; 151 | Paint; 152 | end; 153 | 154 | constructor TDNK_Roundslider.Create(AOwner: TComponent); 155 | begin 156 | inherited Create(AOwner); 157 | Width := 100; 158 | Height := 100; 159 | 160 | fposition:= 0; 161 | fmax:= 100; 162 | fmin:= 0; 163 | fColor := clbtnface; 164 | fcolor_light := $00E8E8E8; 165 | fcolor_shadow := $008C8C8C; 166 | fbordercolor:=clblack; 167 | fbarcolor:= clblue; 168 | fspacer:= 3; 169 | fbordersize:= 2; 170 | 171 | Enab := true; 172 | paint; 173 | end; 174 | 175 | destructor TDNK_Roundslider.Destroy; 176 | begin 177 | inherited Destroy; 178 | end; 179 | 180 | procedure TDNK_Roundslider.Paint; 181 | var 182 | b: Tbitmap; 183 | angle: real; 184 | radius: integer; 185 | 186 | procedure paintbmptransparent(from: Tbitmap; drawonthis: Tcanvas; transpcolor: Tcolor); 187 | begin 188 | drawonthis.brush.Style:= bsclear; 189 | drawonthis.BrushCopy(rect(0,0, from.width, from.height), from, rect(0,0, from.width, from.height), transpcolor); 190 | end; 191 | 192 | begin 193 | try 194 | 195 | picture.bitmap.Width:= width; 196 | picture.bitmap.height:= height; 197 | 198 | with canvas do begin 199 | pen.color:= color_light; 200 | brush.color:= color_light; 201 | Canvas.Polygon([ 202 | Point(width, 0), 203 | Point(0,0), 204 | Point(0, height) 205 | ]); 206 | 207 | pen.color:= color_shadow; 208 | brush.color:= color_shadow; 209 | Canvas.Polygon([ 210 | Point(width, 0), 211 | Point(width, height), 212 | Point(0, height) 213 | ]); 214 | 215 | b:= Tbitmap.create; 216 | b.width:= width; 217 | b.height:= height; 218 | 219 | b.canvas.Pen.Color:= color; 220 | b.canvas.Brush.Color:= color; 221 | 222 | b.canvas.FillRect(b.Canvas.ClipRect); 223 | 224 | b.canvas.Pen.Color:= clFuchsia; 225 | b.canvas.Brush.Color:= color; 226 | 227 | b.canvas.pen.Width:= BorderSize; 228 | b.canvas.Ellipse(1+ BorderSize div 2, 1+ BorderSize div 2, width-BorderSize div 2, height-BorderSize div 2); 229 | 230 | paintbmptransparent(b, canvas, clfuchsia); 231 | 232 | b.canvas.copyrect(rect(0,0, width, height), canvas, rect(0,0, width, height)); 233 | 234 | b.canvas.Pen.Color:= clFuchsia; 235 | b.canvas.Brush.Color:= clFuchsia; 236 | b.canvas.Ellipse(spacer+1, spacer+1, width-spacer-1, height-spacer-1); 237 | 238 | 239 | 240 | radius:= width div 2; 241 | angle:= -position * pi / (max div 2); 242 | 243 | Canvas.Pen.Width:= linesize; 244 | canvas.pen.color:= barcolor; 245 | canvas.moveto(radius, radius); 246 | canvas.lineto(radius + round(radius *sin(angle)), radius + round(radius *cos(angle))); 247 | 248 | paintbmptransparent(b, canvas, clfuchsia); 249 | 250 | b.free; 251 | 252 | if flat= false then begin 253 | Pen.Color:= bordercolor; 254 | pen.Width:= 1; 255 | Brush.style:= bsclear; 256 | Ellipse(0, 0, width, height); 257 | end; 258 | 259 | end; 260 | except end; 261 | end; // paint 262 | 263 | procedure TDNK_Roundslider.SetCol(Value: TColor); 264 | begin 265 | fColor := Value; 266 | Paint; 267 | end; 268 | 269 | procedure TDNK_Roundslider.set_color_light(Value: TColor); 270 | begin 271 | fcolor_light := Value; 272 | Paint; 273 | end; 274 | 275 | procedure TDNK_Roundslider.set_color_shadow(Value: TColor); 276 | begin 277 | fcolor_shadow := Value; 278 | Paint; 279 | end; 280 | 281 | procedure TDNK_Roundslider.set_bordercolor(Value: TColor); 282 | begin 283 | fbordercolor := Value; 284 | Paint; 285 | end; 286 | 287 | procedure TDNK_Roundslider.Setflat(Value: boolean); 288 | begin 289 | fflat := value; 290 | Paint; 291 | end; 292 | 293 | procedure TDNK_Roundslider.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 294 | begin 295 | inherited; 296 | updating:= true; 297 | translatecoordinates(y, x); 298 | end; 299 | 300 | procedure TDNK_Roundslider.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 301 | begin 302 | inherited; 303 | updating:= false 304 | end; 305 | 306 | procedure TDNK_Roundslider.MouseMove(Shift: TShiftState; X, Y: Integer); 307 | begin 308 | inherited; 309 | if enabled then if updating then translatecoordinates(y, x) 310 | end; 311 | 312 | procedure TDNK_Roundslider.Setposition(Value: integer); 313 | begin 314 | if value < min then value:=min; 315 | if value > max then value:=max; 316 | 317 | if value <> fposition then begin 318 | fposition:=value; 319 | if Assigned (fonchange) then Onchange (self); 320 | paint; 321 | end; 322 | end; 323 | 324 | procedure TDNK_Roundslider.Setbarcolor(value : tcolor); 325 | begin 326 | fbarcolor:=value; 327 | Paint; 328 | end; 329 | 330 | procedure TDNK_Roundslider.Setmax(Value: integer); 331 | begin 332 | fmax:=value; 333 | paint; 334 | end; 335 | 336 | procedure TDNK_Roundslider.Setmin(Value: integer); 337 | begin 338 | fmin:=value; 339 | paint; 340 | end; 341 | 342 | 343 | procedure TDNK_Roundslider.setEnab(value:boolean); 344 | begin 345 | Enab:=value; 346 | Paint; 347 | end; 348 | 349 | procedure Register; 350 | begin 351 | RegisterComponents('DNK Components', [TDNK_Roundslider]); 352 | end; 353 | 354 | end. 355 | -------------------------------------------------------------------------------- /components/DNK_designpanel.pas: -------------------------------------------------------------------------------- 1 | unit DNK_designpanel; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | ExtCtrls; 8 | 9 | type 10 | TDNK_designpanel = class(TPanel) 11 | private 12 | { Private declarations } 13 | onchangeevent: TNotifyEvent; 14 | FBordersize: integer; 15 | allowevent: boolean; 16 | procedure setBordersize(Value: integer); 17 | procedure WMMOVE(var message: TWMMove); message WM_MOVE; 18 | procedure WMSIZE(var message: TWMSize); message WM_SIZE; 19 | protected 20 | { Protected declarations } 21 | procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 22 | procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 23 | procedure MouseMove (Shift: TShiftState; X, Y: Integer); override; 24 | public 25 | { Public declarations } 26 | constructor Create(AOwner: TComponent); override; 27 | published 28 | { Published declarations } 29 | property Onchange: TNotifyEvent read onchangeevent write onchangeevent; 30 | property Bordersize : integer read FBordersize write setBordersize; 31 | property OnMouseDown; 32 | property OnMouseMove; 33 | property OnMouseUp; 34 | end; 35 | 36 | procedure Register; 37 | 38 | implementation 39 | 40 | procedure TDNK_designpanel.WMMOVE(var message: TWMMove); 41 | begin 42 | if allowevent= true then if Assigned(onchangeevent) then onchangeevent(Self); 43 | end; 44 | 45 | procedure TDNK_designpanel.WMSIZE(var message: TWMSize); 46 | begin 47 | if allowevent= true then if Assigned(onchangeevent) then onchangeevent(Self); 48 | end; 49 | 50 | constructor TDNK_designpanel.Create(AOwner: TComponent); 51 | begin 52 | inherited Create(AOwner); 53 | Width := 180; 54 | Height := 80; 55 | Font.Name := 'Tahoma'; 56 | Font.Color := clblack; 57 | Font.Size := 8; 58 | setBordersize(3); 59 | end; 60 | 61 | procedure TDNK_designpanel.setBordersize(Value: integer); 62 | begin 63 | FBordersize:= value; 64 | invalidate; 65 | end; 66 | 67 | procedure TDNK_designpanel.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 68 | var 69 | ptrect: Trect; 70 | 71 | procedure sendmsg(msg: integer); 72 | begin 73 | ReleaseCapture; // important! 74 | SendMessage(Handle, WM_NCLBUTTONDOWN, msg, 0); 75 | end; 76 | 77 | begin 78 | inherited MouseDown (Button, Shift, X, Y); 79 | try 80 | allowevent:= true; 81 | 82 | // send message that convinces windows that user clicked somewhere on 83 | // control's border but panel doesn't have a border, this is cheating :) 84 | 85 | // center 86 | ptrect:= rect(FBordersize, FBordersize, width-FBordersize, height-FBordersize); 87 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTCAPTION); 88 | 89 | // left top 90 | ptrect:= rect(0,0,FBordersize,FBordersize); 91 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTTOPLEFT); 92 | // right top 93 | ptrect:= rect(width-FBordersize,0, width, FBordersize); 94 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTTOPRIGHT); 95 | // left bottom 96 | ptrect:= rect(0,height-FBordersize,FBordersize,height); 97 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTBOTTOMLEFT); 98 | // right bottom 99 | ptrect:= rect(width-FBordersize, height-FBordersize, width, height); 100 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTBOTTOMRIGHT); 101 | 102 | // top 103 | ptrect:= rect(FBordersize,0, width-FBordersize, FBordersize); 104 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTTOP); 105 | // bottom 106 | ptrect:= rect(FBordersize,height-FBordersize, width-FBordersize, height); 107 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTBOTTOM); 108 | // left 109 | ptrect:= rect(0, FBordersize, FBordersize, height-FBordersize); 110 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTLEFT); 111 | // right 112 | ptrect:= rect(width-FBordersize, FBordersize, width, height-FBordersize); 113 | if ptinrect(ptrect,point(x,y)) then sendmsg(HTRIGHT); 114 | 115 | finally 116 | allowevent:= false; 117 | end; 118 | end; 119 | 120 | procedure TDNK_designpanel.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 121 | begin 122 | try 123 | inherited MouseUp (Button, Shift, X, Y); 124 | except end; 125 | end; 126 | 127 | procedure TDNK_designpanel.MouseMove (Shift: TShiftState; X, Y: Integer); 128 | var 129 | ptrect: Trect; 130 | begin 131 | inherited MouseMove (shift, X, Y); 132 | // change the cursor depending on where it is 133 | 134 | // center 135 | ptrect:= rect(FBordersize, FBordersize, width-FBordersize, height-FBordersize); 136 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeAll; 137 | 138 | // left top 139 | ptrect:= rect(0,0,FBordersize,FBordersize); 140 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeNWSE; 141 | // right top 142 | ptrect:= rect(width-FBordersize,0, width, FBordersize); 143 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeNESW; 144 | // left bottom 145 | ptrect:= rect(0,height-FBordersize,FBordersize,height); 146 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeNESW; 147 | // right bottom 148 | ptrect:= rect(width-FBordersize, height-FBordersize, width, height); 149 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeNWSE; 150 | 151 | // top 152 | ptrect:= rect(FBordersize,0, width-FBordersize, FBordersize); 153 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeNS; 154 | // bottom 155 | ptrect:= rect(FBordersize,height-FBordersize, width-FBordersize, height); 156 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeNS; 157 | // left 158 | ptrect:= rect(0, FBordersize, FBordersize, height-FBordersize); 159 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeWE; 160 | // right 161 | ptrect:= rect(width-FBordersize, FBordersize, width, height-FBordersize); 162 | if ptinrect(ptrect,point(x,y)) then cursor:=crSizeWE; 163 | end; 164 | 165 | procedure Register; 166 | begin 167 | RegisterComponents('DNK Components', [TDNK_designpanel]); 168 | end; 169 | 170 | end. 171 | -------------------------------------------------------------------------------- /components/DNK_edit.pas: -------------------------------------------------------------------------------- 1 | unit DNK_edit; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Graphics, Classes, Controls, Forms, SysUtils, StdCtrls, Menus, messages; 7 | 8 | type 9 | TDNK_edit = class(TEdit) 10 | private 11 | FAlignment : TAlignment; 12 | Bmp: TBitmap; 13 | fflat:boolean; 14 | fnumbersonly:boolean; 15 | procedure verticalcenter; 16 | procedure SetBmp(Value: TBitmap); 17 | procedure Setflat(Value: boolean); 18 | procedure Setnumbersonly(Value: boolean); 19 | procedure CMEnter(var message:TCMGotFocus);message CM_ENTER; 20 | procedure WMSize(var Message: TWMSize); message WM_SIZE; 21 | procedure WM_SETFOCUS(var message:TWMSetFocus);message WM_SETFOCUS; 22 | procedure WM_KILLFOCUS(var message:TWMKillFocus);message WM_KILLFOCUS; 23 | procedure caret; 24 | protected 25 | procedure CreateParams(var Params:TCreateParams); override; 26 | procedure SetAlignment(NewValue:TAlignment); 27 | procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 28 | procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 29 | public 30 | procedure Loaded; override; 31 | constructor Create(AOwner:TComponent); override; 32 | procedure KeyDown(var Key: Word; Shift: TShiftState); override; 33 | procedure KeyUp(var Key: Word; Shift: TShiftState); override; 34 | procedure KeyPress(var Key: char); override; 35 | published 36 | property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; 37 | property Align; 38 | property Input_caret: TBitmap read Bmp write SetBmp; 39 | property Flat: boolean read fflat write Setflat; 40 | property Numbersonly: boolean read fnumbersonly write Setnumbersonly; 41 | property OnKeydown; 42 | property OnKeyUp; 43 | property OnKeypress; 44 | property OnMouseDown; 45 | property OnMouseUp; 46 | property Anchors; 47 | end; 48 | 49 | procedure Register; 50 | 51 | implementation 52 | 53 | procedure TDNK_edit.verticalcenter; 54 | var 55 | loc: Trect; 56 | begin 57 | // this was supposed to center text verticaly 58 | // doesn't work because a strange bug 59 | // probably in Tedit or Tcustomedit vcl code? 60 | SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); 61 | Loc.Top := clientheight div 2 - font.Height div 2; 62 | Loc.Bottom := clientheight div 2 + font.Height div 2; 63 | SendMessage(Handle, EM_SETRECT, 0, LongInt(@Loc)); 64 | end; 65 | 66 | procedure tDNK_edit.SetBmp(Value: TBitmap); 67 | begin 68 | Bmp.Assign(value); 69 | caret; 70 | RecreateWnd; 71 | end; 72 | 73 | procedure tDNK_edit.Setflat(Value: boolean); 74 | begin 75 | fflat:=value; 76 | RecreateWnd; 77 | end; 78 | 79 | procedure tDNK_edit.Setnumbersonly(Value: boolean); 80 | begin 81 | fnumbersonly:=value; 82 | end; 83 | 84 | procedure tDNK_edit.caret; 85 | begin 86 | if bmp.empty = false then begin 87 | CreateCaret(self.Handle, Bmp.Handle, 0, 0); 88 | ShowCaret(self.Handle); 89 | end; 90 | invalidate; 91 | end; 92 | 93 | procedure tDNK_edit.KeyDown(var Key: Word; Shift: TShiftState); 94 | begin 95 | inherited; 96 | end; 97 | 98 | procedure tDNK_edit.KeyUp(var Key: Word; Shift: TShiftState); 99 | begin 100 | try 101 | if fnumbersonly = true then if text = '' then begin 102 | text := '0'; 103 | selectall; 104 | end; 105 | except end; 106 | inherited; 107 | end; 108 | 109 | procedure tDNK_edit.KeyPress(var Key: char); 110 | begin 111 | inherited; 112 | if fnumbersonly = true then begin 113 | if Key <> '-' then begin 114 | if Key <> '' then begin // backspace 115 | if ((UpCase(Key) < '0') or (UpCase(Key) > '9')) then Key := #0; 116 | end; 117 | end; 118 | end; 119 | end; 120 | 121 | procedure tDNK_edit.WM_SETFOCUS(var message:TWMSetFocus); 122 | begin 123 | inherited; 124 | caret; 125 | end; 126 | 127 | procedure tDNK_edit.WM_KILLFOCUS(var message:TWMKillFocus); 128 | begin 129 | inherited; 130 | HideCaret(self.handle); 131 | DestroyCaret; 132 | end; 133 | 134 | procedure tDNK_edit.CMEnter(var message:TCMGotFocus); 135 | begin 136 | inherited; 137 | end; 138 | 139 | procedure tDNK_edit.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 140 | begin 141 | inherited; 142 | end; 143 | 144 | procedure tDNK_edit.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 145 | begin 146 | inherited; 147 | end; 148 | 149 | procedure TDNK_edit.Loaded; 150 | begin 151 | inherited; 152 | end; 153 | 154 | Constructor TDNK_edit.Create(AOwner:TComponent); 155 | begin 156 | inherited Create(AOwner); 157 | bmp:=tbitmap.Create; 158 | end; 159 | 160 | procedure TDNK_edit.WMSize(var Message: TWMSize); 161 | begin 162 | inherited; 163 | verticalcenter; 164 | end; 165 | 166 | procedure TDNK_edit.CreateParams(var Params: TCreateParams); 167 | begin 168 | inherited CreateParams(Params); 169 | case Alignment of 170 | taLeftJustify : Params.Style := Params.Style or ES_LEFT; 171 | taRightJustify : Params.Style := Params.Style or ES_RIGHT; 172 | taCenter : Params.Style := Params.Style or ES_CENTER; 173 | end; 174 | if fflat=true then params.ExStyle:=params.ExStyle OR ws_ex_staticedge; 175 | if fflat=false then params.ExStyle:=params.ExStyle and not ws_ex_staticedge; 176 | end; 177 | 178 | procedure TDNK_edit.SetAlignment(NewValue:TAlignment); 179 | begin 180 | if FAlignment<>NewValue then begin 181 | FAlignment:=NewValue; 182 | RecreateWnd; 183 | verticalcenter; 184 | end; 185 | end; 186 | 187 | procedure Register; 188 | begin 189 | RegisterComponents('DNK components', [TDNK_edit]); 190 | end; 191 | 192 | end. 193 | -------------------------------------------------------------------------------- /components/Trackbar_32.pas: -------------------------------------------------------------------------------- 1 | unit Trackbar_32; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | ComCtrls, CommCtrl; 8 | 9 | type 10 | T___drawstyle = (Normal, Special, Flat, unknown); 11 | TTrackbar_32 = class(TTrackBar) 12 | private 13 | { Private declarations } 14 | _thumbcolor : TColor; 15 | _trackcolor : TColor; 16 | _color_light : TColor; 17 | _color_shadow : TColor; 18 | _bordercolor : TColor; 19 | FEnableselrange:boolean; 20 | Fdrawfocusrect:boolean; 21 | Fautohint:boolean; 22 | _drawstyle:T___drawstyle; 23 | Bmp: TBitmap; 24 | FCanvas: TCanvas; 25 | procedure set_thumbcolor(Value: TColor); 26 | procedure set_trackcolor(Value: TColor); 27 | procedure set_color_light(Value: TColor); 28 | procedure set_color_shadow(Value: TColor); 29 | procedure set_bordercolor(Value: TColor); 30 | procedure set_drawstyle(Value: T___drawstyle); 31 | procedure SetEnableselrange(value:boolean); 32 | procedure Setdrawfocusrect(value:boolean); 33 | procedure Setautohint(value:boolean); 34 | procedure SetBmp(Value: TBitmap); 35 | procedure WMPaint(var Message: TWMPaint); message WM_PAINT; 36 | protected 37 | { Protected declarations } 38 | procedure drawbitmap; 39 | procedure drawthumb; 40 | procedure drawtrack; 41 | procedure drawflatthumb; 42 | procedure drawflattrack; 43 | procedure drawunknowntrack; 44 | procedure Paint; 45 | procedure PaintWindow(DC: HDC); override; 46 | procedure CreateParams(var Params: TCreateParams); override; 47 | procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 48 | procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 49 | procedure MouseMove (Shift: TShiftState; X, Y: Integer); override; 50 | public 51 | constructor Create(AOwner: TComponent); override; 52 | destructor Destroy; override; 53 | { Public declarations } 54 | published 55 | { Published declarations } 56 | property Enableselrange:boolean read fEnableselrange write SetEnableselrange; 57 | property DrawFocusRect:boolean read Fdrawfocusrect write Setdrawfocusrect; 58 | property Autohint:boolean read fautohint write Setautohint; 59 | property OnMouseDown; 60 | property OnMouseMove; 61 | property OnMouseUp; 62 | property Color; 63 | property thumbcolor : TColor read _thumbcolor write set_thumbcolor; 64 | property trackcolor : TColor read _trackcolor write set_trackcolor; 65 | property color_light : TColor read _color_light write set_color_light; 66 | property color_shadow : TColor read _color_shadow write set_color_shadow; 67 | property bordercolor : TColor read _bordercolor write set_bordercolor; 68 | property Drawstyle : T___drawstyle read _drawstyle write set_drawstyle; 69 | property Glyph: TBitmap read Bmp write SetBmp; 70 | end; 71 | 72 | procedure Register; 73 | 74 | implementation 75 | 76 | // DRAW SPECIAL TRACKBAR // 77 | 78 | procedure TTrackbar_32.SetBmp(Value: TBitmap); 79 | begin 80 | Bmp.Assign(value); 81 | invalidate; 82 | end; 83 | 84 | procedure TTrackbar_32.drawbitmap; 85 | var 86 | thumbrect : TRect; 87 | begin 88 | if bmp.Empty = false then begin 89 | SendMessage(self.Handle, TBM_GETTHUMBRECT, 0, Integer(@thumbrect)); 90 | 91 | fCanvas.BrushCopy(thumbrect,bmp, 92 | Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]); 93 | 94 | end; 95 | end; 96 | 97 | procedure TTrackbar_32.drawthumb; 98 | var channelrect, thumbrect : TRect; 99 | var left_,top_,width_,height_:integer; 100 | begin 101 | SendMessage(self.Handle, TBM_GETTHUMBRECT, 0, Integer(@thumbrect)); 102 | SendMessage(self.Handle, TBM_GETCHANNELRECT, 0, Integer(@channelrect)); 103 | 104 | left_:=thumbrect.left; 105 | top_:=thumbrect.top; 106 | width_:=thumbrect.left+thumbrect.right-thumbrect.left; 107 | height_:=thumbrect.top+thumbrect.bottom-thumbrect.top; 108 | 109 | // vertical // 110 | 111 | if orientation = trVertical then begin 112 | if tickmarks = tmBoth then begin 113 | Fcanvas.pen.Style:=psSolid; 114 | Fcanvas.pen.Color:=_bordercolor; 115 | Fcanvas.Rectangle(left_,top_,width_,height_); 116 | Fcanvas.pen.Color:=_color_light; 117 | Fcanvas.Rectangle(left_+1,top_+1,width_-1,height_-1); 118 | Fcanvas.pen.Color:=_color_shadow; 119 | Fcanvas.Rectangle(left_+2,top_+2,width_-1,height_-1); 120 | Fcanvas.pen.Color:=_thumbcolor; 121 | Fcanvas.brush.Color:=_thumbcolor; 122 | Fcanvas.Rectangle(left_+2,top_+2,width_-2,height_-2); 123 | end; 124 | 125 | if tickmarks = tmBottomRight then begin 126 | Fcanvas.brush.Color:=_thumbcolor; 127 | Fcanvas.pen.Color:=_thumbcolor; 128 | Fcanvas.pen.Style:=psSolid; 129 | Fcanvas.Rectangle(left_,top_,width_,height_); 130 | Fcanvas.pen.Color:=_bordercolor; 131 | 132 | Fcanvas.Polyline([ 133 | Point(thumbrect.left,thumbrect.bottom), 134 | Point(thumbrect.left,thumbrect.top), 135 | Point(thumbrect.left+width_ div 2 + width_ div 4,thumbrect.top), 136 | Point(thumbrect.right,(thumbrect.top + thumbrect.bottom-1) div 2), 137 | Point(thumbrect.left+width_ div 2 + width_ div 4,thumbrect.bottom), 138 | Point(thumbrect.left,thumbrect.bottom) 139 | ]); 140 | 141 | fcanvas.pen.Color:=_color_light; 142 | Fcanvas.Polyline([ 143 | Point(1+thumbrect.left,thumbrect.bottom-2), 144 | Point(1+thumbrect.left,1+thumbrect.top), 145 | Point(1+thumbrect.left+width_ div 2 + width_ div 4 -1,1+thumbrect.top), 146 | Point(1+thumbrect.right -1,1+(thumbrect.top + thumbrect.bottom-1) div 2 ) 147 | ]); 148 | 149 | Fcanvas.pen.Color:=_color_shadow; 150 | Fcanvas.Polyline([ 151 | Point(thumbrect.right-1,(thumbrect.top + thumbrect.bottom-1) div 2), 152 | Point(thumbrect.left+width_ div 2 + width_ div 4 ,thumbrect.bottom -1), 153 | Point(thumbrect.left,thumbrect.bottom-1) 154 | ]); 155 | 156 | end; 157 | 158 | if tickmarks = tmTopLeft then begin 159 | Fcanvas.brush.Color:=_thumbcolor; 160 | Fcanvas.pen.Color:=_thumbcolor; 161 | Fcanvas.pen.Style:=psSolid; 162 | Fcanvas.Rectangle(left_,top_,width_,height_); 163 | 164 | Fcanvas.pen.Color:=_bordercolor; 165 | 166 | Fcanvas.Polyline([ 167 | Point(thumbrect.right,thumbrect.bottom), 168 | Point(thumbrect.right,thumbrect.top), 169 | Point(thumbrect.left+width_ div 2 - width_ div 4,thumbrect.top), 170 | Point(thumbrect.left,(thumbrect.top + thumbrect.bottom-1) div 2), 171 | Point(thumbrect.left+width_ div 2 - width_ div 4,thumbrect.bottom), 172 | Point(thumbrect.right,thumbrect.bottom) 173 | ]); 174 | 175 | fcanvas.pen.Color:=_color_light; 176 | Fcanvas.Polyline([ 177 | Point(1+thumbrect.right -2,1+thumbrect.top), 178 | Point(thumbrect.left+width_ div 2 - width_ div 4 ,1+thumbrect.top), 179 | Point(1+thumbrect.left -1,1+(thumbrect.top + thumbrect.bottom-1) div 2 ) 180 | ]); 181 | 182 | Fcanvas.pen.Color:=_color_shadow; 183 | Fcanvas.Polyline([ 184 | Point(thumbrect.left+1,(thumbrect.top + thumbrect.bottom-1) div 2), 185 | Point(thumbrect.left+width_ div 2 - width_ div 4 ,thumbrect.bottom -1), 186 | Point(thumbrect.right-1,thumbrect.bottom-1), 187 | Point(thumbrect.right-1,thumbrect.top+1) 188 | ]); 189 | end; 190 | end; 191 | 192 | // horizontal // 193 | 194 | if orientation = trHorizontal then begin 195 | if tickmarks = tmBoth then begin 196 | Fcanvas.pen.Style:=psSolid; 197 | Fcanvas.pen.Color:=_bordercolor; 198 | Fcanvas.Rectangle(left_,top_,width_,height_); 199 | Fcanvas.pen.Color:=_color_light; 200 | Fcanvas.Rectangle(left_+1,top_+1,width_-1,height_-1); 201 | Fcanvas.pen.Color:=_color_shadow; 202 | Fcanvas.Rectangle(left_+2,top_+2,width_-1,height_-1); 203 | Fcanvas.pen.Color:=_thumbcolor; 204 | Fcanvas.brush.Color:=_thumbcolor; 205 | Fcanvas.Rectangle(left_+2,top_+2,width_-2,height_-2); 206 | end; 207 | 208 | if tickmarks = tmBottomRight then begin 209 | Fcanvas.brush.Color:=_thumbcolor; 210 | Fcanvas.pen.Color:=_thumbcolor; 211 | Fcanvas.Rectangle(left_,top_,width_,height_); 212 | 213 | Fcanvas.pen.Style:=psSolid; 214 | Fcanvas.pen.Color:=_bordercolor; 215 | 216 | Fcanvas.Polyline([ 217 | Point(thumbrect.left,thumbrect.top), 218 | Point(thumbrect.right-1,thumbrect.top), 219 | Point(thumbrect.right-1,thumbrect.top + thumbrect.bottom div 2), 220 | Point((thumbrect.left + thumbrect.right-1) div 2,thumbrect.bottom-height_ div 8),// 221 | Point(thumbrect.left,thumbrect.top + thumbrect.bottom div 2), 222 | Point(thumbrect.left,thumbrect.top) 223 | ]); 224 | 225 | fcanvas.pen.Color:=_color_light; 226 | Fcanvas.Polyline([ 227 | Point(thumbrect.right-2,thumbrect.top+1), 228 | Point(thumbrect.left+1,thumbrect.top+1), 229 | Point(thumbrect.left+1,(thumbrect.top+1 + thumbrect.bottom div 2 ) -1 ), 230 | Point((thumbrect.left + thumbrect.right-1) div 2 +1 ,thumbrect.bottom-height_ div 8 )//, 231 | ]); 232 | 233 | Fcanvas.pen.Color:=_color_shadow; 234 | Fcanvas.Polyline([ 235 | Point(thumbrect.right-2,thumbrect.top+2), 236 | Point(thumbrect.right-2,(thumbrect.top-2 + thumbrect.bottom div 2 ) +2 ), 237 | Point((thumbrect.right + thumbrect.left+2) div 2 -2 ,thumbrect.bottom-height_ div 8 )//, 238 | ]); 239 | 240 | end; 241 | 242 | if tickmarks = tmTopLeft then begin 243 | Fcanvas.brush.Color:=_thumbcolor; 244 | Fcanvas.pen.Color:=_thumbcolor; 245 | Fcanvas.Rectangle(left_,top_,width_,height_); 246 | 247 | Fcanvas.pen.Style:=psSolid; 248 | Fcanvas.pen.Color:=_bordercolor; 249 | 250 | Fcanvas.Polyline([ 251 | Point(thumbrect.right,thumbrect.bottom), 252 | Point(thumbrect.left,thumbrect.bottom), 253 | Point(thumbrect.left,thumbrect.top + thumbrect.bottom div 4), 254 | Point((thumbrect.left + thumbrect.right-1) div 2,thumbrect.top-height_ div 8), 255 | Point(thumbrect.right,thumbrect.top + thumbrect.bottom div 4), 256 | Point(thumbrect.right,thumbrect.bottom) 257 | ]); 258 | 259 | fcanvas.pen.Color:=_color_light; 260 | Fcanvas.Polyline([ 261 | Point(thumbrect.left+1,thumbrect.bottom-1), 262 | Point(thumbrect.left+1,thumbrect.top + thumbrect.bottom div 4), 263 | Point((thumbrect.left+1 + thumbrect.right) div 2,thumbrect.top-height_ div 8) 264 | ]); 265 | 266 | Fcanvas.pen.Color:=_color_shadow; 267 | Fcanvas.Polyline([ 268 | Point(thumbrect.left+1,thumbrect.bottom-1), 269 | Point(thumbrect.right-1,thumbrect.bottom-1), 270 | Point(thumbrect.right-1,thumbrect.top + thumbrect.bottom div 4 ), 271 | Point((thumbrect.left + thumbrect.right) div 2,thumbrect.top-height_ div 8 +1) 272 | ]); 273 | end; 274 | end; 275 | 276 | end; 277 | 278 | procedure TTrackbar_32.drawtrack; 279 | var channelrect, thumbrect : TRect; 280 | var left_,top_,width_,height_:integer; 281 | begin 282 | 283 | SendMessage(self.Handle, TBM_GETTHUMBRECT, 0, Integer(@thumbrect)); 284 | SendMessage(self.Handle, TBM_GETCHANNELRECT, 0, Integer(@channelrect)); 285 | 286 | left_:=channelrect.left; 287 | top_:=channelrect.top; 288 | width_:=channelrect.left+channelrect.right-channelrect.left; 289 | height_:=channelrect.top+channelrect.bottom-channelrect.top; 290 | 291 | // in case if we have vertical trackbar 292 | if orientation = trVertical then begin 293 | left_:=channelrect.left + 8; 294 | top_:=channelrect.top-8; 295 | height_:=(channelrect.left+channelrect.right-1-channelrect.left) -3; 296 | width_:=channelrect.top+channelrect.bottom-channelrect.top; 297 | end; 298 | 299 | Fcanvas.pen.Style:=psSolid; 300 | Fcanvas.pen.Color:=_bordercolor; 301 | Fcanvas.Rectangle(left_,top_,width_,height_); 302 | Fcanvas.pen.Color:=_color_shadow; 303 | Fcanvas.Rectangle(left_+1,top_+1,width_-1,height_-1); 304 | Fcanvas.pen.Color:=_color_light; 305 | Fcanvas.Rectangle(left_+2,top_+2,width_-1,height_-1); 306 | Fcanvas.pen.Color:=_trackcolor; 307 | Fcanvas.brush.Color:=_trackcolor; 308 | Fcanvas.Rectangle(left_+2,top_+2,width_-2,height_-2); 309 | end; 310 | 311 | // DRAW FLAT TRACKBAR // 312 | 313 | procedure TTrackbar_32.drawflatthumb; 314 | var channelrect, thumbrect : TRect; 315 | var left_,top_,width_,height_:integer; 316 | begin 317 | SendMessage(self.Handle, TBM_GETTHUMBRECT, 0, Integer(@thumbrect)); 318 | SendMessage(self.Handle, TBM_GETCHANNELRECT, 0, Integer(@channelrect)); 319 | 320 | left_:=thumbrect.left; 321 | top_:=thumbrect.top; 322 | width_:=thumbrect.left+thumbrect.right-1-thumbrect.left; 323 | height_:=thumbrect.top+thumbrect.bottom-thumbrect.top; 324 | 325 | // vertical // 326 | 327 | if orientation = trVertical then begin 328 | if tickmarks = tmBoth then begin 329 | Fcanvas.pen.Style:=psSolid; 330 | Fcanvas.pen.Color:=_color_light; 331 | Fcanvas.Rectangle(left_,top_,width_,height_); 332 | Fcanvas.pen.Color:=_color_shadow; 333 | Fcanvas.Rectangle(left_+1,top_+1,width_,height_); 334 | Fcanvas.pen.Color:=_thumbcolor; 335 | Fcanvas.brush.Color:=_thumbcolor; 336 | Fcanvas.Rectangle(left_+1,top_+1,width_-1,height_-1); 337 | end; 338 | 339 | if tickmarks = tmBottomright then begin 340 | Fcanvas.brush.Color:=_thumbcolor; 341 | Fcanvas.pen.Color:=_thumbcolor; 342 | Fcanvas.pen.Style:=psSolid; 343 | Fcanvas.Rectangle(left_,top_,width_,height_); 344 | 345 | fcanvas.pen.Color:=_color_light; 346 | Fcanvas.Polyline([ 347 | Point(thumbrect.left,thumbrect.bottom-1), 348 | Point(thumbrect.left,thumbrect.top), 349 | Point(thumbrect.left+width_ div 2 + width_ div 4 ,thumbrect.top), 350 | Point(thumbrect.right-1 ,(thumbrect.top + thumbrect.bottom-1) div 2 ) 351 | ]); 352 | 353 | Fcanvas.pen.Color:=_color_shadow; 354 | Fcanvas.Polyline([ 355 | Point(thumbrect.right-1,(thumbrect.top + thumbrect.bottom-1) div 2), 356 | Point(thumbrect.left+width_ div 2 + width_ div 4 ,thumbrect.bottom-1 ), 357 | Point(thumbrect.left,thumbrect.bottom-1) 358 | ]); 359 | 360 | end; 361 | 362 | if tickmarks = tmTopLeft then begin 363 | Fcanvas.brush.Color:=_thumbcolor; 364 | Fcanvas.pen.Color:=_thumbcolor; 365 | Fcanvas.pen.Style:=psSolid; 366 | Fcanvas.Rectangle(left_,top_,width_,height_); 367 | 368 | fcanvas.pen.Color:=_color_light; 369 | Fcanvas.Polyline([ 370 | Point(thumbrect.right-1 ,thumbrect.top), 371 | Point(thumbrect.left+width_ div 2 - width_ div 4 ,thumbrect.top), 372 | Point(thumbrect.left ,(thumbrect.top + thumbrect.bottom-1) div 2 ) 373 | ]); 374 | 375 | Fcanvas.pen.Color:=_color_shadow; 376 | Fcanvas.Polyline([ 377 | Point(thumbrect.left,(thumbrect.top + thumbrect.bottom-1) div 2), 378 | Point(thumbrect.left+width_ div 2 - width_ div 4 ,thumbrect.bottom-1 ), 379 | Point(thumbrect.right-1,thumbrect.bottom-1), 380 | Point(thumbrect.right-1,thumbrect.top) 381 | ]); 382 | end; 383 | end; 384 | 385 | // horizontal // 386 | 387 | if orientation = trHorizontal then begin 388 | if tickmarks = tmBoth then begin 389 | Fcanvas.pen.Style:=psSolid; 390 | Fcanvas.pen.Color:=_color_light; 391 | Fcanvas.Rectangle(left_,top_,width_,height_); 392 | Fcanvas.pen.Color:=_color_shadow; 393 | Fcanvas.Rectangle(left_+1,top_+1,width_,height_); 394 | Fcanvas.pen.Color:=_thumbcolor; 395 | Fcanvas.brush.Color:=_thumbcolor; 396 | Fcanvas.Rectangle(left_+1,top_+1,width_-1,height_-1); 397 | end; 398 | 399 | if tickmarks = tmBottomright then begin 400 | Fcanvas.brush.Color:=_thumbcolor; 401 | Fcanvas.pen.Color:=_thumbcolor; 402 | Fcanvas.Rectangle(left_,top_,width_,height_); 403 | 404 | fcanvas.pen.Color:=_color_light; 405 | Fcanvas.Polyline([ 406 | Point(thumbrect.right-1-1,thumbrect.top), 407 | Point(thumbrect.left,thumbrect.top), 408 | Point(thumbrect.left,(thumbrect.top + thumbrect.bottom div 2 -1) -1 ), 409 | Point((thumbrect.left + thumbrect.right-1) div 2 +1,thumbrect.bottom-height_ div 8 )//, 410 | ]); 411 | 412 | Fcanvas.pen.Color:=_color_shadow; 413 | Fcanvas.Polyline([ 414 | Point(thumbrect.right-1,thumbrect.top), 415 | Point(thumbrect.right-1,(thumbrect.top + thumbrect.bottom div 2 -1) ), 416 | Point((thumbrect.right-1 + thumbrect.left) div 2 ,thumbrect.bottom-height_ div 8 -1)//, 417 | ]); 418 | 419 | end; 420 | 421 | if tickmarks = tmTopLeft then begin 422 | Fcanvas.brush.Color:=_thumbcolor; 423 | Fcanvas.pen.Color:=_thumbcolor; 424 | Fcanvas.Rectangle(left_,top_,width_,height_); 425 | 426 | fcanvas.pen.Color:=_color_light; 427 | Fcanvas.Polyline([ 428 | Point(thumbrect.left,thumbrect.bottom-1), 429 | Point(thumbrect.left,thumbrect.top + thumbrect.bottom div 4 -1), 430 | Point((thumbrect.left + thumbrect.right-1) div 2,thumbrect.top-height_ div 8) 431 | ]); 432 | 433 | Fcanvas.pen.Color:=_color_shadow; 434 | Fcanvas.Polyline([ 435 | Point(thumbrect.left,thumbrect.bottom -1), 436 | Point(thumbrect.right-1,thumbrect.bottom -1), 437 | Point(thumbrect.right-1,thumbrect.top + thumbrect.bottom div 4 -1), 438 | Point((thumbrect.left + thumbrect.right-1) div 2,thumbrect.top-height_ div 8 ) 439 | ]); 440 | end; 441 | end; 442 | end; 443 | 444 | procedure TTrackbar_32.drawflattrack; 445 | var channelrect, thumbrect : TRect; 446 | var left_,top_,width_,height_:integer; 447 | begin 448 | 449 | SendMessage(self.Handle, TBM_GETTHUMBRECT, 0, Integer(@thumbrect)); 450 | SendMessage(self.Handle, TBM_GETCHANNELRECT, 0, Integer(@channelrect)); 451 | 452 | left_:=channelrect.left; 453 | top_:=channelrect.top; 454 | width_:=channelrect.left+channelrect.right-1-channelrect.left; 455 | height_:=channelrect.top+channelrect.bottom-channelrect.top; 456 | 457 | // in case if we have vertical trackbar 458 | if orientation = trVertical then begin 459 | left_:=channelrect.left + 8; 460 | top_:=channelrect.top; 461 | height_:=(channelrect.left+channelrect.right-1-channelrect.left) ; 462 | width_:=channelrect.top+channelrect.bottom-channelrect.top; 463 | end; 464 | 465 | Fcanvas.pen.Color:=_color_shadow; 466 | Fcanvas.Rectangle(left_,top_,width_,height_); 467 | Fcanvas.pen.Color:=_color_light; 468 | Fcanvas.Rectangle(left_+1,top_+1,width_,height_); 469 | Fcanvas.pen.Color:=_trackcolor; 470 | Fcanvas.brush.Color:=_trackcolor; 471 | Fcanvas.Rectangle(left_+1,top_+1,width_-1,height_-1); 472 | end; 473 | 474 | procedure TTrackbar_32.drawunknowntrack; 475 | var 476 | channelrect, thumbrect : TRect; 477 | left_,top_,width_,height_:integer; 478 | begin 479 | 480 | SendMessage(self.Handle, TBM_GETTHUMBRECT, 0, Integer(@thumbrect)); 481 | SendMessage(self.Handle, TBM_GETCHANNELRECT, 0, Integer(@channelrect)); 482 | 483 | left_:=channelrect.left; 484 | top_:=channelrect.top; 485 | width_:=channelrect.left+channelrect.right-1-channelrect.left; 486 | height_:=channelrect.top+channelrect.bottom-channelrect.top; 487 | 488 | Fcanvas.pen.Color:=_color_shadow; 489 | 490 | Fcanvas.moveto(left_, height_-1); 491 | Fcanvas.lineto(width_-1, top_); 492 | 493 | Fcanvas.pen.Color:=_color_light; 494 | Fcanvas.moveto(width_-1, top_); 495 | Fcanvas.lineto(width_-1, height_); 496 | 497 | Fcanvas.moveto(width_-1, height_); 498 | Fcanvas.lineto(left_, height_); 499 | 500 | end; 501 | 502 | procedure TTrackbar_32.set_drawstyle(Value: T___drawstyle); 503 | begin 504 | _drawstyle := Value; 505 | recreatewnd; 506 | end; 507 | 508 | procedure TTrackbar_32.set_thumbcolor(Value: TColor); 509 | begin 510 | _thumbcolor := Value; 511 | Paint; 512 | end; 513 | 514 | procedure TTrackbar_32.set_trackcolor(Value: TColor); 515 | begin 516 | _trackcolor := Value; 517 | Paint; 518 | end; 519 | 520 | procedure TTrackbar_32.set_color_light(Value: TColor); 521 | begin 522 | _color_light := Value; 523 | Paint; 524 | end; 525 | 526 | procedure TTrackbar_32.set_color_shadow(Value: TColor); 527 | begin 528 | _color_shadow := Value; 529 | Paint; 530 | end; 531 | 532 | procedure TTrackbar_32.set_bordercolor(Value: TColor); 533 | begin 534 | _bordercolor := Value; 535 | Paint; 536 | end; 537 | 538 | procedure TTrackbar_32.WMPaint(var Message: TWMPaint); 539 | begin 540 | PaintHandler(Message); 541 | inherited; 542 | end; 543 | 544 | procedure TTrackbar_32.PaintWindow(DC: HDC); 545 | begin 546 | inherited PaintWindow(DC); 547 | FCanvas.Lock; 548 | try 549 | FCanvas.Handle := DC; 550 | try 551 | Paint; 552 | finally 553 | FCanvas.Handle := 0; 554 | end; 555 | finally 556 | FCanvas.Unlock; 557 | end; 558 | end; 559 | 560 | procedure TTrackbar_32.Paint; 561 | var Frame:trect; 562 | begin 563 | // no need for painting anythink, leave original trackbar 564 | if _drawstyle = Normal then exit; 565 | 566 | // draw trackbar special style 567 | if _drawstyle = Special then begin; 568 | // clear canvas first 569 | Fcanvas.pen.Color:=color; 570 | Fcanvas.brush.Color:=color; 571 | Fcanvas.Rectangle(0,0,width,height); 572 | // draw trackbar 573 | drawtrack; 574 | drawthumb; 575 | end; 576 | 577 | // draw trackbar unknown style 578 | if _drawstyle = unknown then begin; 579 | // clear canvas first 580 | Fcanvas.pen.Color:=color; 581 | Fcanvas.brush.Color:=color; 582 | Fcanvas.Rectangle(0,0,width,height); 583 | // draw trackbar 584 | drawunknowntrack; 585 | drawflatthumb; 586 | end; 587 | 588 | // draw trackbar flat style 589 | if _drawstyle = Flat then begin; 590 | // clear canvas first 591 | Fcanvas.pen.Color:=color; 592 | Fcanvas.brush.Color:=color; 593 | Fcanvas.Rectangle(0,0,width,height); 594 | // draw trackbar 595 | drawflattrack; 596 | drawflatthumb; 597 | if Fdrawfocusrect = true then begin 598 | Frame := GetClientRect; 599 | if focused then begin 600 | Frame := Rect(Frame.Left,Frame.Top,Frame.Right,Frame.Bottom); 601 | fCanvas.DrawFocusRect(Frame); 602 | end; 603 | end; 604 | end; 605 | 606 | // draw bitmap (if there is one ... ) 607 | drawbitmap; 608 | 609 | end; 610 | 611 | procedure TTrackbar_32.Setdrawfocusrect(value:boolean); 612 | begin 613 | inherited; 614 | Fdrawfocusrect:=value; 615 | recreatewnd; 616 | end; 617 | 618 | procedure TTrackbar_32.SetEnableselrange(value:boolean); 619 | begin 620 | inherited; 621 | FEnableselrange:=value; 622 | recreatewnd; 623 | end; 624 | 625 | procedure TTrackbar_32.Setautohint(value:boolean); 626 | begin 627 | inherited; 628 | Fautohint:=value; 629 | recreatewnd; 630 | end; 631 | 632 | procedure TTrackbar_32.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 633 | begin 634 | try 635 | inherited MouseDown (Button, Shift, X, Y); 636 | except end; 637 | end; 638 | 639 | procedure TTrackbar_32.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 640 | begin 641 | try 642 | inherited MouseUp (Button, Shift, X, Y); 643 | except end; 644 | end; 645 | 646 | procedure TTrackbar_32.MouseMove (Shift: TShiftState; X, Y: Integer); 647 | begin 648 | inherited MouseMove (shift, X, Y); 649 | end; 650 | 651 | constructor TTrackbar_32.Create(AOwner: TComponent); 652 | begin 653 | inherited; 654 | FEnableselrange:=false; 655 | Color:=clbtnface; 656 | FCanvas := TControlCanvas.Create; 657 | TControlCanvas(FCanvas).Control := Self; 658 | Bmp := TBitmap.Create; 659 | _thumbcolor:=clbtnface; 660 | _trackcolor:=clbtnface; 661 | _color_light:=clbtnhighlight; 662 | _color_shadow:=clbtnshadow; 663 | _bordercolor:=clblack; 664 | Fdrawfocusrect:=true; 665 | end; 666 | 667 | destructor TTrackbar_32.destroy; 668 | begin 669 | FCanvas.Free; 670 | Bmp.FreeImage; 671 | inherited; 672 | end; 673 | 674 | procedure TTrackbar_32.CreateParams(var Params: TCreateParams); 675 | begin 676 | inherited CreateParams(params); 677 | if fEnableselrange = true then params.style:=params.style OR TBS_ENABLESELRANGE; 678 | if fEnableselrange = false then params.style:=params.style AND NOT TBS_ENABLESELRANGE; 679 | if fautohint = true then params.style:=params.style OR TBS_TOOLTIPS; 680 | if fautohint = false then params.style:=params.style AND NOT TBS_TOOLTIPS; 681 | end; 682 | 683 | procedure Register; 684 | begin 685 | RegisterComponents('DNK components', [TTrackbar_32]); 686 | end; 687 | 688 | end. 689 | -------------------------------------------------------------------------------- /components/checkbox_32.pas: -------------------------------------------------------------------------------- 1 | unit checkbox_32; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | Tcheckbox_32 = class(TCheckBox) 11 | private 12 | { Private declarations } 13 | Fwordwrap:boolean; 14 | Fbutton:boolean; 15 | Fflat:boolean; 16 | procedure Setwordwrap(value:boolean); 17 | procedure Setflat(value:boolean); 18 | procedure Setbutton(value:boolean); 19 | protected 20 | { Protected declarations } 21 | procedure CreateParams(var Params: TCreateParams); override; 22 | public 23 | { Public declarations } 24 | constructor Create(AOwner: TComponent); override; 25 | published 26 | { Published declarations } 27 | property wordwrap:boolean read fwordwrap write Setwordwrap; 28 | property button:boolean read fbutton write Setbutton; 29 | property Flat:boolean read fflat write Setflat; 30 | property Align; 31 | end; 32 | 33 | procedure Register; 34 | 35 | implementation 36 | 37 | constructor Tcheckbox_32.Create(AOwner: TComponent); 38 | begin 39 | FWordWrap:=true; 40 | inherited; 41 | end; 42 | 43 | 44 | procedure Tcheckbox_32.CreateParams(var Params: TCreateParams); 45 | begin 46 | inherited; 47 | if fWordWrap = true then Params.Style:=Params.Style or BS_MULTILINE; 48 | if fWordWrap = false then Params.Style:=Params.Style AND NOT BS_MULTILINE; 49 | 50 | if Fbutton=true then Params.Style:=Params.Style or BS_PUSHLIKE; 51 | if Fbutton=false then Params.Style:=Params.Style AND NOT BS_PUSHLIKE; 52 | 53 | if fflat = true then Params.Style:=Params.Style or BS_FLAT; 54 | if fflat = false then Params.Style:=Params.Style AND NOT BS_FLAT; 55 | end; 56 | 57 | procedure Tcheckbox_32.SetWordWrap(Value: boolean); 58 | begin 59 | FWordWrap:=Value; 60 | RecreateWnd; 61 | end; 62 | 63 | procedure Tcheckbox_32.setbutton(Value: boolean); 64 | begin 65 | Fbutton:=Value; 66 | RecreateWnd; 67 | end; 68 | 69 | procedure Tcheckbox_32.setflat(Value: boolean); 70 | begin 71 | Fflat:=Value; 72 | RecreateWnd; 73 | end; 74 | 75 | procedure Register; 76 | begin 77 | RegisterComponents('DNK components', [Tcheckbox_32]); 78 | end; 79 | 80 | end. 81 | -------------------------------------------------------------------------------- /editor.dpr: -------------------------------------------------------------------------------- 1 | program editor; 2 | 3 | uses 4 | madExcept, 5 | madLinkDisAsm, 6 | madListHardware, 7 | madListProcesses, 8 | madListModules, 9 | Forms, 10 | u_edit in 'u_edit.pas' {GtaEditor}, 11 | gtadll in 'Struct\GTADLL.PAS', 12 | textparser in 'Struct\textparser.pas', 13 | u_Objects in 'u_Objects.pas', 14 | FrustumCulling in 'FrustumCulling.pas', 15 | Geometry in 'Geometry.pas', 16 | VectorTypes in 'VectorTypes.pas', 17 | RenderWareDFF in 'Struct\RenderWareDFF.pas', 18 | CameraClass in 'CameraClass.pas', 19 | rwtxd in 'Struct\rwtxd.pas', 20 | u_txdrecords in 'Struct\u_txdrecords.pas', 21 | OpenGL12 in 'OpenGL12.pas', 22 | ThdTimer in 'ThdTimer.pas', 23 | U_main in 'U_main.pas' {wnd_about}, 24 | ColObject in 'ColObject.pas', 25 | Newton in 'Newton.pas', 26 | u_sowcode in 'u_sowcode.pas' {wnd_showcode}, 27 | uHashedStringList in 'uHashedStringList.pas', 28 | BitUnit in 'BitUnit.pas', 29 | u_carcolors in 'u_carcolors.pas' {wnd_carcolorpicker}, 30 | u_report in 'u_report.pas' {wnd_report}; 31 | 32 | {$R *.res} 33 | 34 | begin 35 | Application.Initialize; 36 | Application.Title := 'Map Construction'; 37 | Application.CreateForm(TGtaEditor, GtaEditor); 38 | Application.CreateForm(Twnd_about, wnd_about); 39 | Application.CreateForm(Twnd_showcode, wnd_showcode); 40 | Application.CreateForm(Twnd_carcolorpicker, wnd_carcolorpicker); 41 | Application.CreateForm(Twnd_report, wnd_report); 42 | Application.Run; 43 | end. 44 | -------------------------------------------------------------------------------- /editor.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/editor.ico -------------------------------------------------------------------------------- /editor.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/editor.res -------------------------------------------------------------------------------- /mapviewerstuff/FileTypes.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/mapviewerstuff/FileTypes.pas -------------------------------------------------------------------------------- /mapviewerstuff/MapLoader.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/mapviewerstuff/MapLoader.pas -------------------------------------------------------------------------------- /mapviewerstuff/RequiredTypes.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/mapviewerstuff/RequiredTypes.pas -------------------------------------------------------------------------------- /mapviewerstuff/TextureStuff.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/mapviewerstuff/TextureStuff.pas -------------------------------------------------------------------------------- /uHashedStringList.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/uHashedStringList.pas -------------------------------------------------------------------------------- /u_Objects.pas: -------------------------------------------------------------------------------- 1 | unit u_Objects; 2 | 3 | interface 4 | 5 | uses classes, graphics, dialogs, filectrl, geometry, gtadll, sysutils, textparser, vectortypes, windows, uHashedStringList, inifiles, math, vectorgeometry; 6 | 7 | type 8 | 9 | // single structures 10 | 11 | TBounds = packed record 12 | min, max: TVector3F; 13 | center : TVector3F; 14 | radius : single; 15 | end; 16 | 17 | TIDEinforecord = class 18 | public 19 | idefile, ideitem: longword; 20 | ideidx: longword; 21 | 22 | // coll info 23 | collectionname: string; 24 | collectionfileindex: integer; 25 | imgindex: integer; 26 | collname: string; 27 | collmodelindex: integer; 28 | colloffset: integer; 29 | 30 | gotcollbounds: boolean; 31 | collbounds: TBounds; 32 | end; 33 | 34 | Tcarcolor = array[0..3] of integer; // 4 color indexes 35 | 36 | Tcarcolored = class(TObject) 37 | public 38 | carname: string; 39 | colorcount: integer; 40 | car4: boolean; 41 | colors: array[0..2048] of Tcarcolor; 42 | end; 43 | 44 | Tcarcolsfile = class(TObject) 45 | public 46 | colors: array[0..2048] of Tcolor; 47 | colorcount: integer; 48 | cars: array[0..2048] of Tcarcolored; 49 | carcount: integer; 50 | end; 51 | 52 | TTXDP = class 53 | fromtxd, totxd: string; 54 | end; 55 | 56 | TOBJS = class // and TOBJ 57 | ID: longword; 58 | 59 | ModelName, TextureName: string; // should even use this? could go faster with img indices 60 | Modelidx, Textureidx: integer; // img indices 61 | modelinimg, txdinimg: integer; 62 | 63 | ObjectCount: longword; 64 | DrawDist: single; 65 | Flags: longword; 66 | TimeOn, TimeOff: longword; 67 | 68 | exportRC: boolean; 69 | end; 70 | Pobjs = ^Tobjs; 71 | 72 | TINST = class 73 | id: integer; 74 | LoadedModelIndex: integer; 75 | draw_distance: single; 76 | Name: string; // ignore - unused, don't load, use ID 77 | int_id: integer; 78 | Location: Tvector3F; 79 | rx, ry, rz, rw: single; 80 | lod: integer; 81 | haslod: boolean; 82 | rootlod: boolean; 83 | added, deleted: boolean; 84 | lodobject: boolean; 85 | rux, ruy, ruz: single; 86 | 87 | carcolor1,carcolor2: integer; 88 | 89 | visibility: boolean; 90 | 91 | constructor create; 92 | procedure SetGTARotation(x, y, z: single); 93 | 94 | end; 95 | 96 | TCULL = class 97 | startorigin: Tvector3F; 98 | dimensions: Tvector3F; 99 | rotation: single; 100 | flags: longword; 101 | end; 102 | 103 | RCARS = class 104 | Location: Tvector3F; 105 | angle: single; 106 | car_id: longword; 107 | primary, secondary: longword; 108 | bool: boolean; 109 | alarm_probability, door_lock_probability: single; 110 | radio: single; 111 | appear_delay: single; 112 | end; 113 | 114 | // file classes 115 | 116 | TIDEFILE = class 117 | Objects: array of TOBJS; 118 | TexReplace: array of TTXDP; 119 | procedure loadfromfile(filen: string; imglist: Tstrings); 120 | end; 121 | 122 | TIPLFILE = class 123 | filename: string; 124 | InstObjects: array of TINST; 125 | CullZones: array of TCULL; 126 | Bounds: array[0..1] of TVector3f; 127 | Cars: array of RCARS; 128 | procedure loadfromfile(filen: string); 129 | procedure loadfrombinfile(filen: string); 130 | procedure processlodinfo; 131 | end; 132 | 133 | Tiplinst = packed record 134 | x, y, z: single; 135 | qx, qy, qz, qw: single; 136 | ObjectID, InteriorID, lod: integer; 137 | end; 138 | 139 | Tiplcars = packed record 140 | x, y, z: single; 141 | angle: single; 142 | ObjectID, u1, u2, u3, u4, u5, u6, u7: integer; 143 | end; 144 | 145 | Tiplstruct = packed record 146 | bninary: array[0..3] of char; // bnry 147 | 148 | instcount, 149 | cullcount, 150 | pathcount, 151 | grgecount, 152 | carscount, 153 | jumpcount: longword; 154 | 155 | instptr, 156 | cullptr, 157 | pathptr, 158 | grgeptr, 159 | enexptr, 160 | pickptr, 161 | jumpptr, 162 | U1, 163 | carsptr, 164 | tcycptr, 165 | auzoptr, 166 | multptr 167 | : longword; 168 | end; 169 | 170 | Twatervertex = packed record 171 | pos: Tvector3f; 172 | F1, F2, F3, F4: single; 173 | end; 174 | 175 | TWaterGeom = packed record 176 | vertices: array[0..3] of Twatervertex; 177 | param: integer; 178 | end; 179 | 180 | // map class 181 | 182 | TGTAMAP = class(TObject) 183 | public 184 | 185 | imgfile: array[0..5] of string; 186 | imglist: array[0..5] of THashedStringList; 187 | 188 | Water: array of TWaterGeom; 189 | 190 | IDE: array of TIDEFILE; 191 | IPL: array of TIPLFILE; 192 | loaded: boolean; 193 | idetable: TurboHashedStringList; 194 | idemapping: array of Tobject; 195 | colors: Tcarcolsfile; 196 | 197 | procedure loadcolldata(collfileidx: integer; inimg: integer); 198 | procedure loadfile(typ, filen: string; secondarybinipl: boolean); 199 | procedure loadimg(filen, filen2, filen3, filen4, filen5, filen6: string); 200 | procedure loadcolors(colorfile: string); 201 | procedure loadwater(filen: string); 202 | end; 203 | 204 | // http://www.delphipages.com/tips/thread.cfm?ID=208 205 | 206 | function gtarot2matrix3x3(x, y, z: single): TMatrix3f; 207 | procedure matrix3f2quaternion(m: TMatrix3f; var rx, ry, rz, rw: single); 208 | 209 | 210 | var 211 | totalones: integer = 0; 212 | mainidelist: array[0..19999] of TOBJS; 213 | 214 | implementation 215 | 216 | uses u_edit; 217 | 218 | 219 | function gtarot2matrix3x3(x, y, z: single): TMatrix3f; 220 | 221 | var 222 | v5, 223 | v6, 224 | v7, 225 | v8, 226 | v9, 227 | v10: double; 228 | 229 | v11, 230 | v12, 231 | v13: single; 232 | 233 | begin 234 | 235 | v5 := cos(x); 236 | // LODWORD(this->pos.X) = 0; 237 | // LODWORD(this->pos.Y) = 0; 238 | // LODWORD(this->pos.Z) = 0; 239 | v6 := sin(x); 240 | v11 := cos(y); 241 | v7 := sin(y); 242 | v8 := cos(z); 243 | v9 := sin(z); 244 | v12 := v9; 245 | v10 := v9 * v6; 246 | v13 := v8 * v6; 247 | 248 | result[0,0] := v8 * v11 - v10 * v7; 249 | result[0,1] := v13 * v7 + v12 * v11; 250 | result[0,2] := -(v7 * v5); 251 | result[1,0] := -(v12 * v5); 252 | result[1,1] := v8 * v5; 253 | result[1,2] := v6; 254 | result[2,0] := v8 * v7 + v10 * v11; 255 | result[2,1] := v12 * v7 - v13 * v11; 256 | result[2,2] := v11 * v5; 257 | 258 | { 259 | this->right.X = v8 * v11 - v10 * v7; 260 | this->right.Y = v13 * v7 + v12 * v11; 261 | this->right.Z = -(v7 * v5); 262 | this->up.X = -(v12 * v5); 263 | this->up.Y = v8 * v5; 264 | this->up.Z = v6; 265 | this->at.X = v8 * v7 + v10 * v11; 266 | this->at.Y = v12 * v7 - v13 * v11; 267 | this->at.Z = v11 * v5; 268 | } 269 | 270 | end; 271 | 272 | 273 | 274 | 275 | 276 | 277 | 278 | 279 | 280 | (* 281 | function gtarot2matrix3x3(x, y, z: single): TMatrix3f; 282 | var 283 | v4, 284 | sinx, 285 | siny, 286 | cosz, 287 | sinz, 288 | v9, 289 | cosy, 290 | v11, 291 | v12: single; 292 | a, b, c, d, e, f, ad, bd: single; 293 | begin 294 | 295 | x:= x * (PI / 180); 296 | y:= y * (PI / 180); 297 | z:= z * (PI / 180); 298 | 299 | A := cos(x); 300 | B := sin(x); 301 | C := cos(y); 302 | D := sin(y); 303 | E := cos(z); 304 | F := sin(z); 305 | 306 | AD := A * D; 307 | BD := B * D; 308 | 309 | result[0,0] := C * E; 310 | result[1,0] := -C * F; 311 | result[2,0] := -D; 312 | 313 | result[0,1] := -BD * E + A * F; 314 | result[1,1] := BD * F + A * E; 315 | result[2,1] := -B * C; 316 | 317 | result[0,2] := AD * E + B * F; 318 | result[1,2] := -AD * F + B * E; 319 | result[2,2] := A * C; 320 | 321 | {exit; 322 | 323 | x:= x * (PI / 180); 324 | y:= y * (PI / 180); 325 | z:= z * (PI / 180); 326 | 327 | fillchar(Result, sizeof(result), 0); 328 | 329 | v4:= cos(x); 330 | sinx:= sin(x); 331 | cosy:= cos(y); 332 | siny:= sin(y); 333 | cosz:= cos(z); 334 | sinz:= sin(z); 335 | v11:= sinz; 336 | v9:= sinz * sinx; 337 | v12:= cosz * sinx; 338 | 339 | result[0,0]:= cosz * cosy - v9 * siny; // ERROR 340 | result[1,0]:= v12 * siny + v11 * cosy; // ERROR 341 | result[2,0]:= -(siny * v4); // CHECK 342 | 343 | result[0,1]:= -(v11 * v4); // ERROR 344 | result[1,1]:= cosz * v4; // ERROR 345 | result[2,1]:= sinx; // CHECK 346 | 347 | result[0,2]:= cosz * siny + v9 * cosy; // CHECK 348 | result[1,2]:= v11 * siny - v12 * cosy; // CHECK 349 | result[2,2]:= cosy * v4; // CHECK 350 | } 351 | 352 | { 353 | [ecx] <- cos z * cos y - sin z * sin x * sin y 354 | [ecx+4] <- cos z * sin y + sin x * sin y + sin z * cos y 355 | [ecx+8] <- -(sin y * cos x) 356 | [ecx+10h] <- -(sin z * cos x) 357 | [ecx+14h] <- cos z * cos x 358 | [ecx+18h] <- sin x 359 | [ecx+20h] <- cos y * sin z * sin x + cos z * sin y 360 | [ecx+24h] <- sin z * sin y - cos z * sin x * cos y 361 | } 362 | 363 | end; 364 | *) 365 | 366 | { 367 | procedure matrix3f2quaternion(m: TMatrix3f; var rx, ry, rz, rw: single); 368 | var 369 | trace, s: single; 370 | i, j, k: integer; 371 | q: array[0..3] of single; 372 | begin 373 | trace:= m[0][0]+m[1][1]+m[2][2]; 374 | 375 | if ( trace > 0.0 ) then begin 376 | s:= 0.5 / Sqrt( trace + 1 ); 377 | rx:= ( m[2][1] - m[1][2] ) * s; 378 | ry:= ( m[0][2] - m[2][0] ) * s; 379 | rz:= ( m[1][0] - m[0][1] ) * s; 380 | rw:= 0.25 / s; 381 | end else begin 382 | 383 | i:= 0; 384 | if (m[1][1] > m[0][0]) then i:= 1; 385 | 386 | if (m[2][2] > m[i][i]) then i:= 2; 387 | 388 | j:= nxt[i]; 389 | k:= nxt[j]; 390 | s:= ((m[i][i] - (m[j][j] + m[k][k])) + 1.0); 391 | q[i]:= s * 0.5; 392 | 393 | if (s <> 0.0) then s:= 0.5 / s; 394 | 395 | q[3]:= (m[k][j] - m[j][k]) * s; 396 | q[j]:= (m[i][j] + m[j][i]) * s; 397 | q[k]:= (m[i][k] + m[k][i]) * s; 398 | 399 | rx:= q[0]; 400 | ry:= q[1]; 401 | rz:= q[2]; 402 | rw:= q[3]; 403 | end; 404 | 405 | end; 406 | } 407 | 408 | procedure matrix3f2quaternion(m: TMatrix3f; var rx, ry, rz, rw: single); 409 | var 410 | tr: single; 411 | S: single; 412 | begin 413 | 414 | tr:= m[0,0] + m[1,1] + m[2,2]; 415 | 416 | if (tr > 0) then begin 417 | S := sqrt(tr+1.0) * 2; // S=4*rw 418 | rw := 0.25 * S; 419 | rx := (m[2,1] - m[1,2]) / S; 420 | ry := (m[0,2] - m[2,0]) / S; 421 | rz := (m[1,0] - m[0,1]) / S; 422 | end else if ((m[0,0] > m[1,1]) and (m[0,0] > m[2,2])) then begin 423 | S := sqrt(1.0 + m[0,0] - m[1,1] - m[2,2]) * 2; // S:=4*rx 424 | rw := (m[2,1] - m[1,2]) / S; 425 | rx := 0.25 * S; 426 | ry := (m[0,1] + m[1,0]) / S; 427 | rz := (m[0,2] + m[2,0]) / S; 428 | end else if (m[1,1] > m[2,2]) then begin 429 | S := sqrt(1.0 + m[1,1] - m[0,0] - m[2,2]) * 2; // S:=4*ry 430 | rw := (m[0,2] - m[2,0]) / S; 431 | rx := (m[0,1] + m[1,0]) / S; 432 | ry := 0.25 * S; 433 | rz := (m[1,2] + m[2,1]) / S; 434 | end else begin 435 | S := sqrt(1.0 + m[2,2] - m[0,0] - m[1,1]) * 2; // S:=4*rz 436 | rw := (m[1,0] - m[0,1]) / S; 437 | rx := (m[0,2] + m[2,0]) / S; 438 | ry := (m[1,2] + m[2,1]) / S; 439 | rz := 0.25 * S; 440 | end; 441 | end; 442 | 443 | function GetTempDir: string; 444 | var 445 | n: dword; 446 | p: PChar; 447 | begin 448 | n := MAX_PATH; 449 | p := stralloc(n); 450 | gettemppath(n, p); 451 | Result := strpas(p); 452 | strdispose(p); 453 | end; 454 | 455 | { TGTAMAP } 456 | 457 | procedure TGTAMAP.loadcolldata(collfileidx: integer; inimg: integer); 458 | var 459 | i, j: integer; 460 | filebuff: Tmemorystream; 461 | lws: longword; 462 | name: array[0..23] of char; // srsly steve :S 463 | namelc: string; 464 | fcc: array [0..3] of char; 465 | bounds: TBounds; 466 | opos: integer; 467 | lastofs: integer; 468 | begin 469 | filebuff:= Tmemorystream.create; 470 | filebuff.size:= IMGGetThisFile( collfileidx ).sizeblocks * 2048; 471 | IMGExportBuffer(collfileidx, filebuff.Memory); 472 | 473 | repeat 474 | lastofs:= filebuff.Position; 475 | filebuff.Read(fcc, 4); 476 | filebuff.Read(lws, 4); 477 | opos:= filebuff.Position; 478 | filebuff.Read(name, sizeof(name)); 479 | 480 | namelc:= lowercase(trim(name)); 481 | 482 | if ((fcc = 'COL3') or (fcc = 'COL2') or (fcc = 'COLL')) then 483 | filebuff.Read(bounds, sizeof(bounds)) 484 | else begin 485 | if trim(fcc) = '' then break; 486 | showmessage(trim(fcc) + ' -> ' + namelc + ' -> ' + IMGGetFileName(collfileidx)); 487 | end; 488 | 489 | i:= idetable.IndexOfname(namelc, true); 490 | if i <> -1 then begin 491 | with idetable.items[i].ObjectRef as TIDEinforecord do begin 492 | 493 | // outputdebugstring(pchar(format('ide %d name %s (%0.4f,%0.4f,%0.4f) radius %0.4f', [ideidx, namelc, bounds.center[0], bounds.center[1], bounds.center[2], bounds.radius ]))); 494 | 495 | collbounds:= bounds; 496 | 497 | collectionname:= IMGGetThisFile( collfileidx ).Name; 498 | collectionfileindex:= collfileidx; 499 | 500 | imgindex:= inimg; 501 | 502 | collname:= namelc; 503 | collmodelindex:= i; 504 | 505 | colloffset:= lastofs; 506 | 507 | gotcollbounds:= true; 508 | end; 509 | end; 510 | 511 | filebuff.Position:= opos; 512 | filebuff.Seek(lws, soFromCurrent); 513 | 514 | until filebuff.Position >= filebuff.Size; 515 | 516 | filebuff.Free; 517 | end; 518 | 519 | 520 | procedure TGTAMAP.loadcolors(colorfile: string); 521 | var 522 | ls: Tstrings; 523 | i, ii: integer; 524 | insection: string; 525 | 526 | function transf(i: integer): integer; 527 | begin 528 | Result := i - 1; 529 | if Result = -1 then 530 | Result := 3; 531 | end; 532 | 533 | begin 534 | 535 | ls:= Tstringlist.create; 536 | 537 | ls.loadfromfile(colorfile); 538 | 539 | colors := Tcarcolsfile.Create; 540 | colors.colorcount := 0; 541 | colors.carcount := 0; 542 | 543 | insection := 'NULL'; 544 | 545 | for i := 0 to ls.Count - 1 do 546 | begin 547 | if ls[i] = 'col' then 548 | insection := 'col' 549 | else 550 | if ls[i] = 'car' then 551 | insection := 'car' 552 | else 553 | if ls[i] = 'car4' then 554 | insection := 'car4' 555 | else 556 | if ls[i] = 'end' then 557 | continue 558 | else // skip these 559 | begin 560 | textparser.setworkspace(textparser. 561 | stripcomments('#', ls[i])); 562 | 563 | if textparser.foo.Count <> 0 then // if nothing was left of the text after stripping comments don't do this code 564 | with colors do 565 | begin 566 | 567 | if insection = 'col' then 568 | begin // colors are being parsed 569 | colors[colorcount] := rgb(textparser.intindex(0), textparser.intindex(1), textparser.intindex(2)); 570 | colorcount := colorcount + 1; 571 | end; 572 | 573 | if insection = 'car' then 574 | begin // colors are being parsed 575 | cars[carcount] := Tcarcolored.Create; 576 | cars[carcount].carname := textparser.indexed(0); 577 | cars[carcount].colorcount := 0; // no colors yet 578 | cars[carcount].car4 := False; 579 | 580 | for ii := 1 to textparser.foo.Count do 581 | cars[carcount].colors[(ii - 1) div 2][integer(not boolean((ii mod 2)))] := textparser.intindex(ii); 582 | 583 | cars[carcount].colorcount := (textparser.foo.Count - 1); // set color count 584 | 585 | carcount := carcount + 1; 586 | 587 | end; 588 | 589 | // car4 590 | if insection = 'car4' then 591 | begin // colors are being parsed 592 | cars[carcount] := Tcarcolored.Create; 593 | cars[carcount].carname := textparser.indexed(0); 594 | cars[carcount].colorcount := 0; // no colors yet 595 | cars[carcount].car4 := True; 596 | 597 | for ii := 1 to textparser.foo.Count do 598 | cars[carcount].colors[(ii - 1) div 4][transf(ii mod 4)] := textparser.intindex(ii); 599 | 600 | cars[carcount].colorcount := (textparser.foo.Count div 2); // set color count 601 | 602 | carcount := carcount + 1; 603 | 604 | end; 605 | // end car4 606 | 607 | end; 608 | 609 | end; 610 | end; 611 | 612 | ls.free; 613 | 614 | end; 615 | 616 | procedure TGTAMAP.loadfile(typ, filen: string; secondarybinipl: boolean); 617 | var 618 | binipl: integer; 619 | z: integer; 620 | streamname: string; 621 | begin 622 | if typ = 'IPL' then 623 | begin 624 | setlength(ipl, length(ipl) + 1); 625 | ipl[high(ipl)] := TIPLFILE.Create; 626 | 627 | if secondarybinipl = false then begin 628 | ipl[high(ipl)].loadfromfile(filen); 629 | 630 | // check img #1 631 | for z:= 0 to 30 do begin 632 | streamname:= lowercase(extractfilename(changefileext(filen, '')) + '_stream' + inttostr(z) + '.ipl'); 633 | 634 | // outputdebugstring(pchar(streamname)); 635 | 636 | binipl:= imglist[0].IndexOf(streamname); 637 | 638 | if binipl <> -1 then begin 639 | 640 | u_edit.GtaEditor.imgipls.lines.add(streamname); 641 | 642 | IMGLoadImg(pchar(city.imgfile[0])); 643 | // todo: should IMGExportBuffer() for speed.. 644 | IMGExportFile(binipl, PChar(GetTempDir + '\' + streamname)); 645 | 646 | // failures here? maybe you are out of drive space in temp. 647 | 648 | ipl[high(ipl)].loadfrombinfile(PChar(GetTempDir + '\' + streamname)); 649 | 650 | deletefile(PChar(GetTempDir + '\' + streamname)); 651 | end;// else break; 652 | end; 653 | 654 | // check img #2 655 | for z:= 0 to 20 do begin 656 | streamname:= lowercase(extractfilename(changefileext(filen, '')) + '_stream' + inttostr(z) + '.ipl'); 657 | 658 | if imglist[1] = nil then continue; // wtf? 659 | 660 | binipl:= imglist[1].IndexOf(streamname); 661 | 662 | if binipl <> -1 then begin 663 | 664 | u_edit.GtaEditor.imgipls.lines.add(streamname); 665 | 666 | IMGLoadImg(pchar(city.imgfile[1])); 667 | IMGExportFile(binipl, PChar(GetTempDir + '\' + streamname)); 668 | 669 | ipl[high(ipl)].loadfrombinfile(PChar(GetTempDir + '\' + streamname)); 670 | 671 | deletefile(PChar(GetTempDir + '\' + streamname)); 672 | end else break; 673 | end; 674 | 675 | end else begin 676 | ipl[high(ipl)].loadfrombinfile(filen); 677 | 678 | end; 679 | 680 | end 681 | else 682 | if typ = 'IDE' then 683 | begin 684 | setlength(ide, length(ide) + 1); 685 | ide[high(ide)] := TIDEFILE.Create; 686 | ide[high(ide)].loadfromfile(filen, imglist[0]); 687 | end 688 | else 689 | begin 690 | // skip this line 691 | end; 692 | 693 | end; 694 | 695 | 696 | procedure TGTAMAP.loadimg(filen, filen2, filen3, filen4, filen5, filen6: string); 697 | { 698 | var 699 | i: integer;} 700 | 701 | procedure globimg(index: integer; filename: string); 702 | var 703 | i: integer; 704 | begin 705 | 706 | if fileexists(changefileext(filename, '.img')) = true then begin 707 | // SetFileAttributes(PChar(changefileext(filename, '.img')), FILE_ATTRIBUTE_ARCHIVE); 708 | 709 | IMGLoadImg(PChar(filename)); 710 | 711 | outputdebugstring(pchar('GLOBBING img: ' + filename)); 712 | 713 | imglist[index] := Thashedstringlist.Create; 714 | ImgList[index].Clear; 715 | ImgList[index].CaseSensitive:= false; 716 | 717 | for i := 0 to IMGFileCount - 1 do 718 | ImgList[index].add(lowercase(IMGGetThisFile(i).Name)); 719 | 720 | outputdebugstring(pchar('GLOBBING img: ' + filename + ' ADDED: total files: ' + inttostr(ImgList[index].Count))); 721 | 722 | imgfile[index]:= filename; 723 | end else begin 724 | outputdebugstring(pchar('GLOBBING img FAILURE (MISERABLE): ' + changefileext(filename, '.img'))); 725 | end; 726 | 727 | end; 728 | 729 | begin 730 | 731 | globimg(5, filen6); 732 | globimg(4, filen5); 733 | globimg(3, filen4); 734 | globimg(2, filen3); 735 | globimg(1, filen2); 736 | globimg(0, filen); 737 | 738 | { 739 | // img 3 740 | 741 | if fileexists(changefileext(filen4, '.img')) = true then begin 742 | SetFileAttributes(PChar(changefileext(filen4, '.img')), FILE_ATTRIBUTE_ARCHIVE); 743 | 744 | IMGLoadImg(PChar(filen4)); 745 | 746 | if imglist[3] = nil then imglist[3] := Thashedstringlist.Create; 747 | ImgList[3].Clear; 748 | ImgList[3].CaseSensitive:= false; 749 | 750 | 751 | for i := 0 to IMGFileCount - 1 do 752 | ImgList[3].add(lowercase(IMGGetThisFile(i).Name)); 753 | 754 | imgfile[3]:= filen4; 755 | end; 756 | 757 | 758 | // img 3 759 | 760 | if fileexists(changefileext(filen3, '.img')) = true then begin 761 | SetFileAttributes(PChar(changefileext(filen3, '.img')), FILE_ATTRIBUTE_ARCHIVE); 762 | 763 | IMGLoadImg(PChar(filen3)); 764 | 765 | if imglist[2] = nil then imglist[2] := Thashedstringlist.Create; 766 | ImgList[2].Clear; 767 | ImgList[2].CaseSensitive:= false; 768 | 769 | 770 | for i := 0 to IMGFileCount - 1 do 771 | ImgList[2].add(lowercase(IMGGetThisFile(i).Name)); 772 | 773 | imgfile[2]:= filen3; 774 | end; 775 | 776 | 777 | 778 | // img 2 779 | 780 | SetFileAttributes(PChar(changefileext(filen2, '.img')), FILE_ATTRIBUTE_ARCHIVE); 781 | 782 | IMGLoadImg(PChar(filen2)); 783 | 784 | if imglist[1] = nil then imglist[1] := Thashedstringlist.Create; 785 | ImgList[1].Clear; 786 | ImgList[1].CaseSensitive:= false; 787 | 788 | for i := 0 to IMGFileCount - 1 do 789 | ImgList[1].add(lowercase(IMGGetThisFile(i).Name)); 790 | 791 | imgfile[1]:= filen2; 792 | 793 | // img 1 794 | 795 | SetFileAttributes(PChar(changefileext(filen, '.img')), FILE_ATTRIBUTE_ARCHIVE); 796 | 797 | IMGLoadImg(PChar(Filen)); 798 | 799 | if imglist[0] = nil then imglist[0] := Thashedstringlist.Create; 800 | ImgList[0].Clear; 801 | ImgList[0].CaseSensitive:= false; 802 | 803 | for i := 0 to IMGFileCount - 1 do 804 | ImgList[0].add(lowercase(IMGGetThisFile(i).Name)); 805 | 806 | imgfile[0]:= filen; 807 | } 808 | end; 809 | 810 | procedure TGTAMAP.loadwater(filen: string); 811 | var 812 | waterlist: TStrings; 813 | i: integer; 814 | begin 815 | waterlist := TStringList.Create; 816 | waterlist.LoadFromFile(filen); 817 | 818 | for i:= 1 to waterlist.Count-1 do begin 819 | textparser.setworkspace(stripcomments('#', waterlist[i])); 820 | setlength(Water, length(Water) + 1); 821 | with Water[high(Water)] do begin 822 | vertices[0].pos[0]:= textparser.fltindex(0); 823 | vertices[0].pos[1]:= textparser.fltindex(1); 824 | vertices[0].pos[2]:= textparser.fltindex(2); 825 | 826 | vertices[1].pos[0]:= textparser.fltindex(7*1 + 0); 827 | vertices[1].pos[1]:= textparser.fltindex(7*1 + 1); 828 | vertices[1].pos[2]:= textparser.fltindex(7*1 + 2); 829 | 830 | vertices[2].pos[0]:= textparser.fltindex(7*2 + 0); 831 | vertices[2].pos[1]:= textparser.fltindex(7*2 + 1); 832 | vertices[2].pos[2]:= textparser.fltindex(7*2 + 2); 833 | 834 | if textparser.foo.Count = 29 then begin 835 | vertices[3].pos[0]:= textparser.fltindex(7*3 + 0); 836 | vertices[3].pos[1]:= textparser.fltindex(7*3 + 1); 837 | vertices[3].pos[2]:= textparser.fltindex(7*3 + 2); 838 | param:= textparser.intindex(29); 839 | end else begin 840 | vertices[3].pos[0]:= textparser.fltindex(7*1 + 0); 841 | vertices[3].pos[1]:= textparser.fltindex(7*1 + 1); 842 | vertices[3].pos[2]:= textparser.fltindex(7*1 + 2); 843 | param:= textparser.intindex(22); 844 | end; 845 | end; 846 | end; 847 | 848 | waterlist.free; 849 | end; 850 | 851 | { TIPLFILE } 852 | 853 | procedure TIPLFILE.loadfromfile(filen: string); 854 | var 855 | ipllist: TStrings; 856 | i: integer; 857 | insection: string; 858 | begin 859 | 860 | Bounds[0] := NullVector; 861 | Bounds[1] := NullVector; 862 | 863 | filename := filen; 864 | 865 | if pos('path', filen) > 0 then 866 | begin 867 | // we ignore paths to speed up loading. 868 | exit; 869 | end; 870 | 871 | ipllist := TStringList.Create; 872 | ipllist.LoadFromFile(filen); 873 | 874 | insection := ''; 875 | 876 | for i := 0 to ipllist.Count - 1 do 877 | begin 878 | 879 | textparser.setworkspace(stripcomments('#', ipllist[i])); 880 | 881 | if trim(textparser.indexed(0)) <> '' then 882 | begin 883 | 884 | if (length(textparser.indexed(0)) <= 4) and (textparser.foo.Count = 1) then 885 | begin 886 | insection := textparser.indexed(0); 887 | Continue; // continue with next line 888 | end; 889 | 890 | if insection = 'inst' then 891 | begin 892 | 893 | setlength(InstObjects, length(InstObjects) + 1); 894 | InstObjects[high(InstObjects)] := TINST.Create; 895 | 896 | with InstObjects[high(InstObjects)] do 897 | begin 898 | 899 | LoadedModelIndex := -1; 900 | draw_distance:= 0.0; 901 | 902 | added:= false; 903 | deleted:= false; 904 | 905 | id := textparser.intindex(0); 906 | 907 | { 908 | if id = 1412 then begin 909 | showmessage(textparser.foo.GetText); 910 | end; 911 | } 912 | //name := textparser.intindex(1); 913 | 914 | int_id := textparser.intindex(2); 915 | if int_id > 17 then int_id:= 0; 916 | 917 | totalones:= totalones + 1; 918 | 919 | Location[0] := textparser.fltindex(3); 920 | Location[1] := textparser.fltindex(4); 921 | Location[2] := textparser.fltindex(5); 922 | 923 | // calculate bounding box 924 | 925 | // lowest coords 926 | if Location[0] < Bounds[0][0] then 927 | Bounds[0][0] := Location[0]; 928 | if Location[1] < Bounds[0][1] then 929 | Bounds[0][1] := Location[1]; 930 | if Location[2] < Bounds[0][2] then 931 | Bounds[0][2] := Location[2]; 932 | 933 | // highiest coords 934 | if Location[0] > Bounds[1][0] then 935 | Bounds[1][0] := Location[0]; 936 | if Location[1] > Bounds[1][1] then 937 | Bounds[1][1] := Location[1]; 938 | if Location[2] > Bounds[1][2] then 939 | Bounds[1][2] := Location[2]; 940 | 941 | rx := textparser.fltindex(6); 942 | ry := textparser.fltindex(7); 943 | rz := textparser.fltindex(8); 944 | rw := textparser.fltindex(9); 945 | lod := textparser.intindex(10); 946 | lodobject:= false; 947 | 948 | end; 949 | 950 | end 951 | 952 | else if insection = 'cull' then 953 | begin 954 | setlength(CullZones, length(CullZones) + 1); 955 | CullZones[high(CullZones)] := TCULL.Create; 956 | CullZones[high(CullZones)].startorigin[0]:= textparser.fltindex(0); 957 | CullZones[high(CullZones)].startorigin[1]:= textparser.fltindex(1); 958 | CullZones[high(CullZones)].startorigin[2]:= textparser.fltindex(2); 959 | 960 | 961 | CullZones[high(CullZones)].dimensions[0]:= textparser.fltindex(6); 962 | CullZones[high(CullZones)].dimensions[1]:= textparser.fltindex(4); 963 | CullZones[high(CullZones)].dimensions[2]:= textparser.fltindex(5); 964 | 965 | CullZones[high(CullZones)].rotation:= textparser.fltindex(3); 966 | 967 | CullZones[high(CullZones)].flags:= textparser.intindex(8); 968 | 969 | end 970 | 971 | else if insection = 'cars' then 972 | begin 973 | 974 | end 975 | else 976 | begin 977 | 978 | end; 979 | 980 | end; 981 | 982 | end; 983 | 984 | end; 985 | 986 | procedure ConvertNonNormaQuatToEuler(qw, qx, qy, qz: single; var heading, attitude, bank: single); 987 | var 988 | sqw, 989 | sqx, 990 | sqy, 991 | sqz, 992 | unt, diagonal: single; 993 | begin 994 | sqw := qw*qw; 995 | sqx := qx*qx; 996 | sqy := qy*qy; 997 | sqz := qz*qz; 998 | unt := sqx + sqy + sqz + sqw; 999 | 1000 | diagonal := qx*qy + qz*qw; 1001 | 1002 | if (diagonal > 0.499 * unt) then begin 1003 | heading := 2 * ArcTan2(qx,qw); 1004 | attitude := 3.141592653/2; 1005 | bank := 0; 1006 | exit; 1007 | end; 1008 | 1009 | if (diagonal < -0.499 * unt) then begin 1010 | heading := -2*ArcTan2(qx,qw); 1011 | attitude := -3.141592653/2; 1012 | bank := 0; 1013 | exit; 1014 | end; 1015 | 1016 | heading := ArcTan2(2*qy*qw - 2*qx*qz, sqx - sqy - sqz + sqw); 1017 | 1018 | if (heading < 0) then 1019 | heading := 0 - heading 1020 | else heading := 360 - heading; 1021 | attitude := ArcSin(2*diagonal / unt); 1022 | bank := ArcTan2(2*qx*qw - 2*qy*qz, -sqx + sqy - sqz + sqw); 1023 | 1024 | end; 1025 | 1026 | 1027 | 1028 | procedure TIPLFILE.loadfrombinfile(filen: string); 1029 | var 1030 | ipllist: TStrings; 1031 | i: integer; 1032 | insection: string; 1033 | f: Tmemorystream; 1034 | iplstruct: Tiplstruct; 1035 | iplinst: Tiplinst; 1036 | iplcars: Tiplcars; 1037 | begin 1038 | 1039 | f:= Tmemorystream.create; 1040 | f.loadfromfile(filen); 1041 | f.read(iplstruct, sizeof(iplstruct)); 1042 | 1043 | if iplstruct.instptr <> 0 then begin 1044 | f.position:= iplstruct.instptr; 1045 | 1046 | for i:= 0 to iplstruct.instcount-1 do begin 1047 | f.read(iplinst, sizeof(iplinst)); 1048 | 1049 | setlength(InstObjects, length(InstObjects) + 1); 1050 | InstObjects[high(InstObjects)] := TINST.Create; 1051 | 1052 | with InstObjects[high(InstObjects)] do 1053 | begin 1054 | 1055 | LoadedModelIndex := -1; 1056 | draw_distance:= 0.0; 1057 | 1058 | added:= false; 1059 | deleted:= false; 1060 | 1061 | // OutputDebugString(pchar(inttostr(iplinst.objectid))); 1062 | 1063 | id := iplinst.objectid; 1064 | 1065 | { 1066 | if id = 1412 then begin 1067 | showmessage(inttostr(iplinst.lod)); 1068 | end; 1069 | } 1070 | int_id := iplinst.interiorid; 1071 | if int_id > 17 then int_id:= 0; 1072 | 1073 | Location[0] := iplinst.x; 1074 | Location[1] := iplinst.y; 1075 | Location[2] := iplinst.z; 1076 | totalones:= totalones + 1; 1077 | 1078 | // if id = 9698 then showmessage(format('%f %f %f', [Location[0], Location[1], Location[2]])); 1079 | 1080 | // calculate bounding box 1081 | 1082 | // lowest coords 1083 | if Location[0] < Bounds[0][0] then 1084 | Bounds[0][0] := Location[0]; 1085 | if Location[1] < Bounds[0][1] then 1086 | Bounds[0][1] := Location[1]; 1087 | if Location[2] < Bounds[0][2] then 1088 | Bounds[0][2] := Location[2]; 1089 | 1090 | // highiest coords 1091 | if Location[0] > Bounds[1][0] then 1092 | Bounds[1][0] := Location[0]; 1093 | if Location[1] > Bounds[1][1] then 1094 | Bounds[1][1] := Location[1]; 1095 | if Location[2] > Bounds[1][2] then 1096 | Bounds[1][2] := Location[2]; 1097 | 1098 | rx := iplinst.qx; 1099 | ry := iplinst.qy; 1100 | rz := iplinst.qz; 1101 | rw := iplinst.qw; 1102 | 1103 | ConvertNonNormaQuatToEuler(rx, ry, rz, rw, rux, ruy, ruz); 1104 | 1105 | lod := iplinst.lod; 1106 | lodobject:= false; 1107 | 1108 | 1109 | end; 1110 | 1111 | //ipltext.lines.add(format( '%d, %s, %d, %f, %f, %f, %f, %f, %f, %f, %d', [iplinst.objectid, 'object' + inttostr(iplinst.objectid), iplinst.interiorid, iplinst.x, iplinst.y, iplinst.z, iplinst.qx, iplinst.qy, iplinst.qz, iplinst.qw, iplinst.flags] )); 1112 | end; 1113 | end; 1114 | 1115 | { 1116 | if iplstruct.carsptr <> 0 then begin 1117 | f.position:= iplstruct.carsptr; 1118 | for i:= 0 to iplstruct.carscount-1 do begin 1119 | f.read(iplcars, sizeof(iplcars)); 1120 | //ipltext.lines.add(format( '%d, %f, %f, %f, %f', [iplcars.objectid, iplcars.x, iplcars.y, iplcars.z, iplcars.angle ] )); 1121 | end; 1122 | end; 1123 | } 1124 | { 1125 | if iplstruct.cullptr <> 0 then ipltext.lines.add('cull found but don''t know how to handle it'); 1126 | if iplstruct.pathptr <> 0 then ipltext.lines.add('path found but don''t know how to handle it'); 1127 | if iplstruct.grgeptr <> 0 then ipltext.lines.add('grge found but don''t know how to handle it'); 1128 | if iplstruct.enexptr <> 0 then ipltext.lines.add('enex found but don''t know how to handle it'); 1129 | if iplstruct.pickptr <> 0 then ipltext.lines.add('pick found but don''t know how to handle it'); 1130 | if iplstruct.jumpptr <> 0 then ipltext.lines.add('jump found but don''t know how to handle it'); 1131 | if iplstruct.tcycptr <> 0 then ipltext.lines.add('tcyc found but don''t know how to handle it'); 1132 | if iplstruct.auzoptr <> 0 then ipltext.lines.add('auzo found but don''t know how to handle it'); 1133 | if iplstruct.multptr <> 0 then ipltext.lines.add('mult found but don''t know how to handle it'); 1134 | if iplstruct.U1 <> 0 then ipltext.lines.add('additionally this file contains unknown data.'); 1135 | } 1136 | 1137 | f.free; 1138 | 1139 | end; 1140 | 1141 | procedure TIPLFILE.processlodinfo; 1142 | var 1143 | i: integer; 1144 | 1145 | function anylods(cid: integer): boolean; 1146 | var j: integer; 1147 | begin 1148 | result:= false; 1149 | 1150 | for j:= 0 to high(InstObjects) do begin 1151 | if InstObjects[j].lod = cid then begin result:= true; break; end; 1152 | end; 1153 | end; 1154 | 1155 | begin 1156 | 1157 | for i:= 0 to high(InstObjects) do begin 1158 | InstObjects[i].haslod:= anylods(i); // this object is a sub-lod 1159 | InstObjects[i].rootlod:= not InstObjects[i].haslod; // this object has no sub-lods and is alone 1160 | 1161 | if InstObjects[i].lod <> -1 then 1162 | InstObjects[InstObjects[i].lod].lodobject:= True; 1163 | 1164 | end; 1165 | 1166 | end; 1167 | 1168 | { TIDEFILE } 1169 | 1170 | procedure TIDEFILE.loadfromfile(filen: string; imglist: tstrings); 1171 | var 1172 | idelist: TStrings; 1173 | i, j, o: integer; 1174 | insection: string; 1175 | begin 1176 | 1177 | idelist := TStringList.Create; 1178 | idelist.LoadFromFile(filen); 1179 | 1180 | insection := ''; 1181 | 1182 | for i := 0 to idelist.Count - 1 do 1183 | begin 1184 | 1185 | textparser.setworkspace(stripcomments('#', idelist[i])); 1186 | 1187 | //outputdebugstring(pchar(textparser.foo.GetText)); 1188 | 1189 | if trim(textparser.indexed(0)) <> '' then 1190 | begin 1191 | 1192 | if (length(textparser.indexed(0)) <= 4) and (textparser.foo.Count = 1) then 1193 | begin 1194 | insection := textparser.indexed(0); 1195 | Continue; // continue with next line 1196 | end; 1197 | 1198 | if 1199 | 1200 | (insection = 'peds') or (insection = 'cars') or (insection = 'hier') or (insection = 'weap') or 1201 | 1202 | (insection = 'objs') or (insection = 'tobj') or (insection = 'anim') then 1203 | begin // threat both as one type of data, no need to make things harder.. 1204 | 1205 | setlength(Objects, length(Objects) + 1); 1206 | Objects[high(Objects)] := TOBJS.Create; 1207 | 1208 | with Objects[high(Objects)] do 1209 | begin 1210 | 1211 | for o:= 0 to textparser.foo.Count-1 do begin 1212 | textparser.foo[o]:= StringReplace(textparser.foo[o], ',', '', [rfReplaceAll]); 1213 | end; 1214 | 1215 | ID := textparser.intindex(0); 1216 | 1217 | mainidelist[ID] := Objects[high(Objects)]; 1218 | 1219 | //ID:= 1411; 1220 | //if ID >= 1411 then if id <= 1413 then GtaEditor.Memo1.lines.add('IDE fence: ' + textparser.indexed(1)); 1221 | { 1222 | ModelName := 'DYN_MESH_2'; //textparser.indexed(1); 1223 | TextureName := 'BREAK_FEN_mesh'; //textparser.indexed(2); 1224 | } 1225 | 1226 | ModelName := lowercase(textparser.indexed(1)); 1227 | TextureName := lowercase(textparser.indexed(2)); 1228 | 1229 | //u_edit.GtaEditor.Memo1.lines.add(TextureName); 1230 | 1231 | if insection = 'objs' then begin 1232 | DrawDist := textparser.intindex(3); 1233 | Flags := textparser.intindex(4); 1234 | end; 1235 | 1236 | if insection = 'anim' then begin 1237 | DrawDist := textparser.intindex(4); 1238 | Flags := textparser.intindex(5); 1239 | //TextureName := lowercase(textparser.indexed(3)); 1240 | end; 1241 | 1242 | if insection = 'tobj' then begin 1243 | TimeOn := textparser.intindex(5); 1244 | TimeOff := textparser.intindex(6); 1245 | end; 1246 | end; 1247 | 1248 | end 1249 | else if insection = 'txdp' then 1250 | begin 1251 | setlength(TexReplace, length(TexReplace) + 1); 1252 | TexReplace[high(TexReplace)] := TTXDP.Create; 1253 | TexReplace[high(TexReplace)].fromtxd := textparser.indexed(0); 1254 | TexReplace[high(TexReplace)].totxd := textparser.indexed(1); 1255 | 1256 | // u_edit.GtaEditor.Memo1.lines.add('TXDP: ' + TexReplace[high(TexReplace)].fromtxd + ' - ' + TexReplace[high(TexReplace)].totxd); 1257 | 1258 | end 1259 | 1260 | else 1261 | begin 1262 | 1263 | end; 1264 | 1265 | end; 1266 | 1267 | end; 1268 | 1269 | end; 1270 | 1271 | { TINST } 1272 | 1273 | constructor TINST.create; 1274 | begin 1275 | rux:= 0; 1276 | ruy:= 0; 1277 | ruz:= 0; 1278 | end; 1279 | 1280 | procedure TINST.SetGTARotation(x, y, z: single); 1281 | var 1282 | tma, tmn: TMatrix3f; 1283 | a, b: integer; 1284 | ms: Tmemorystream; 1285 | begin 1286 | 1287 | rux:= x; 1288 | ruy:= y; 1289 | ruz:= z; 1290 | 1291 | tma:= gtarot2matrix3x3(degtorad(x), degtorad(y), degtorad(z)); 1292 | 1293 | for a := 0 to 2 do 1294 | for b := 0 to 2 do 1295 | tmn[a, b] := tma[a, b]; // transpose! 1296 | 1297 | { ms:= Tmemorystream.create; 1298 | ms.Write(tmn, sizeof(tmn)); 1299 | ms.SaveToFile('c:\tadaa.dmp');} 1300 | 1301 | matrix3f2quaternion(tmn, rx, ry, rz, rw); 1302 | end; 1303 | 1304 | var i: integer; 1305 | 1306 | initialization 1307 | 1308 | for i:= 0 to high(mainidelist) do 1309 | mainidelist[i]:= nil; 1310 | 1311 | end. 1312 | 1313 | -------------------------------------------------------------------------------- /u_addide.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/u_addide.dfm -------------------------------------------------------------------------------- /u_addide.pas: -------------------------------------------------------------------------------- 1 | unit u_addide; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls; 8 | 9 | type 10 | Twnd_addide = class(TForm) 11 | Panel5: TPanel; 12 | Image4: TImage; 13 | Edit1: TEdit; 14 | Edit2: TEdit; 15 | Label1: TLabel; 16 | Label2: TLabel; 17 | Panel1: TPanel; 18 | Image1: TImage; 19 | BitBtn9: TBitBtn; 20 | BitBtn10: TBitBtn; 21 | BitBtn1: TBitBtn; 22 | BitBtn2: TBitBtn; 23 | Edit3: TEdit; 24 | Edit4: TEdit; 25 | Label3: TLabel; 26 | procedure btn_clearClick(Sender: TObject); 27 | procedure SpeedButton1Click(Sender: TObject); 28 | procedure FormShow(Sender: TObject); 29 | procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, 30 | Y: Integer); 31 | procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; 32 | Shift: TShiftState; X, Y: Integer); 33 | procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; 34 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 35 | procedure updatepic; 36 | procedure Edit1Change(Sender: TObject); 37 | procedure BitBtn10Click(Sender: TObject); 38 | procedure BitBtn9Click(Sender: TObject); 39 | private 40 | { Private declarations } 41 | public 42 | { Public declarations } 43 | end; 44 | 45 | var 46 | wnd_addide: Twnd_addide; 47 | 48 | cameradrag: boolean = false; 49 | lastmouse: Tpoint; 50 | cammouse: Tpoint; 51 | 52 | implementation 53 | 54 | uses u_edit; 55 | 56 | {$R *.dfm} 57 | 58 | procedure Twnd_addide.btn_clearClick(Sender: TObject); 59 | begin 60 | modalresult:= mrok; 61 | end; 62 | 63 | procedure Twnd_addide.SpeedButton1Click(Sender: TObject); 64 | begin 65 | modalresult:= mrcancel; 66 | end; 67 | 68 | procedure Twnd_addide.FormShow(Sender: TObject); 69 | begin 70 | updatepic(); 71 | end; 72 | 73 | procedure Twnd_addide.Image1MouseMove(Sender: TObject; Shift: TShiftState; 74 | X, Y: Integer); 75 | begin 76 | if cameradrag = false then exit; 77 | cammouse.x:= x; 78 | cammouse.y:= y; 79 | 80 | updatepic(); 81 | end; 82 | 83 | procedure Twnd_addide.Image1MouseUp(Sender: TObject; Button: TMouseButton; 84 | Shift: TShiftState; X, Y: Integer); 85 | begin 86 | cameradrag:= false; 87 | end; 88 | 89 | procedure Twnd_addide.FormMouseWheel(Sender: TObject; Shift: TShiftState; 90 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 91 | begin 92 | if ssCtrl in Shift then zoomadd:= zoomadd + (wheeldelta) 93 | else zoomadd:= zoomadd + (wheeldelta / 80); 94 | 95 | updatepic(); 96 | end; 97 | 98 | procedure Twnd_addide.updatepic; 99 | begin 100 | //try 101 | rota:= lastmouse.x - cammouse.x; 102 | rotb:= lastmouse.y - cammouse.y; 103 | 104 | u_edit.prefabrenderid:= inttostr(strtointdef(Edit1.text, 500)); 105 | 106 | GtaEditor.BitBtn1Click(GtaEditor.BitBtn1); 107 | 108 | if fileexists(extractfiledir(application.exename)+'\PrefabPics\' + u_edit.prefabrenderid + '.bmp') then 109 | Image1.picture.LoadFromFile((extractfiledir(application.exename)+'\PrefabPics\' + u_edit.prefabrenderid + '.bmp')); 110 | 111 | application.processmessages; 112 | //except end; 113 | end; 114 | 115 | procedure Twnd_addide.Edit1Change(Sender: TObject); 116 | begin 117 | updatepic(); 118 | end; 119 | 120 | procedure Twnd_addide.BitBtn10Click(Sender: TObject); 121 | begin 122 | Edit1.Text:= inttostr(strtoint(Edit1.text) + 1); 123 | updatepic(); 124 | end; 125 | 126 | procedure Twnd_addide.BitBtn9Click(Sender: TObject); 127 | begin 128 | Edit1.Text:= inttostr(strtoint(Edit1.text) - 1); 129 | if (strtoint(Edit1.Text) < 0) then 130 | Edit1.Text:= '0'; 131 | updatepic(); 132 | end; 133 | 134 | end. 135 | -------------------------------------------------------------------------------- /u_advedit.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JernejL/samp-map-editor/85d900e93a670d2c92acb79314c870307f0b6a2f/u_advedit.dfm -------------------------------------------------------------------------------- /u_advedit.pas: -------------------------------------------------------------------------------- 1 | unit u_advedit; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, CheckLst, SynEdit, SynMemo; 8 | 9 | type 10 | Twnd_advinfo = class(TForm) 11 | Edit1: TEdit; 12 | list_dfftextures: TSynMemo; 13 | Edit2: TEdit; 14 | Label1: TLabel; 15 | Label2: TLabel; 16 | Label3: TLabel; 17 | txdtextures: TSynMemo; 18 | Edit3: TEdit; 19 | Label4: TLabel; 20 | Label5: TLabel; 21 | BitBtn1: TBitBtn; 22 | Label6: TLabel; 23 | Edit4: TEdit; 24 | labelother: TLabel; 25 | ideflags: TCheckListBox; 26 | Label7: TLabel; 27 | extras: TSynMemo; 28 | procedure BitBtn1Click(Sender: TObject); 29 | procedure list_dfftexturesClick(Sender: TObject); 30 | procedure list_dfftexturesChange(Sender: TObject); 31 | private 32 | { Private declarations } 33 | public 34 | { Public declarations } 35 | end; 36 | 37 | var 38 | wnd_advinfo: Twnd_advinfo; 39 | 40 | implementation 41 | 42 | {$R *.dfm} 43 | 44 | procedure Twnd_advinfo.BitBtn1Click(Sender: TObject); 45 | begin 46 | hide; 47 | end; 48 | 49 | procedure Twnd_advinfo.list_dfftexturesClick(Sender: TObject); 50 | var 51 | line: integer; 52 | begin 53 | Line := Perform(EM_LINEFROMCHAR, 0, 0) ; 54 | end; 55 | 56 | procedure Twnd_advinfo.list_dfftexturesChange(Sender: TObject); 57 | begin 58 | //list_dfftextures.Lines[list_dfftextures.CaretY] 59 | end; 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /u_carcolors.dfm: -------------------------------------------------------------------------------- 1 | object wnd_carcolorpicker: Twnd_carcolorpicker 2 | Left = 2016 3 | Top = 63 4 | BorderIcons = [biSystemMenu] 5 | BorderStyle = bsDialog 6 | Caption = 'Car Colors' 7 | ClientHeight = 449 8 | ClientWidth = 202 9 | Color = clBtnFace 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'MS Sans Serif' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | Position = poMainFormCenter 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object DrawGrid1: TDrawGrid 20 | Left = 3 21 | Top = 30 22 | Width = 196 23 | Height = 196 24 | ColCount = 16 25 | Ctl3D = False 26 | DefaultColWidth = 12 27 | DefaultRowHeight = 12 28 | FixedCols = 0 29 | RowCount = 16 30 | FixedRows = 0 31 | GridLineWidth = 0 32 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goThumbTracking] 33 | ParentCtl3D = False 34 | ScrollBars = ssNone 35 | TabOrder = 0 36 | OnClick = DrawGrid1Click 37 | OnDrawCell = DrawGrid1DrawCell 38 | end 39 | object CheckBox1: TCheckBox 40 | Left = 3 41 | Top = 9 42 | Width = 196 43 | Height = 17 44 | Caption = 'Use Random Primary Color' 45 | TabOrder = 1 46 | OnClick = DrawGrid1Click 47 | end 48 | object DrawGrid2: TDrawGrid 49 | Left = 3 50 | Top = 250 51 | Width = 196 52 | Height = 196 53 | ColCount = 16 54 | Ctl3D = False 55 | DefaultColWidth = 12 56 | DefaultRowHeight = 12 57 | FixedCols = 0 58 | RowCount = 16 59 | FixedRows = 0 60 | GridLineWidth = 0 61 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goThumbTracking] 62 | ParentCtl3D = False 63 | ScrollBars = ssNone 64 | TabOrder = 2 65 | OnClick = DrawGrid1Click 66 | OnDrawCell = DrawGrid1DrawCell 67 | end 68 | object CheckBox2: TCheckBox 69 | Left = 3 70 | Top = 229 71 | Width = 196 72 | Height = 17 73 | Caption = 'Use Random Secondary Color' 74 | TabOrder = 3 75 | OnClick = DrawGrid1Click 76 | end 77 | end 78 | -------------------------------------------------------------------------------- /u_carcolors.pas: -------------------------------------------------------------------------------- 1 | unit u_carcolors; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, Grids, StdCtrls, Buttons, ExtCtrls; 8 | 9 | type 10 | Twnd_carcolorpicker = class(TForm) 11 | DrawGrid1: TDrawGrid; 12 | CheckBox1: TCheckBox; 13 | DrawGrid2: TDrawGrid; 14 | CheckBox2: TCheckBox; 15 | procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 16 | Rect: TRect; State: TGridDrawState); 17 | procedure DrawGrid1Click(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | var 25 | wnd_carcolorpicker: Twnd_carcolorpicker; 26 | 27 | implementation 28 | 29 | uses u_edit; 30 | 31 | {$R *.dfm} 32 | 33 | procedure Twnd_carcolorpicker.DrawGrid1DrawCell(Sender: TObject; ACol, 34 | ARow: Integer; Rect: TRect; State: TGridDrawState); 35 | begin 36 | if u_edit.city = nil then exit; 37 | 38 | (sender as TDrawGrid).canvas.Brush.color:= city.colors.colors[arow * 16 + acol]; 39 | (sender as TDrawGrid).Canvas.FillRect(rect); 40 | end; 41 | 42 | procedure Twnd_carcolorpicker.DrawGrid1Click(Sender: TObject); 43 | begin 44 | u_edit.gtaeditor.inp_coordseditchange(u_edit.gtaeditor.inp_coordsedit); 45 | end; 46 | 47 | end. 48 | -------------------------------------------------------------------------------- /u_report.dfm: -------------------------------------------------------------------------------- 1 | object wnd_report: Twnd_report 2 | Left = 405 3 | Top = 140 4 | Width = 577 5 | Height = 517 6 | Caption = 'wnd_report' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | FormStyle = fsStayOnTop 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | Scaled = False 17 | DesignSize = ( 18 | 569 19 | 490) 20 | PixelsPerInch = 96 21 | TextHeight = 13 22 | object Label43: TLabel 23 | Left = 3 24 | Top = 291 25 | Width = 563 26 | Height = 17 27 | Anchors = [akLeft, akTop, akRight] 28 | AutoSize = False 29 | Caption = ' Describe the problem:' 30 | Color = clInactiveCaption 31 | Font.Charset = ANSI_CHARSET 32 | Font.Color = clInactiveCaptionText 33 | Font.Height = -11 34 | Font.Name = 'Tahoma' 35 | Font.Style = [fsBold] 36 | ParentColor = False 37 | ParentFont = False 38 | Layout = tlCenter 39 | end 40 | object Label1: TLabel 41 | Left = 317 42 | Top = 462 43 | Width = 211 44 | Height = 13 45 | Caption = '^ First write a report into field above.' 46 | Font.Charset = DEFAULT_CHARSET 47 | Font.Color = clRed 48 | Font.Height = -11 49 | Font.Name = 'MS Sans Serif' 50 | Font.Style = [fsBold] 51 | ParentFont = False 52 | end 53 | object reports: TMemo 54 | Left = 3 55 | Top = 4 56 | Width = 563 57 | Height = 283 58 | Anchors = [akLeft, akTop, akRight] 59 | Lines.Strings = ( 60 | 'reports') 61 | ReadOnly = True 62 | TabOrder = 0 63 | WordWrap = False 64 | end 65 | object reportuser: TMemo 66 | Left = 3 67 | Top = 313 68 | Width = 563 69 | Height = 142 70 | Anchors = [akLeft, akTop, akRight, akBottom] 71 | Color = 7012351 72 | Lines.Strings = ( 73 | 74 | 'Please write your email address and describe the problem you hav' + 75 | 'e with the program.') 76 | TabOrder = 1 77 | WordWrap = False 78 | OnChange = reportuserChange 79 | end 80 | object btn_send: TBitBtn 81 | Left = 237 82 | Top = 462 83 | Width = 75 84 | Height = 25 85 | Anchors = [akBottom] 86 | Caption = 'Send report!' 87 | Enabled = False 88 | TabOrder = 2 89 | OnClick = btn_sendClick 90 | end 91 | end 92 | -------------------------------------------------------------------------------- /u_report.pas: -------------------------------------------------------------------------------- 1 | unit u_report; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, WinInet; 8 | 9 | type 10 | Twnd_report = class(TForm) 11 | reports: TMemo; 12 | reportuser: TMemo; 13 | Label43: TLabel; 14 | btn_send: TBitBtn; 15 | Label1: TLabel; 16 | procedure btn_sendClick(Sender: TObject); 17 | procedure reportuserChange(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | var 25 | wnd_report: Twnd_report; 26 | 27 | implementation 28 | 29 | uses U_main; 30 | 31 | {$R *.dfm} 32 | 33 | function GetUrlContent(const Url: string): string; 34 | var 35 | NetHandle: HINTERNET; 36 | UrlHandle: HINTERNET; 37 | Buffer: array[0..1024] of Char; 38 | BytesRead: dWord; 39 | begin 40 | Result := ''; 41 | NetHandle := InternetOpen('MapEditor', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); 42 | 43 | if Assigned(NetHandle) then 44 | begin 45 | UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0); 46 | 47 | if Assigned(UrlHandle) then 48 | { UrlHandle valid? Proceed with download } 49 | begin 50 | FillChar(Buffer, SizeOf(Buffer), 0); 51 | repeat 52 | Result := Result + Buffer; 53 | FillChar(Buffer, SizeOf(Buffer), 0); 54 | InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead); 55 | until BytesRead = 0; 56 | InternetCloseHandle(UrlHandle); 57 | end 58 | else 59 | { UrlHandle is not valid. Raise an exception. } 60 | raise Exception.CreateFmt('Cannot open URL %s', [Url]); 61 | 62 | InternetCloseHandle(NetHandle); 63 | end 64 | else 65 | { NetHandle is not valid. Raise an exception } 66 | raise Exception.Create('Unable to initialize Wininet'); 67 | end; 68 | 69 | function GetComputerNetName: string; 70 | var 71 | buffer: array[0..255] of char; 72 | size: dword; 73 | begin 74 | size := 256; 75 | if GetComputerName(buffer, size) then 76 | Result := buffer 77 | else 78 | Result := '' 79 | end; 80 | 81 | Function GetUserFromWindows: string; 82 | Var 83 | UserName : string; 84 | UserNameLen : Dword; 85 | Begin 86 | UserNameLen := 255; 87 | SetLength(userName, UserNameLen) ; 88 | If GetUserName(PChar(UserName), UserNameLen) Then 89 | Result := Copy(UserName,1,UserNameLen - 1) 90 | Else 91 | Result := 'Unknown'; 92 | End; 93 | 94 | procedure Twnd_report.btn_sendClick(Sender: TObject); 95 | var 96 | send: string; 97 | CanonicalURL: pchar; 98 | CanonicalURL2: pchar; 99 | CanonicalURL3: pchar; 100 | size: integer; 101 | fullurl: string; 102 | begin 103 | send:= reports.lines.GetText; 104 | send:= StringReplace(send, #13, '%0d', [rfReplaceAll, rfIgnoreCase] ); 105 | Size := 3 * Length(send); 106 | getmem(CanonicalURL, size); 107 | InternetCanonicalizeUrl(PChar(send), PChar(CanonicalURL), cardinal(Size), 0 ); 108 | 109 | send:= reportuser.lines.GetText; 110 | send:= StringReplace(send, #13, '%0d', [rfReplaceAll, rfIgnoreCase] ); 111 | Size := 3 * Length(send); 112 | getmem(CanonicalURL2, size); 113 | InternetCanonicalizeUrl(PChar(send), PChar(CanonicalURL2), cardinal(Size), 0 ); 114 | 115 | send:= wnd_about.Label1.caption; 116 | send:= StringReplace(send, #13, '%0d', [rfReplaceAll, rfIgnoreCase] ); 117 | Size := 3 * Length(send); 118 | getmem(CanonicalURL3, size); 119 | InternetCanonicalizeUrl(PChar(send), PChar(CanonicalURL3), cardinal(Size), 0 ); 120 | 121 | 122 | fullurl := 'http://mathpudding.com/editor.php?user=' + GetUserFromWindows() + '&pc=' + GetComputerNetName() + '&version=' + CanonicalURL3 + '&info=' + CanonicalURL + '&describe=' + CanonicalURL2; 123 | 124 | showmessage(GetUrlContent(fullurl)); 125 | 126 | hide; 127 | end; 128 | 129 | procedure Twnd_report.reportuserChange(Sender: TObject); 130 | begin 131 | btn_send.enabled:= true; 132 | end; 133 | 134 | end. 135 | -------------------------------------------------------------------------------- /u_sowcode.dfm: -------------------------------------------------------------------------------- 1 | object wnd_showcode: Twnd_showcode 2 | Left = 998 3 | Top = 156 4 | Width = 661 5 | Height = 545 6 | Caption = 'Pawn Code' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poOwnerFormCenter 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Splitter1: TSplitter 18 | Left = 0 19 | Top = 262 20 | Width = 653 21 | Height = 3 22 | Cursor = crVSplit 23 | Align = alBottom 24 | ResizeStyle = rsUpdate 25 | end 26 | object readwriter: TMemo 27 | Left = 0 28 | Top = 27 29 | Width = 653 30 | Height = 235 31 | Align = alClient 32 | ScrollBars = ssBoth 33 | TabOrder = 0 34 | end 35 | object Panel5: TPanel 36 | Left = 0 37 | Top = 0 38 | Width = 653 39 | Height = 27 40 | Align = alTop 41 | BevelInner = bvRaised 42 | BevelOuter = bvLowered 43 | Caption = 'Panel3' 44 | TabOrder = 1 45 | object Image4: TImage 46 | Left = 2 47 | Top = 2 48 | Width = 649 49 | Height = 23 50 | Align = alClient 51 | Picture.Data = { 52 | 07544269746D617092040000424D920400000000000036040000280000000100 53 | 00001700000001000800000000005C0000000000000000000000000100000001 54 | 0000A0A0A000A2A2A200A4A4A400A7A7A700A9A9A900ABABAB00AEAEAE00B0B0 55 | B000B2B2B200B5B5B500B7B7B700B9B9B900BBBBBB00BDBDBD00BFBFBF00C2C2 56 | C200C4C4C400C6C6C600C8C8C800CACACA00CCCCCC00CFCFCF00D1D1D1000000 57 | 0000000000000000000000000000000000000000000000000000000000000000 58 | 0000000000000000000000000000000000000000000000000000000000000000 59 | 0000000000000000000000000000000000000000000000000000000000000000 60 | 0000000000000000000000000000000000000000000000000000000000000000 61 | 0000000000000000000000000000000000000000000000000000000000000000 62 | 0000000000000000000000000000000000000000000000000000000000000000 63 | 0000000000000000000000000000000000000000000000000000000000000000 64 | 0000000000000000000000000000000000000000000000000000000000000000 65 | 0000000000000000000000000000000000000000000000000000000000000000 66 | 0000000000000000000000000000000000000000000000000000000000000000 67 | 0000000000000000000000000000000000000000000000000000000000000000 68 | 0000000000000000000000000000000000000000000000000000000000000000 69 | 0000000000000000000000000000000000000000000000000000000000000000 70 | 0000000000000000000000000000000000000000000000000000000000000000 71 | 0000000000000000000000000000000000000000000000000000000000000000 72 | 0000000000000000000000000000000000000000000000000000000000000000 73 | 0000000000000000000000000000000000000000000000000000000000000000 74 | 0000000000000000000000000000000000000000000000000000000000000000 75 | 0000000000000000000000000000000000000000000000000000000000000000 76 | 0000000000000000000000000000000000000000000000000000000000000000 77 | 0000000000000000000000000000000000000000000000000000000000000000 78 | 0000000000000000000000000000000000000000000000000000000000000000 79 | 0000000000000000000000000000000000000000000000000000000000000000 80 | 0000000000000000000000000000000000000000000000000000000000000000 81 | 0000000000000000000000000000000000000000000000000000000000000000 82 | 0000000000000000000000000000000000000000000000000000000000000000 83 | 0000000000000000000000000000000000000000000000000000000000000000 84 | 0000000000000000000000000000000000000000000000000000000000000000 85 | 0000000000000000000000000000000000000000000000000000000000000000 86 | 0000000000000100000002000000030000000400000005000000060000000700 87 | 000008000000090000000A0000000B0000000C0000000D0000000E0000000F00 88 | 000010000000110000001200000013000000140000001500000016000000} 89 | Stretch = True 90 | end 91 | object btn_export: TSpeedButton 92 | Left = 1 93 | Top = 2 94 | Width = 90 95 | Height = 23 96 | Caption = 'Export .pwn' 97 | Flat = True 98 | Glyph.Data = { 99 | 06030000424D060300000000000036000000280000000F0000000F0000000100 100 | 180000000000D0020000230B0000230B00000000000000000000FF00FFFF00FF 101 | FF00FFFF00FFFF00FF000000000000000000000000000000FF00FFFF00FFFF00 102 | FFFF00FFFF00FF000000FF00FFFF00FFFF00FF000000000000444E3557694873 103 | 9D6D81BF8977B683000000000000FF00FFFF00FFFF00FF000000FF00FFFF00FF 104 | 000000515C3F5963435B6746809E6D9DC99499D5A397D8AA90D0A474B5860000 105 | 00FF00FFFF00FF000000FF00FF0000005F6A48606B4965704C65704C9AC187A5 106 | D5A29FE6B19FEBB89EEBB991D5A96DAC7E000000FF00FF000000FF00FF000000 107 | 68744F65704C65704C65704CA2C68EA6DDA9A3EDB89FEBB99FEBB99DEAB78DCE 108 | A1000000FF00FF00000000000070805771845A7D9767829E6D758F6564795B00 109 | 000061917188CA9D9EEAB89BE7B492D5A462996C000000000000000000809B6A 110 | 8AAA759AC18896C1895A7453000000FF00FF00000064916EA2E7B29EDAA89ACE 111 | 9A669366000000000000000000A7D097A1CD99A3D29F9FD09F000000FF00FFFF 112 | 00FFFF00FF000000ABD29DA4C8948FB57E536645000000000000000000A4E8AC 113 | A1E7B09CE6B298E1AF578265000000FF00FF0000005567478EAD777D97676879 114 | 524D593C000000000000000000A3F0B3A2F1B89DEAB79DEAB87FBE93547E6200 115 | 000048583D5C694865704C65704C5F6A48465036000000000000FF00FF000000 116 | A3F1BE9DEAB89DEAB899E7B391DBA78ABD84738A5E65704C65704C65704C5963 117 | 43000000FF00FF000000FF00FF000000A5F3C4A0F1BD9AE7B398E4B095E0A88F 118 | C0846E815865704C65704C606B49515C3F000000FF00FF000000FF00FFFF00FF 119 | 000000A0F1C09CF0B49AEBAF96DDA285B1786B7C546B7A5268744F5F6A480000 120 | 00FF00FFFF00FF000000FF00FFFF00FFFF00FF0000000000009AE9A69BD5978F 121 | C283778F61728259000000000000FF00FFFF00FFFF00FF000000FF00FFFF00FF 122 | FF00FFFF00FFFF00FF000000000000000000000000000000FF00FFFF00FFFF00 123 | FFFF00FFFF00FF000000} 124 | OnClick = btn_exportClick 125 | end 126 | object brn_rgen: TSpeedButton 127 | Left = 91 128 | Top = 2 129 | Width = 90 130 | Height = 23 131 | Caption = 'Rebuild' 132 | Flat = True 133 | Glyph.Data = { 134 | 36030000424D3603000000000000360000002800000010000000100000000100 135 | 18000000000000030000330B0000330B00000000000000000000FF00FFFF00FF 136 | FF00FFFF00FFFF00FF006399005F92005685003856FF00FFFF00FFFF00FFFF00 137 | FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF0069A20182C713ADFF32D5FF32 138 | D5FF027CBE005C8D003450FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF 139 | 0082C813ADFF1EBEFF17C0FF21DAFF5AFFFF86FFFF32D5FF0171AE003754FF00 140 | FFFF00FFFF00FF004F79FF00FF0198EA1AB9FF17B3FF0088D2FF00FFFF00FFFF 141 | 00FF32FDFF92FFFF32D5FF0171AE003E5FFF00FF007DC0006297FF00FF15BBFF 142 | 1AB8FF0082C8FF00FFFF00FFFF00FFFF00FFFF00FF2FFAFF92FFFF32D5FF027A 143 | BB0488CF0DA1F1005F9204A7FF4CF7FF0084CBFF00FFFF00FFFF00FFFF00FFFF 144 | 00FFFF00FFFF00FF37FFFF86FFFF32D5FF23C1FF1EB8FF005C8D3CFFFF03A3FA 145 | FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF52FFFF3CE3 146 | FF32D5FF1EB9FF005B8CC300008E0000850000850000890000910000740000FF 147 | 00FFFF00FFFF00FF0295E42BD3FF46F0FF41EAFF2BCDFF006196FF1515FF2B2B 148 | FF1E1EFF1E1EEC0C0CBE0000FF00FFFF00FFFF00FF2FF2FF73FFFF27E4FF1AD2 149 | FF15CCFF12C4FF0084CCFF1C1CFF4141FF3232FF2323CF0404FF00FFFF00FFFF 150 | 00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF990000600000FF1E1EFF4646 151 | FF3C3CFF3232BB02025F0000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00 152 | FFCB0000FF1C1C9B0000FF2F2FFF2727FF5252FF8686FF3232AE0101540000FF 153 | 00FFFF00FFFF00FFFF00FFFF00FFC80000FF1515C80101FF00FFFF7D7DE20202 154 | FF00FFFF3737FF9292FF3232AE0101590000FF00FFFF00FFFF00FFC30000FF17 155 | 17FF13139E0000FF00FFFF2B2BFF00FFFF00FFFF00FFFF2F2FFF8686FF3232BE 156 | 02029400008F0000C30101FF1A1AFF1A1AC80000FF00FFFF00FFFF00FFFF00FF 157 | FF00FFFF00FFFF00FFFF1E1EFF6161FF8686FF3232FF3232FF1A1AFF1010E801 158 | 01FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF 159 | 1E1EFF2121FF1515F10202FF00FFFF00FFFF00FFFF00FFFF00FF} 160 | OnClick = brn_rgenClick 161 | end 162 | object CheckBox1: TRadioButton 163 | Left = 275 164 | Top = 5 165 | Width = 70 166 | Height = 17 167 | Caption = 'Raw Data' 168 | TabOrder = 0 169 | OnClick = CheckBox1Click 170 | end 171 | object RadioButton1: TRadioButton 172 | Left = 187 173 | Top = 5 174 | Width = 84 175 | Height = 17 176 | Caption = 'CreateObject' 177 | Checked = True 178 | TabOrder = 1 179 | TabStop = True 180 | OnClick = CheckBox1Click 181 | end 182 | object CDO: TRadioButton 183 | Left = 350 184 | Top = 5 185 | Width = 127 186 | Height = 17 187 | Caption = 'CreateDynamicObject' 188 | TabOrder = 2 189 | OnClick = CheckBox1Click 190 | end 191 | object CheckBox2: TCheckBox 192 | Left = 483 193 | Top = 5 194 | Width = 97 195 | Height = 17 196 | Caption = 'Centered' 197 | TabOrder = 3 198 | OnClick = CheckBox2Click 199 | end 200 | end 201 | object lin_cars: TMemo 202 | Left = 0 203 | Top = 265 204 | Width = 653 205 | Height = 253 206 | Align = alBottom 207 | ScrollBars = ssBoth 208 | TabOrder = 2 209 | end 210 | object SaveDialog1: TSaveDialog 211 | Filter = '*.pwn|*.pwn' 212 | Left = 303 213 | Top = 97 214 | end 215 | end 216 | -------------------------------------------------------------------------------- /u_sowcode.pas: -------------------------------------------------------------------------------- 1 | unit u_sowcode; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, ExtCtrls; 8 | 9 | type 10 | Twnd_showcode = class(TForm) 11 | readwriter: TMemo; 12 | SaveDialog1: TSaveDialog; 13 | Panel5: TPanel; 14 | Image4: TImage; 15 | btn_export: TSpeedButton; 16 | CheckBox1: TRadioButton; 17 | RadioButton1: TRadioButton; 18 | CDO: TRadioButton; 19 | lin_cars: TMemo; 20 | Splitter1: TSplitter; 21 | CheckBox2: TCheckBox; 22 | brn_rgen: TSpeedButton; 23 | procedure btn_exportClick(Sender: TObject); 24 | procedure CheckBox1Click(Sender: TObject); 25 | procedure brn_rgenClick(Sender: TObject); 26 | procedure CheckBox2Click(Sender: TObject); 27 | private 28 | { Private declarations } 29 | public 30 | { Public declarations } 31 | end; 32 | 33 | var 34 | wnd_showcode: Twnd_showcode; 35 | 36 | implementation 37 | 38 | uses u_edit; 39 | 40 | {$R *.dfm} 41 | 42 | procedure Twnd_showcode.btn_exportClick(Sender: TObject); 43 | begin 44 | if SaveDialog1.execute = false then exit; 45 | readwriter.lines.AddStrings(lin_cars.Lines); 46 | readwriter.lines.SaveToFile(changefileext(SaveDialog1.filename, '.pwn')); 47 | gtaeditor.gencode() 48 | end; 49 | 50 | procedure Twnd_showcode.CheckBox1Click(Sender: TObject); 51 | begin 52 | wnd_showcode.readwriter.lines.clear; 53 | gtaeditor.gencode() 54 | end; 55 | 56 | procedure Twnd_showcode.brn_rgenClick(Sender: TObject); 57 | begin 58 | gtaeditor.gencode() 59 | end; 60 | 61 | procedure Twnd_showcode.CheckBox2Click(Sender: TObject); 62 | begin 63 | gtaeditor.gencode() 64 | end; 65 | 66 | end. 67 | --------------------------------------------------------------------------------