├── .gitattributes ├── .gitignore ├── ENGINE ├── ddsd32_SrcImage8_fastloop.inc ├── ddsd32_SrcImage8_fastloop_end.inc ├── se_D3DUtils.pas ├── se_DXClass.pas ├── se_DXClasses.pas ├── se_DXConsts.pas ├── se_DXDUtils.pas ├── se_DXDraws.pas ├── se_DXInput.pas ├── se_DXMeshes.pas ├── se_DXRender.inc ├── se_DXRender.pas ├── se_DXTables.pas ├── se_DXTexImg.pas ├── se_DXTextureEffects.pas ├── se_DirectX.pas ├── se_IDSoftData.ddp ├── se_IDSoftData.dfm ├── se_IDSoftData.pas ├── se_Main.pas ├── se_MyD3DUtils.pas ├── se_Quake2Utils.pas ├── se_QuakeTypes.pas ├── se_RTLCompileParams.pas ├── se_TempDXDraw.ddp ├── se_TempDXDraw.dfm ├── se_TempDXDraw.pas ├── se_Utils.pas ├── se_WADS.pas └── se_ZipFile.pas ├── FASTMM ├── FastMM4.pas ├── FastMM4Messages.pas └── FastMM4Options.inc ├── IMAGEFORMATS ├── dib_PaletteEntriesToRGBQuads_fastloop.inc ├── dib_PaletteEntriesToRGBQuads_fastloop_end.inc ├── dib_RGBQuadsToPaletteEntries_fastloop.inc ├── dib_RGBQuadsToPaletteEntries_fastloop_end.inc ├── dibimage.pas ├── pcximage.pas ├── pngimage.pas ├── pnglang.pas ├── xGIF.pas ├── xM8.pas ├── xPPM.pas ├── xStubGraphic.pas ├── xTGA.pas ├── xWZ.pas └── zBitmap.pas ├── LIBRARY ├── ABOUTDLG.DCR ├── ABOUTLINE.BMP ├── About.ddp ├── About.dfm ├── About.pas ├── Aboutdlg.pas ├── AnotherReg.dcr ├── AnotherReg.pas ├── AnotherReg.res ├── DropDownButton.dcr ├── DropDownButton.pas ├── FILEDRAGBTN.DCR ├── FileMenuHistory.dcr ├── FileMenuHistory.pas ├── MessageBox.dcr ├── MessageBox.pas ├── XPMenu.dcr ├── XPMenu.pas ├── binarydata.pas ├── filedrag.pas ├── rmBaseEdit.pas ├── rmBtnEdit.dcr ├── rmBtnEdit.pas ├── rmBtnEdit.res ├── rmLibrary.pas ├── rmSBSpin.res ├── rmSpeedBtns.dcr ├── rmSpeedBtns.pas ├── rmcontrols.inc └── smoothshow.pas ├── LICENSE ├── QUAKEVIEWER ├── ImageList1.bmp ├── OpenQuakeMapFrm.ddp ├── OpenQuakeMapFrm.dfm ├── OpenQuakeMapFrm.pas ├── QuickInfoFrm.ddp ├── QuickInfoFrm.dfm ├── QuickInfoFrm.pas ├── Splash.ddp ├── Splash.dfm ├── Splash.pas ├── Unit1.ddp ├── Unit1.dfm ├── Unit1.pas ├── dots.bmp ├── file.bmp ├── quakeviewer_128.ico ├── quakeviewer_32.ico ├── quakeviewer_48.ico ├── quakeviewer_64.ico ├── qv_argv.pas └── qv_globals.pas ├── QuakeViewer.dof ├── QuakeViewer.dpr ├── QuakeViewer.res ├── README.md ├── ZLIB ├── adler32.obj ├── compress.obj ├── crc32.obj ├── deflate.obj ├── gzio.obj ├── infback.obj ├── inffast.obj ├── inflate.obj ├── inftrees.obj ├── trees.obj ├── uncompr.obj ├── z125_adler32.obj ├── z125_compress.obj ├── z125_crc32.obj ├── z125_deflate.obj ├── z125_infback.obj ├── z125_inffast.obj ├── z125_inflate.obj ├── z125_inftrees.obj ├── z125_trees.obj └── zlibpas.pas └── defs.inc /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /ENGINE/ddsd32_SrcImage8_fastloop.inc: -------------------------------------------------------------------------------- 1 | //ddsd32_SrcImage8_fastloop 2 | 3 | PDWord(yy)^ := PDWord(@ppalentries[PByte(topBits)^])^; 4 | yy := yy + 4; 5 | topBits := Pointer(integer(topBits) + 1); 6 | 7 | 8 | { 9 | pEntry := @ppalentries[PByte(topBits)^]; 10 | PDWord(yy)^ := 11 | (pEntry.peRed shl 16) or 12 | (pEntry.peGreen shl 8) or 13 | (pEntry.peBlue); 14 | yy := yy + 4; 15 | topBits := Pointer(integer(topBits) + 1); 16 | } 17 | 18 | 19 | { pEntry := @SrcImage.idx_palette[PByte(topBits)^]; 20 | PDWord(yy)^ := 21 | (pEntry.peRed shl dest_red_fmt._rshift) or 22 | (pEntry.peGreen shl dest_green_fmt._rshift) or 23 | (pEntry.peBlue shl dest_blue_fmt._rshift); 24 | yy := yy + 4; 25 | topBits := Pointer(integer(topBits) + 1); 26 | } 27 | -------------------------------------------------------------------------------- /ENGINE/ddsd32_SrcImage8_fastloop_end.inc: -------------------------------------------------------------------------------- 1 | //ddsd32_SrcImage8_fastloop_end 2 | 3 | PDWord(yy)^ := PDWord(@ppalentries[PByte(topBits)^])^; 4 | 5 | { 6 | pEntry := @ppalentries[PByte(topBits)^]; 7 | PDWord(yy)^ := 8 | (pEntry.peRed shl 16) or 9 | (pEntry.peGreen shl 8) or 10 | (pEntry.peBlue); 11 | } 12 | 13 | { 14 | pEntry := @SrcImage.idx_palette[PByte(topBits)^]; 15 | PDWord(yy)^ := 16 | (pEntry.peRed shl dest_red_fmt._rshift) or 17 | (pEntry.peGreen shl dest_green_fmt._rshift) or 18 | (pEntry.peBlue shl dest_blue_fmt._rshift); 19 | } 20 | -------------------------------------------------------------------------------- /ENGINE/se_DXClasses.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // Surfaces Engine (SE) - Gaming engine for Windows based on DirectX & DelphiX 4 | // Copyright (C) 1999-2004, 2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Various utility classes 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | //------------------------------------------------------------------------------ 27 | 28 | {$I defs.inc} 29 | unit se_DXClasses; 30 | 31 | interface 32 | 33 | uses 34 | SysUtils, Classes, Graphics; 35 | 36 | type 37 | TSubStream = class(TStream) 38 | protected 39 | fParent: TStream; 40 | fSubPos, 41 | fSubSize: LongInt; 42 | fPosition: LongInt; 43 | public 44 | constructor Create(aParent: TStream; aSubPos, aSubSize: LongInt); virtual; 45 | function Read(var Buffer; Count: Longint): Longint; override; 46 | function Write(const Buffer; Count: Longint): Longint; override; 47 | function Seek(Offset: Longint; Origin: Word): Longint; override; 48 | function AbsolutPosition: LongInt; virtual; 49 | end; 50 | 51 | ESSCreateError = class(EStreamError); 52 | 53 | TCachedFileStream = class(TFileStream) 54 | private 55 | fBufSize: integer; 56 | fBuffer: pointer; 57 | fPosition: integer; 58 | fBufferStart: integer; 59 | fBufferEnd: integer; 60 | fSize: integer; 61 | fInitialized: boolean; 62 | protected 63 | procedure SetSize(NewSize: Longint); override; 64 | procedure ResetBuffer; virtual; 65 | public 66 | constructor Create(const FileName: string; mode: word; ABufSize: integer = $FFFF); virtual; 67 | destructor Destroy; override; 68 | function Read(var Buffer; Count: Longint): Longint; override; 69 | function ReadNoBuffer(var Buffer; Count: Longint): Longint; virtual; 70 | function Write(const Buffer; Count: Longint): Longint; override; 71 | function Seek(Offset: Longint; Origin: Word): Longint; override; 72 | end; 73 | 74 | TDXStringList = class(TStringList) 75 | protected 76 | fLastIndex: integer; 77 | procedure Put(Index: Integer; const S: string); override; 78 | public 79 | constructor Create; virtual; 80 | procedure Insert(Index: Integer; const S: string); override; 81 | function IndexOfFromLast(const S: string): Integer; virtual; 82 | end; 83 | 84 | { 85 | TDXBitmap = class(TBitmap) 86 | public 87 | procedure SetDimentions(aWidth, aHeight: Integer); virtual; 88 | end; 89 | } 90 | implementation 91 | 92 | uses 93 | Windows; 94 | 95 | resourceString 96 | rsSSCreateError = 'Cannot create TSubStream class with nil parent'; 97 | 98 | constructor TSubStream.Create(aParent: TStream; aSubPos, aSubSize: LongInt); 99 | begin 100 | if Assigned(aParent) then 101 | begin 102 | Inherited Create; 103 | fParent := aParent; 104 | fSubPos := aSubPos; 105 | fSubSize := aSubSize; 106 | fPosition := 0; 107 | end 108 | else 109 | raise ESSCreateError.Create(rsSSCreateError); 110 | end; 111 | 112 | function TSubStream.Read(var Buffer; Count: Longint): Longint; 113 | var fParentPosition: LongInt; 114 | begin 115 | fParentPosition := fParent.Position; 116 | fParent.Seek(fPosition + fSubPos, soFromBeginning); 117 | Result := fParent.Read(Buffer, Count); 118 | inc(fPosition, Count); 119 | fParent.Seek(fParentPosition, soFromBeginning); 120 | end; 121 | 122 | function TSubStream.Write(const Buffer; Count: Longint): Longint; 123 | var fParentPosition: LongInt; 124 | begin 125 | fParentPosition := fParent.Position; 126 | fParent.Seek(fPosition + fSubPos, soFromBeginning); 127 | Result := fParent.Write(Buffer, Count); 128 | inc(fPosition, Count); 129 | fParent.Seek(fParentPosition, soFromBeginning); 130 | end; 131 | 132 | function TSubStream.Seek(Offset: Longint; Origin: Word): Longint; 133 | begin 134 | case Origin of 135 | soFromBeginning: fPosition := Offset; 136 | soFromCurrent: Inc(fPosition, Offset); 137 | soFromEnd: fPosition := fSubSize + Offset; 138 | end; 139 | Result := fPosition; 140 | end; 141 | 142 | function TSubStream.AbsolutPosition: LongInt; 143 | begin 144 | Result := fPosition + fSubPos; 145 | if fParent.InheritsFrom(TSubStream) then 146 | Result := Result + (fParent as TSubStream).AbsolutPosition; 147 | end; 148 | 149 | //////////////////////////////////////////////////////////////////////////////// 150 | 151 | constructor TCachedFileStream.Create(const FileName: string; mode: word; ABufSize: integer = $FFFF); 152 | begin 153 | fInitialized := false; 154 | Inherited Create(FileName, mode); 155 | fBufSize := ABufSize; 156 | GetMem(fBuffer, fBufSize); 157 | fPosition := 0; 158 | ResetBuffer; 159 | fSize := Inherited Size; 160 | fInitialized := true; 161 | end; 162 | 163 | procedure TCachedFileStream.ResetBuffer; 164 | begin 165 | fBufferStart := -1; 166 | fBufferEnd := -1; 167 | end; 168 | 169 | destructor TCachedFileStream.Destroy; 170 | begin 171 | FreeMem(fBuffer, fBufSize); 172 | Inherited; 173 | end; 174 | 175 | function TCachedFileStream.Read(var Buffer; Count: Longint): Longint; 176 | var 177 | x: Longint; 178 | begin 179 | // Buffer hit 180 | if (fPosition >= fBufferStart) and (fPosition + Count <= fBufferEnd) then 181 | begin 182 | x := LongInt(fBuffer) + fPosition - fBufferStart; 183 | Move(Pointer(x)^, Buffer, Count); 184 | fPosition := fPosition + Count; 185 | Result := Count; 186 | end 187 | // Non Buffer hit, cache buffer 188 | else if Count <= fBufSize then 189 | begin 190 | fPosition := Inherited Seek(fPosition, soFromBeginning); 191 | x := Inherited Read(fBuffer^, fBufSize); 192 | if x < Count then 193 | Result := x 194 | else 195 | Result := Count; 196 | Move(fBuffer^, Buffer, Count); 197 | fBufferStart := fPosition; 198 | fBufferEnd := fPosition + x; 199 | fPosition := fPosition + Result; 200 | end 201 | // Keep old buffer 202 | else 203 | begin 204 | fPosition := Inherited Seek(fPosition, soFromBeginning); 205 | Result := Inherited Read(Buffer, Count); 206 | fPosition := fPosition + Result; 207 | end; 208 | end; 209 | 210 | function TCachedFileStream.ReadNoBuffer(var Buffer; Count: Longint): Longint; 211 | begin 212 | fPosition := Inherited Seek(fPosition, soFromBeginning); 213 | Result := Inherited Read(Buffer, Count); 214 | fPosition := fPosition + Result; 215 | end; 216 | 217 | function TCachedFileStream.Write(const Buffer; Count: Longint): Longint; 218 | begin 219 | fPosition := Inherited Seek(fPosition, soFromBeginning); 220 | Result := Inherited Write(Buffer, Count); 221 | fPosition := fPosition + Result; 222 | if fSize < fPosition then 223 | fSize := fPosition; 224 | end; 225 | 226 | function TCachedFileStream.Seek(Offset: Longint; Origin: Word): Longint; 227 | begin 228 | if fInitialized then 229 | begin 230 | case Origin of 231 | soFromBeginning: fPosition := Offset; 232 | soFromCurrent: Inc(fPosition, Offset); 233 | soFromEnd: fPosition := fSize + Offset; 234 | end; 235 | Result := fPosition; 236 | end 237 | else 238 | Result := Inherited Seek(Offset, Origin); 239 | end; 240 | 241 | procedure TCachedFileStream.SetSize(NewSize: Longint); 242 | begin 243 | Inherited; 244 | fSize := NewSize; 245 | end; 246 | 247 | //////////////////////////////////////////////////////////////////////////////// 248 | constructor TDXStringList.Create; 249 | begin 250 | fLastIndex := -1; 251 | Inherited Create; 252 | end; 253 | 254 | procedure TDXStringList.Put(Index: Integer; const S: string); 255 | begin 256 | if Sorted then 257 | Sorted := false; 258 | Inherited; 259 | end; 260 | 261 | procedure TDXStringList.Insert(Index: Integer; const S: string); 262 | begin 263 | if Sorted then 264 | Sorted := false; 265 | Inherited; 266 | end; 267 | 268 | function TDXStringList.IndexOfFromLast(const S: string): Integer; 269 | begin 270 | if (fLastIndex >=0) and (fLastIndex < Count) then 271 | begin 272 | Result := fLastIndex; 273 | if AnsiCompareText(Get(Result), S) = 0 then Exit; 274 | end; 275 | for Result := Count - 1 downto 0 do 276 | if AnsiCompareText(Get(Result), S) = 0 then 277 | begin 278 | fLastIndex := Result; 279 | Exit; 280 | end; 281 | Result := -1; 282 | end; 283 | 284 | //////////////////////////////////////////////////////////////////////////////// 285 | { 286 | procedure TDXBitmap.SetDimentions(aWidth, aHeight: Integer); 287 | var 288 | DIB: TDIBSection; 289 | begin 290 | with FImage do 291 | if (FDIB.dsbm.bmWidth <> aWidth) or 292 | (FDIB.dsbm.bmHeight <> aHeight) then 293 | begin 294 | HandleNeeded; 295 | DIB := FDIB; 296 | DIB.dsbm.bmWidth := aWidth; 297 | DIB.dsbmih.biWidth := aWidth; 298 | DIB.dsbm.bmHeight := aHeight; 299 | DIB.dsbmih.biHeight := aHeight; 300 | CopyImage(FHandle, FPalette, DIB); 301 | Changed(Self); 302 | end; 303 | end; 304 | } 305 | 306 | end. 307 | -------------------------------------------------------------------------------- /ENGINE/se_DXConsts.pas: -------------------------------------------------------------------------------- 1 | // DelphiX - Modified for SE 2 | unit se_DXConsts; 3 | 4 | interface 5 | 6 | resourcestring 7 | SNone = '(None)'; 8 | SUnknownError = 'Unknown Error (%d)'; 9 | 10 | SDirectDraw = 'DirectDraw'; 11 | SDirect3DRM = 'Direct3D RetainedMode'; 12 | SDirectSound = 'DirectSound'; 13 | SDirectSoundCapture = 'DirectSoundCapture'; 14 | SDirectDrawClipper = 'Clipper'; 15 | SDirectDrawPalette = 'Palette'; 16 | SDirectDrawSurface = 'Surface'; 17 | SDirectDrawPrimarySurface = 'Primary Surface'; 18 | SDirectSoundBuffer = 'Sound Buffer'; 19 | SDirectSoundPrimaryBuffer = 'Primary Buffer'; 20 | SDirectSoundCaptureBuffer = 'Sound Capture Buffer'; 21 | STexture = 'Texture'; 22 | SDirectPlay = 'DirectPlay'; 23 | SSession = 'Session'; 24 | 25 | SNotMade = '%s not made'; 26 | SStreamNotOpend = 'Stream not opend'; 27 | SWaveStreamNotSet = 'WaveStream not set'; 28 | SCannotMade = '%s cannot be made'; 29 | SCannotInitialized = '%s cannot be initialized'; 30 | SCannotChanged = '%s cannot be changed'; 31 | SCannotLock = '%s cannot be locked'; 32 | SCannotOpened = '%s cannot be opened'; 33 | SDLLNotLoaded = '%s not loaded'; 34 | SImageNotFound = 'Image ''%s'' not found'; 35 | SWaveNotFound = 'Wave ''%s'' not found'; 36 | SEffectNotFound = 'Effect ''%s'' not found'; 37 | SListIndexError = 'Index of the list exceeds the range. (%d)'; 38 | SScanline = 'Index of the scanning line exceeded the range. (%d)'; 39 | SNoForm = 'Form not found'; 40 | SSinceDirectX5 = 'Necessary since DirectX 5'; 41 | SSinceDirectX6 = 'Necessary since DirectX 6'; 42 | SSinceDirectX7 = 'Necessary since DirectX 7'; 43 | S3DDeviceNotFound = '3D device not found'; 44 | SDisplayModeChange = 'Display mode cannot be changed (%dx%d %dbit)'; 45 | SDisplayModeCannotAcquired = 'A present display mode cannot be acquired'; 46 | SInvalidDIB = 'DIB is invalid'; 47 | SInvalidDIBBitCount = 'Bitcount in invalid (%d)'; 48 | SInvalidDIBPixelFormat = 'PixelFormat in invalid'; 49 | SInvalidWave = 'Wave is invalid'; 50 | SInvalidDisplayBitCount = 'It should be either of 8 or 16 or 24 or 32'; 51 | SInvalidWaveFormat = 'Format is invalid'; 52 | SNotSupported = '%s not supported'; 53 | SStreamOpend = 'Stream has already been opened'; 54 | SNecessaryDirectInputUseMouse = 'DirectInput is necessary to use the mouse'; 55 | 56 | { DirectPlay } 57 | SDXPlayNotConnectedNow = 'TDXPlay component is not connected now.'; 58 | SDXPlayProviderNotFound = 'Provider ''%s'' not found'; 59 | SDXPlayProviderSpecifiedGUIDNotFound = 'Provider of specified GUID is not found'; 60 | SDXPlayModemListCannotBeAcquired = 'Modem list cannot be acquired'; 61 | SDXPlaySessionListCannotBeAcquired = 'Session list cannot be acquired'; 62 | SDXPlaySessionNotFound = 'Session ''%s'' not found'; 63 | SDXPlaySessionCannotOpened = 'Session %s cannot be opened'; 64 | SDXPlayPlayerNotFound = 'The player of specified ID is not found'; 65 | SDXPlayMessageIllegal = 'The message form is illegal'; 66 | SDXPlayPlayerNameIsNotSpecified = 'Player name is not specified'; 67 | SDXPlaySessionNameIsNotSpecified = 'Session name is not specified'; 68 | 69 | DXPlayFormNext = 'Next >'; 70 | DXPlayFormComplete = 'Complete'; 71 | 72 | SNotSupportGraphicFile = 'This format graphic not suported'; 73 | SInvalidDXTFile = 'This DXT file is invalid'; 74 | SCannotLoadGraphic = 'Can''t Load this Graphic'; 75 | SOverlay = 'Not posible Overlay Surface'; 76 | 77 | const 78 | SDIBSize = '(%dx%d)'; 79 | SDIBColor = '%d color'; 80 | SDIBBitSize = '%d bytes'; 81 | SDIBBitSize_K = '%d Kbytes'; 82 | 83 | const 84 | SWaveLength = '%.4g sec'; 85 | SWaveFrequency = '%dHz'; 86 | SWaveBitCount = '%dbit'; 87 | SWaveMono = 'Mono'; 88 | SWaveStereo = 'Stereo'; 89 | SWaveSize = '%d bytes'; 90 | 91 | const 92 | SKeyLeft = 'Left'; 93 | SKeyUp = 'Up'; 94 | SKeyRight = 'Right'; 95 | SKeyDown = 'Down'; 96 | 97 | const 98 | SFFBEffectEditor = '%s Effect Editor'; 99 | 100 | implementation 101 | 102 | end. 103 | 104 | -------------------------------------------------------------------------------- /ENGINE/se_DXDUtils.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_DXDUtils.pas -------------------------------------------------------------------------------- /ENGINE/se_DXMeshes.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // Surfaces Engine (SE) - Gaming engine for Windows based on DirectX & DelphiX 4 | // Copyright (C) 1999-2004, 2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Mesh rendering utilities 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | //------------------------------------------------------------------------------ 27 | 28 | {$I defs.inc} 29 | 30 | unit se_DXMeshes; 31 | 32 | interface 33 | 34 | {$IFNDEF NO_DXMESHES} 35 | uses 36 | Windows, Classes, se_DirectX, se_DXDraws, se_DXDUtils, se_MyD3DUtils, se_DXClasses, 37 | se_DXTables {$IFNDEF NO_TEXTUREEFFECTS}, se_DXTextureEffects{$ENDIF}; 38 | 39 | const 40 | ZERO: integer = 0; 41 | TRHEE: integer = 3; 42 | FOUR: integer = 4; 43 | CULL_NONE: TD3DCull = D3DCULL_NONE; 44 | CULL_CW: TD3DCull = D3DCULL_CW; 45 | CULL_CCW: TD3DCull = D3DCULL_CCW; 46 | PT_INVALID_0: TD3DPrimitiveType = D3DPT_INVALID_0; 47 | PT_POINTLIST: TD3DPrimitiveType = D3DPT_POINTLIST; 48 | PT_LINELIST: TD3DPrimitiveType = D3DPT_LINELIST; 49 | PT_LINESTRIP: TD3DPrimitiveType = D3DPT_LINESTRIP; 50 | PT_TRIANGLELIST: TD3DPrimitiveType = D3DPT_TRIANGLELIST; 51 | PT_TRIANGLESTRIP: TD3DPrimitiveType = D3DPT_TRIANGLESTRIP; 52 | PT_TRIANGLEFAN: TD3DPrimitiveType = D3DPT_TRIANGLEFAN; 53 | 54 | type 55 | PRTLMesh = ^TRTLMesh; 56 | TRTLMesh = record 57 | NumVertexes: PInteger; 58 | Vertexes: PPD3DVertexArray; 59 | NumIndices: PInteger; 60 | Indices: PPIndexesArray; 61 | PrimitiveType: PD3DPrimitiveType; 62 | VertexTypeDesc: PDWORD; 63 | Cull: PD3DCull; 64 | BoundingCube: PBoundingCube; 65 | Center: PD3DValue; 66 | Radius: PD3DValue; 67 | {$IFNDEF NO_TEXTUREEFFECTS} 68 | TexEffect: PTextureEffect; 69 | {$ENDIF} 70 | Tex1, Tex2: TDirect3DTexture2; 71 | // if not movable then triangles for vis & collision 72 | // are fixed to bounding cubes / spheres 73 | Movable: boolean; // true if moves or changes 74 | end; 75 | 76 | procedure GetMeshScript(script: TDXStringList; const m: PRTLMesh; const meshname: string; const stex1, stex2: string); 77 | 78 | procedure RenderMesh(const dev: IDirect3DDevice7; const m: PRTLMesh); 79 | 80 | procedure RenderMeshWithAlphaEffect(const dev: IDirect3DDevice7; const m: PRTLMesh); 81 | 82 | procedure RenderMeshWithStageEffect(const dev: IDirect3DDevice7; const m: PRTLMesh); 83 | 84 | function IsDXMeshScriptReserverWord(const Token: string): boolean; 85 | 86 | type 87 | TRenderMeshProc = procedure(const dev: IDirect3DDevice7; const m: PRTLMesh); 88 | 89 | {$ENDIF} 90 | 91 | implementation 92 | 93 | {$IFNDEF NO_DXMESHES} 94 | 95 | uses 96 | SysUtils; 97 | 98 | const 99 | CULL_TABLE: array[0..3] of string = ( 100 | ' // D3DCULL_INVALID_0', 101 | ' // D3DCULL_NONE', 102 | ' // D3DCULL_CW', 103 | ' // D3DCULL_CCW' ); 104 | 105 | PRIMITIVE_TABLE: array[0..6] of string = ( 106 | ' // D3DPT_INVALID_0', 107 | ' // D3DPT_POINTLIST', 108 | ' // D3DPT_LINELIST', 109 | ' // D3DPT_LINESTRIP', 110 | ' // D3DPT_TRIANGLELIST', 111 | ' // D3DPT_TRIANGLESTRIP', 112 | ' // D3DPT_TRIANGLEFAN' ); 113 | 114 | MSHSCRIPTRESERVEDWORDS: array[0..10] of string = ( 115 | 'MESH', 116 | 'BEGIN', 117 | 'END', 118 | 'TEXTURE1', 119 | 'TEXTURE2', 120 | 'PRIMITIVETYPE', 121 | 'CULL', 122 | 'VERTEXTYPEDESC', 123 | 'NUMVERTEXES', 124 | 'NUMINDICES', 125 | 'EFFECT' ); 126 | 127 | 128 | function IsDXMeshScriptReserverWord(const Token: string): boolean; 129 | var 130 | uToken: string; 131 | i: integer; 132 | begin 133 | uToken := UpperCase(Token); 134 | for i := low(MSHSCRIPTRESERVEDWORDS) to high(MSHSCRIPTRESERVEDWORDS) do 135 | if uToken = MSHSCRIPTRESERVEDWORDS[i] then 136 | begin 137 | result := true; 138 | exit; 139 | end; 140 | result := false; 141 | end; 142 | 143 | procedure GetMeshScript(script: TDXStringList; const m: PRTLMesh; const meshname: string; const stex1, stex2: string); 144 | var 145 | s: TDXStringList; 146 | sTmp: string; 147 | i: integer; 148 | oldSep: char; 149 | begin 150 | oldSep := decimalSeparator; 151 | decimalSeparator := '.'; 152 | s := TDXStringList.Create; 153 | try 154 | 155 | { 156 | mesh 'area1' 157 | begin 158 | primitiveType = 4 // D3DPT_TRIANGLELIST 159 | VertexTypeDesc = 414 // TD3DVertex 160 | Cull = 0 // D3DCULL_NONE 161 | numVertexes 10 162 | (1.2 1.3 1.8 .... ) 163 | (2.4 3.34 12.3 .... ) 164 | (6 4.03 10.1 .... ) 165 | ... 166 | numIndices 30 167 | 0 1 2 .... 168 | end 169 | } 170 | 171 | s.Add('mesh "' + meshname + '"'); 172 | s.Add('begin'); 173 | s.Add(' texture1 = "' + stex1 + '"'); 174 | if stex2 <> '' then 175 | s.Add(' texture2 = "' + stex2 + '"'); 176 | s.Add(' effect = "' + TextureTypeLookUpTable[m.TexEffect.TE_ALPHA.ID].EffectName + '"'); 177 | s.Add(' primitiveType = ' + IntToStrTable(Ord(m.PrimitiveType^)) + PRIMITIVE_TABLE[Ord(m.PrimitiveType^)]); 178 | s.Add(' cull = ' + IntToStrTable(Ord(m.Cull^)) + CULL_TABLE[Ord(m.Cull^)]); 179 | 180 | if m.VertexTypeDesc^ = D3DFVF_LVERTEX then 181 | sTmp := ' // TD3DLVERTEX' 182 | else if m.VertexTypeDesc^ = D3DFVF_VERTEX then 183 | sTmp := ' // TD3DVERTEX' 184 | else 185 | sTmp := ''; 186 | 187 | s.Add(' vertexTypeDesc = ' + IntToStrTable(m.VertexTypeDesc^) + sTmp); 188 | s.Add(' numVertexes = ' + IntToStrTable(m.NumVertexes^)); 189 | 190 | if m.VertexTypeDesc^ = D3DFVF_LVERTEX then 191 | begin 192 | for i := 0 to m.NumVertexes^ - 1 do 193 | begin 194 | s.Add(' (' + FloatToStr(m.Vertexes^[i].x) + ' ' + FloatToStr(m.Vertexes^[i].y) + ' ' + FloatToStr(m.Vertexes^[i].z) + ' ' + 195 | IntToStr(TD3DLVertex(m.Vertexes^[i]).color) + ' ' + IntToStr(TD3DLVertex(m.Vertexes^[i]).specular) + ' ' + 196 | FloatToStr(m.Vertexes^[i].tu) + ' ' + FloatToStr(m.Vertexes^[i].tv) + ')') 197 | end 198 | end 199 | else 200 | begin 201 | for i := 0 to m.NumVertexes^ - 1 do 202 | begin 203 | s.Add(' (' + FloatToStr(m.Vertexes^[i].x) + ' ' + FloatToStr(m.Vertexes^[i].y) + ' ' + FloatToStr(m.Vertexes^[i].z) + ' ' + 204 | FloatToStr(m.Vertexes^[i].nx) + ' ' + FloatToStr(m.Vertexes^[i].ny) + ' ' + FloatToStr(m.Vertexes^[i].nz) + ' ' + 205 | FloatToStr(m.Vertexes^[i].tu) + ' ' + FloatToStr(m.Vertexes^[i].tv) + ')') 206 | end 207 | end; 208 | 209 | if m.NumIndices^ > 0 then 210 | begin 211 | s.Add(' numIndices = ' + IntToStrTable(m.NumIndices^)); 212 | sTmp := ' '; 213 | i := 0; 214 | repeat 215 | sTmp := sTmp + ' ' + IntToStrTable(i); 216 | inc(i); 217 | if (i mod 10 = 0) or (i = m.NumIndices^) then 218 | begin 219 | s.Add(sTmp); 220 | sTmp := ' '; 221 | end; 222 | until i = m.NumIndices^; 223 | end; 224 | 225 | s.Add('end'); 226 | s.Add(''); 227 | 228 | script.AddStrings(s); 229 | finally 230 | s.Free; 231 | decimalSeparator := oldSep; 232 | end; 233 | end; 234 | 235 | {$IFNDEF NO_TEXTUREEFFECTS} 236 | procedure RenderMeshWithAlphaEffect(const dev: IDirect3DDevice7; const m: PRTLMesh); 237 | begin 238 | m.TexEffect.TE_ALPHA.Shaders[0].Args.Texture := m.Tex1; 239 | m.TexEffect.TE_ALPHA.Shaders[1].Args.Texture := m.Tex2; 240 | if m.NumIndices^ = 0 then 241 | TE_ALPH_DrawPrimitive7(m.TexEffect.TE_ALPHA, 242 | dev, m.PrimitiveType^, m.VertexTypeDesc^, 243 | m.Vertexes^[0], m.NumVertexes^) 244 | else 245 | TE_ALPH_DrawIndexedPrimitive7(m.TexEffect.TE_ALPHA, 246 | dev, m.PrimitiveType^, m.VertexTypeDesc^, 247 | m.Vertexes^[0], m.NumVertexes^, m.Indices^, m.NumIndices^); 248 | end; 249 | 250 | procedure RenderMeshWithStageEffect(const dev: IDirect3DDevice7; const m: PRTLMesh); 251 | begin 252 | m.TexEffect.TE_STAGE.Shaders[0].Args.Texture := m.Tex1; 253 | m.TexEffect.TE_STAGE.Shaders[1].Args.Texture := m.Tex2; 254 | if m.NumIndices^ = 0 then 255 | TE_STG_DrawPrimitive7(m.TexEffect.TE_STAGE, 256 | dev, m.PrimitiveType^, 257 | PD3DLVertexArray(m.Vertexes^), m.NumVertexes^) 258 | else 259 | TE_STG_DrawIndexedPrimitive7(m.TexEffect.TE_STAGE, 260 | dev, m.PrimitiveType^, 261 | PD3DLVertexArray(m.Vertexes^), m.NumVertexes^, m.Indices^, m.NumIndices^); 262 | end; 263 | {$ENDIF} 264 | 265 | procedure RenderMesh(const dev: IDirect3DDevice7; const m: PRTLMesh); 266 | begin 267 | if m.Tex1 <> nil then 268 | dev.SetTexture(0, m.Tex1.Surface.IDDSurface7) 269 | else 270 | dev.SetTexture(0, nil); 271 | if (m.NumIndices^ = 0) then 272 | dev.DrawPrimitive(m.PrimitiveType^, m.VertexTypeDesc^, 273 | m.Vertexes^[0], m.NumVertexes^, 0) 274 | else 275 | dev.DrawIndexedPrimitive(m.PrimitiveType^, m.VertexTypeDesc^, 276 | m.Vertexes^[0], m.NumVertexes^, m.Indices^[0], m.NumIndices^, 0); 277 | end; 278 | 279 | {$ENDIF} 280 | 281 | end. 282 | 283 | -------------------------------------------------------------------------------- /ENGINE/se_DXRender.inc: -------------------------------------------------------------------------------- 1 | mov eax,offset @@StartCode // Move(@@StartCode, Code^, @@EndCode-@@StartCode) 2 | mov edx,dword ptr [Code] 3 | mov edx,dword ptr [edx] 4 | mov ecx,offset @@EndCode 5 | sub ecx,offset @@StartCode 6 | call Move 7 | mov ecx,dword ptr [Code] // ecx := Code; 8 | mov ecx,dword ptr [ecx] 9 | mov eax,offset @@EndCode // Inc(PByte(Code), (@@EndCode-@@StartCode)); 10 | sub eax,offset @@StartCode 11 | mov edx,dword ptr [Code] 12 | add dword ptr [edx],eax 13 | -------------------------------------------------------------------------------- /ENGINE/se_DirectX.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_DirectX.pas -------------------------------------------------------------------------------- /ENGINE/se_IDSoftData.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_IDSoftData.ddp -------------------------------------------------------------------------------- /ENGINE/se_IDSoftData.dfm: -------------------------------------------------------------------------------- 1 | object IDSoftDataModule: TIDSoftDataModule 2 | OldCreateOrder = False 3 | OnCreate = DataModuleCreate 4 | OnDestroy = DataModuleDestroy 5 | Left = 192 6 | Top = 100 7 | Height = 480 8 | Width = 696 9 | end 10 | -------------------------------------------------------------------------------- /ENGINE/se_IDSoftData.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_IDSoftData.pas -------------------------------------------------------------------------------- /ENGINE/se_Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_Main.pas -------------------------------------------------------------------------------- /ENGINE/se_MyD3DUtils.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_MyD3DUtils.pas -------------------------------------------------------------------------------- /ENGINE/se_Quake2Utils.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_Quake2Utils.pas -------------------------------------------------------------------------------- /ENGINE/se_RTLCompileParams.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_RTLCompileParams.pas -------------------------------------------------------------------------------- /ENGINE/se_TempDXDraw.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_TempDXDraw.ddp -------------------------------------------------------------------------------- /ENGINE/se_TempDXDraw.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // Surfaces Engine (SE) - Gaming engine for Windows based on DirectX & DelphiX 4 | // Copyright (C) 1999-2004, 2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Temporary rendering Form (if the Application does not provide one) 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | //------------------------------------------------------------------------------ 27 | 28 | unit se_TempDXDraw; 29 | 30 | interface 31 | 32 | uses 33 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 34 | se_DXDraws, se_DXClass; 35 | 36 | type 37 | TTempDXDrawForm = class(TDXForm) 38 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 39 | procedure FormCreate(Sender: TObject); 40 | private 41 | { Private declarations } 42 | public 43 | { Public declarations } 44 | DXDraw: TDXDraw; 45 | end; 46 | 47 | implementation 48 | 49 | {$R *.DFM} 50 | 51 | procedure TTempDXDrawForm.FormClose(Sender: TObject; 52 | var Action: TCloseAction); 53 | begin 54 | Action := caFree; 55 | end; 56 | 57 | procedure TTempDXDrawForm.FormCreate(Sender: TObject); 58 | begin 59 | DXDraw := TDXDraw.Create(self); 60 | DXDraw.Parent := self; 61 | DXDraw.Left := 8; 62 | DXDraw.Top := 16; 63 | DXDraw.Width := 320; 64 | DXDraw.Height := 240; 65 | DXDraw.AutoInitialize := True; 66 | DXDraw.AutoSize := True; 67 | DXDraw.Color := clBlack; 68 | DXDraw.Display.BitCount := 32; 69 | DXDraw.Display.FixedBitCount := False; 70 | DXDraw.Display.FixedRatio := True; 71 | DXDraw.Display.FixedSize := False; 72 | DXDraw.Options := [doAllowReboot, doWaitVBlank, doCenter, doFlip, do3D, doDirectX7Mode, doHardware, doSelectDriver, doZBuffer]; 73 | DXDraw.SurfaceHeight := 240; 74 | DXDraw.SurfaceWidth := 320; 75 | DXDraw.TabOrder := 0; 76 | end; 77 | 78 | end. 79 | -------------------------------------------------------------------------------- /ENGINE/se_Utils.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // Surfaces Engine (SE) - Gaming engine for Windows based on DirectX & DelphiX 4 | // Copyright (C) 1999-2004, 2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // various utilities functions 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | //------------------------------------------------------------------------------ 27 | 28 | unit se_Utils; 29 | 30 | interface 31 | 32 | function CopyFile(const sname, dname: string): boolean; 33 | 34 | procedure BackupFile(const fname: string); 35 | 36 | function MkShortName(const fname: string): string; 37 | 38 | procedure VisitHtmlPage(const handle: integer; const pg: string); 39 | 40 | implementation 41 | 42 | uses 43 | Windows, SysUtils, Classes, ShellApi; 44 | 45 | function CopyFile(const sname, dname: string): boolean; 46 | var 47 | FromF, ToF: file; 48 | NumRead, NumWritten: Integer; 49 | Buf: array[1..8192] of Char; 50 | begin 51 | if FileExists(sname) then 52 | begin 53 | AssignFile(FromF, sname); 54 | Reset(FromF, 1); 55 | AssignFile(ToF, dname); 56 | Rewrite(ToF, 1); 57 | repeat 58 | BlockRead(FromF, Buf, SizeOf(Buf), NumRead); 59 | BlockWrite(ToF, Buf, NumRead, NumWritten); 60 | until (NumRead = 0) or (NumWritten <> NumRead); 61 | CloseFile(FromF); 62 | CloseFile(ToF); 63 | Result := True; 64 | end 65 | else 66 | Result := False; 67 | end; 68 | 69 | procedure BackupFile(const fname: string); 70 | var 71 | fbck: string; 72 | begin 73 | if not FileExists(fname) then 74 | exit; 75 | fbck := fname + '_bak'; 76 | CopyFile(fname, fbck); 77 | end; 78 | 79 | function MkShortName(const fname: string): string; 80 | const 81 | MAXDISPFNAME = 30; 82 | var 83 | i: integer; 84 | begin 85 | if Length(fname) < MAXDISPFNAME then 86 | begin 87 | Result := fname; 88 | exit; 89 | end; 90 | Result := ''; 91 | for i := Length(fname) downto Length(fname) - (MAXDISPFNAME - 6) do 92 | Result := fname[i] + Result; 93 | Result := '...' + Result; 94 | for i := 3 downto 1 do 95 | Result := fname[i] + Result; 96 | end; 97 | 98 | procedure VisitHtmlPage(const handle: integer; const pg: string); 99 | begin 100 | ShellExecute( 101 | handle, 102 | 'open', 103 | PChar(pg), 104 | nil, nil, SW_SHOWNORMAL); 105 | end; 106 | 107 | end. 108 | -------------------------------------------------------------------------------- /ENGINE/se_WADS.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ENGINE/se_WADS.pas -------------------------------------------------------------------------------- /ENGINE/se_ZipFile.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // Surfaces Engine (SE) - Gaming engine for Windows based on DirectX & DelphiX 4 | // Copyright (C) 1999-2004, 2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // zip library 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | //------------------------------------------------------------------------------ 27 | 28 | {$I defs.inc} 29 | 30 | unit se_ZipFile; 31 | 32 | interface 33 | 34 | uses 35 | Classes, se_DXClasses; 36 | 37 | const 38 | ZIPFILESIGNATURE = $04034b50; 39 | ZIPARCIEVESIGNATURE = $08064b50; 40 | 41 | type 42 | TZipFileHeader = packed record 43 | Signature: integer; // $04034b50 44 | Version: word; 45 | BitFlag: word; 46 | CompressionMethod: word; 47 | DosDate: integer; 48 | crc32: integer; 49 | CompressedSize: integer; 50 | UnCompressedSize: integer; 51 | FileNameLen: word; 52 | ExtraFieldLen: word; 53 | end; 54 | 55 | // This descriptor exists only if bit 3 of the general 56 | // purpose bit flag is set (see below). 57 | TZipFileDescriptor = record 58 | crc32: integer; 59 | CompressedSize: integer; 60 | UnCompressedSize: integer; 61 | end; 62 | 63 | TZipArchieveExtraDataRecord = record 64 | Signature: integer; // $08064b50 65 | ExtraFieldLen: integer; 66 | end; 67 | 68 | TZipFile = class(TObject) 69 | private 70 | fFileName: string; 71 | fFiles: TDXStringList; 72 | f: TFileStream; 73 | protected 74 | function GetFile(Index: Integer): string; virtual; 75 | procedure Load; virtual; 76 | procedure Clear; virtual; 77 | procedure SetFileName(const Value: string); virtual; 78 | function GetFileCount: integer; 79 | public 80 | constructor Create(const aFileName: string); virtual; 81 | destructor Destroy; override; 82 | function GetZipFileData(const Index: integer; var p: pointer; 83 | var size: integer): boolean; overload; virtual; 84 | function GetZipFileData(const Name: string; var p: pointer; 85 | var size: integer): boolean; overload; virtual; 86 | property FileName: string read fFileName write SetFileName; 87 | property Files[Index: Integer]: string read GetFile; 88 | property FileCount: integer read GetFileCount; 89 | end; 90 | 91 | type 92 | TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer; 93 | TZFree = procedure (opaque, block: Pointer); 94 | 95 | TZStreamRec = packed record 96 | next_in : PChar; // next input byte 97 | avail_in : Longint; // number of bytes available at next_in 98 | total_in : Longint; // total nb of input bytes read so far 99 | 100 | next_out : PChar; // next output byte should be put here 101 | avail_out: Longint; // remaining free space at next_out 102 | total_out: Longint; // total nb of bytes output so far 103 | 104 | msg : PChar; // last error message, NULL if no error 105 | state : Pointer; // not visible by applications 106 | 107 | zalloc : TZAlloc; // used to allocate the internal state 108 | zfree : TZFree; // used to free the internal state 109 | opaque : Pointer; // private data object passed to zalloc and zfree 110 | 111 | data_type: Integer; // best guess about the data type: ascii or binary 112 | adler : Longint; // adler32 value of the uncompressed data 113 | reserved : Longint; // reserved for future use 114 | end; 115 | 116 | function inflate(var strm: TZStreamRec; flush: Integer): Integer; 117 | 118 | function inflateInit2_(var strm: TZStreamRec; windowBits: Integer; 119 | version: PChar; recsize: Integer): Integer; 120 | 121 | function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; 122 | recsize: Integer): Integer; 123 | 124 | function deflate(var strm: TZStreamRec; flush: Integer): Integer; 125 | 126 | function deflateEnd(var strm: TZStreamRec): Integer; 127 | 128 | function inflateInit_(var strm: TZStreamRec; version: PChar; 129 | recsize: Integer): Integer; 130 | 131 | function inflateEnd(var strm: TZStreamRec): Integer; 132 | 133 | const 134 | ZLIB_VERSION = '1.2.5'; 135 | 136 | implementation 137 | 138 | uses 139 | SysUtils; 140 | 141 | {$L ..\zlib\z125_deflate} 142 | {$L ..\zlib\z125_inflate} 143 | {$L ..\zlib\z125_inftrees} 144 | {$L ..\zlib\z125_infback} 145 | {$L ..\zlib\z125_inffast} 146 | {$L ..\zlib\z125_trees} 147 | {$L ..\zlib\z125_compress} 148 | {$L ..\zlib\z125_adler32} 149 | {$L ..\zlib\z125_crc32} 150 | 151 | const 152 | {** flush constants *******************************************************} 153 | 154 | Z_NO_FLUSH = 0; 155 | Z_PARTIAL_FLUSH = 1; 156 | Z_SYNC_FLUSH = 2; 157 | Z_FULL_FLUSH = 3; 158 | Z_FINISH = 4; 159 | Z_BLOCK = 5; 160 | 161 | const 162 | _z_errmsg: array[0..9] of PChar = ( 163 | 'need dictionary', // Z_NEED_DICT (2) 164 | 'stream end', // Z_STREAM_END (1) 165 | 'ok', // Z_OK (0) 166 | 'file error', // Z_ERRNO (-1) 167 | 'stream error', // Z_STREAM_ERROR (-2) 168 | 'data error', // Z_DATA_ERROR (-3) 169 | 'insufficient memory', // Z_MEM_ERROR (-4) 170 | 'buffer error', // Z_BUF_ERROR (-5) 171 | 'incompatible version', // Z_VERSION_ERROR (-6) 172 | '' 173 | ); 174 | 175 | function zcalloc(opaque: Pointer; items, size: Integer): Pointer; 176 | begin 177 | GetMem(result, items * size); 178 | end; 179 | 180 | procedure zcfree(opaque, block: Pointer); 181 | begin 182 | FreeMem(block); 183 | end; 184 | 185 | procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; 186 | begin 187 | Move(source^, dest^, count); 188 | end; 189 | 190 | {** c function implementations **********************************************} 191 | 192 | procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl; 193 | begin 194 | FillChar(p^, count, b); 195 | end; 196 | 197 | function inflate(var strm: TZStreamRec; flush: Integer): Integer; external; 198 | 199 | function inflateInit2_(var strm: TZStreamRec; windowBits: Integer; 200 | version: PChar; recsize: Integer): Integer; external; 201 | 202 | function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; 203 | recsize: Integer): Integer; external; 204 | 205 | function deflate(var strm: TZStreamRec; flush: Integer): Integer; external; 206 | 207 | function deflateEnd(var strm: TZStreamRec): Integer; external; 208 | 209 | function inflateInit_(var strm: TZStreamRec; version: PChar; 210 | recsize: Integer): Integer; external; 211 | 212 | function inflateEnd(var strm: TZStreamRec): Integer; external; 213 | 214 | function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer; 215 | begin 216 | result := inflateInit2_(stream,windowBits, ZLIB_VERSION, SizeOf(TZStreamRec)); 217 | end; 218 | 219 | procedure ZDecompress2(const inBuffer: Pointer; const inSize: Integer; 220 | const outSize: Integer; out outBuffer: Pointer); 221 | var 222 | zstream: TZStreamRec; 223 | 224 | procedure CheckErr(err: integer); 225 | begin 226 | if err < 0 then 227 | raise exception.Create(Format('ZDecompress2(): Zip file error(%d)', [err])); 228 | end; 229 | 230 | begin 231 | FillChar(zstream, SizeOf(TZStreamRec), 0); 232 | 233 | GetMem(outBuffer, outSize); 234 | 235 | CheckErr(InflateInit2(zstream, -15)); 236 | 237 | zstream.next_in := inBuffer; 238 | zstream.avail_in := inSize; 239 | zstream.next_out := outBuffer; 240 | zstream.avail_out := outSize; 241 | 242 | CheckErr(inflate(zstream, Z_SYNC_FLUSH)); 243 | 244 | inflateEnd(zstream); 245 | end; 246 | 247 | //------------------------------------------------------------------------------ 248 | type 249 | TZipFileEntryInfo = class(TObject) 250 | private 251 | fSize: integer; 252 | fCompressedSize: integer; 253 | fPosition: integer; 254 | fCompressed: boolean; 255 | public 256 | constructor Create(const aSize, aCompressedSize, aPosition: integer; 257 | const aCompressed: boolean); virtual; 258 | property Size: integer read fSize; 259 | property CompressedSize: integer read fCompressedSize; 260 | property Position: integer read fPosition; 261 | property Compressed: boolean read fCompressed; 262 | end; 263 | 264 | constructor TZipFileEntryInfo.Create(const aSize, aCompressedSize, aPosition: integer; 265 | const aCompressed: boolean); 266 | begin 267 | Inherited Create; 268 | fSize := aSize; 269 | fCompressedSize := aCompressedSize; 270 | fPosition := aPosition; 271 | fCompressed := aCompressed; 272 | end; 273 | 274 | //------------------------------------------------------------------------------ 275 | constructor TZipFile.Create(const aFileName: string); 276 | begin 277 | Inherited Create; 278 | fFiles := TDXStringList.Create; 279 | fFileName := aFileName; 280 | Load; 281 | end; 282 | 283 | destructor TZipFile.Destroy; 284 | begin 285 | Clear; 286 | fFiles.Free; 287 | Inherited Destroy; 288 | end; 289 | 290 | function TZipFile.GetZipFileData(const Index: integer; var p: pointer; 291 | var size: integer): boolean; 292 | var 293 | tmp: pointer; 294 | zinf: TZipFileEntryInfo; 295 | csize: integer; 296 | begin 297 | if (Index >= 0) and (Index < fFiles.Count) then 298 | begin 299 | zinf := (fFiles.Objects[Index] as TZipFileEntryInfo); 300 | if zinf.Compressed then 301 | begin 302 | size := zinf.Size; 303 | csize := zinf.CompressedSize; 304 | GetMem(tmp, csize); 305 | try 306 | f.Seek(zinf.Position, soFromBeginning); 307 | f.Read(tmp^, csize); 308 | ZDecompress2(tmp, csize, size, p); 309 | finally 310 | FreeMem(tmp, csize); 311 | end; 312 | result := true; 313 | end 314 | else 315 | begin 316 | size := zinf.Size; 317 | GetMem(p, size); 318 | f.Seek(zinf.Position, soFromBeginning); 319 | f.Read(p^, size); 320 | result := true; 321 | end; 322 | end 323 | else 324 | result := false; 325 | end; 326 | 327 | function TZipFile.GetZipFileData(const Name: string; var p: pointer; 328 | var size: integer): boolean; 329 | var 330 | Name2: string; 331 | i: integer; 332 | begin 333 | Name2 := UpperCase(Name); 334 | for i := 1 to Length(Name) do 335 | if Name2[i] = '/' then 336 | Name2[i] := '\'; 337 | result := GetZipFileData(fFiles.IndexOf(Name2), p, size); 338 | end; 339 | 340 | function TZipFile.GetFile(Index: Integer): string; 341 | begin 342 | result := fFiles[Index]; 343 | end; 344 | 345 | procedure TZipFile.Load; 346 | var 347 | h: TZipFileHeader; 348 | str: string; 349 | i: integer; 350 | begin 351 | Clear; 352 | if fFileName <> '' then 353 | begin 354 | f := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyNone); 355 | while true do 356 | begin 357 | f.Read(h, SizeOf(h)); 358 | if h.Signature = ZIPFILESIGNATURE then 359 | begin 360 | SetLength(str, h.FileNameLen); 361 | if h.FileNameLen > 0 then 362 | begin 363 | f.Read((@str[1])^, h.FileNameLen); 364 | str := UpperCase(str); 365 | for i := 1 to h.FileNameLen do 366 | if str[i] = '/' then 367 | str[i] := '\'; 368 | fFiles.Objects[fFiles.Add(str)] := 369 | TZipFileEntryInfo.Create(h.UnCompressedSize, h.CompressedSize, 370 | f.Position + h.ExtraFieldLen, h.CompressionMethod > 0); 371 | if (h.BitFlag and $4) <> 0 then 372 | f.Seek(h.ExtraFieldLen + h.CompressedSize + SizeOf(TZipFileDescriptor), soFromCurrent) 373 | else 374 | f.Seek(h.ExtraFieldLen + h.CompressedSize, soFromCurrent); 375 | end; 376 | end 377 | else 378 | break; 379 | end; 380 | fFiles.Sorted := true; 381 | end; 382 | end; 383 | 384 | procedure TZipFile.Clear; 385 | var 386 | i: integer; 387 | begin 388 | for i := 0 to fFiles.Count - 1 do 389 | fFiles.Objects[i].Free; 390 | fFiles.Clear; 391 | f.Free; 392 | end; 393 | 394 | procedure TZipFile.SetFileName(const Value: string); 395 | begin 396 | if fFileName <> Value then 397 | begin 398 | fFileName := Value; 399 | Load; 400 | end; 401 | end; 402 | 403 | function TZipFile.GetFileCount: integer; 404 | begin 405 | result := fFiles.Count; 406 | end; 407 | 408 | end. 409 | -------------------------------------------------------------------------------- /FASTMM/FastMM4.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/FASTMM/FastMM4.pas -------------------------------------------------------------------------------- /FASTMM/FastMM4Messages.pas: -------------------------------------------------------------------------------- 1 | { 2 | 3 | Fast Memory Manager: Messages 4 | 5 | English translation by Pierre le Riche. 6 | 7 | } 8 | 9 | unit FastMM4Messages; 10 | 11 | interface 12 | 13 | {$Include FastMM4Options.inc} 14 | 15 | const 16 | {The name of the debug info support DLL} 17 | FullDebugModeLibraryName32Bit = 'FastMM_FullDebugMode.dll'; 18 | FullDebugModeLibraryName64Bit = 'FastMM_FullDebugMode64.dll'; 19 | {Event log strings} 20 | LogFileExtension = '_MemoryManager_EventLog.txt'#0; 21 | CRLF = #13#10; 22 | EventSeparator = '--------------------------------'; 23 | {Class name messages} 24 | UnknownClassNameMsg = 'Unknown'; 25 | {Memory dump message} 26 | MemoryDumpMsg = #13#10#13#10'Current memory dump of 256 bytes starting at pointer address '; 27 | {Block Error Messages} 28 | BlockScanLogHeader = 'Allocated block logged by LogAllocatedBlocksToFile. The size is: '; 29 | ErrorMsgHeader = 'FastMM has detected an error during a '; 30 | GetMemMsg = 'GetMem'; 31 | FreeMemMsg = 'FreeMem'; 32 | ReallocMemMsg = 'ReallocMem'; 33 | BlockCheckMsg = 'free block scan'; 34 | OperationMsg = ' operation. '; 35 | BlockHeaderCorruptedMsg = 'The block header has been corrupted. '; 36 | BlockFooterCorruptedMsg = 'The block footer has been corrupted. '; 37 | FreeModifiedErrorMsg = 'FastMM detected that a block has been modified after being freed. '; 38 | FreeModifiedDetailMsg = #13#10#13#10'Modified byte offsets (and lengths): '; 39 | DoubleFreeErrorMsg = 'An attempt has been made to free/reallocate an unallocated block.'; 40 | WrongMMFreeErrorMsg = 'An attempt has been made to free/reallocate a block that was allocated through a different FastMM instance. Check your memory manager sharing settings.'; 41 | PreviousBlockSizeMsg = #13#10#13#10'The previous block size was: '; 42 | CurrentBlockSizeMsg = #13#10#13#10'The block size is: '; 43 | PreviousObjectClassMsg = #13#10#13#10'The block was previously used for an object of class: '; 44 | CurrentObjectClassMsg = #13#10#13#10'The block is currently used for an object of class: '; 45 | PreviousAllocationGroupMsg = #13#10#13#10'The allocation group was: '; 46 | PreviousAllocationNumberMsg = #13#10#13#10'The allocation number was: '; 47 | CurrentAllocationGroupMsg = #13#10#13#10'The allocation group is: '; 48 | CurrentAllocationNumberMsg = #13#10#13#10'The allocation number is: '; 49 | BlockErrorMsgTitle = 'Memory Error Detected'; 50 | VirtualMethodErrorHeader = 'FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.'; 51 | InterfaceErrorHeader = 'FastMM has detected an attempt to use an interface of a freed object. An access violation will now be raised in order to abort the current operation.'; 52 | BlockHeaderCorruptedNoHistoryMsg = ' Unfortunately the block header has been corrupted so no history is available.'; 53 | FreedObjectClassMsg = #13#10#13#10'Freed object class: '; 54 | VirtualMethodName = #13#10#13#10'Virtual method: '; 55 | VirtualMethodOffset = 'Offset +'; 56 | VirtualMethodAddress = #13#10#13#10'Virtual method address: '; 57 | {Stack trace messages} 58 | CurrentThreadIDMsg = #13#10#13#10'The current thread ID is 0x'; 59 | CurrentStackTraceMsg = ', and the stack trace (return addresses) leading to this error is:'; 60 | ThreadIDPrevAllocMsg = #13#10#13#10'This block was previously allocated by thread 0x'; 61 | ThreadIDAtAllocMsg = #13#10#13#10'This block was allocated by thread 0x'; 62 | ThreadIDAtFreeMsg = #13#10#13#10'The block was previously freed by thread 0x'; 63 | ThreadIDAtObjectAllocMsg = #13#10#13#10'The object was allocated by thread 0x'; 64 | ThreadIDAtObjectFreeMsg = #13#10#13#10'The object was subsequently freed by thread 0x'; 65 | StackTraceMsg = ', and the stack trace (return addresses) at the time was:'; 66 | {Installation Messages} 67 | AlreadyInstalledMsg = 'FastMM4 is already installed.'; 68 | AlreadyInstalledTitle = 'Already installed.'; 69 | OtherMMInstalledMsg = 'FastMM4 cannot be installed since another third party memory ' 70 | + 'manager has already installed itself.'#13#10'If you want to use FastMM4, ' 71 | + 'please make sure that FastMM4.pas is the very first unit in the "uses"' 72 | + #13#10'section of your project''s .dpr file.'; 73 | OtherMMInstalledTitle = 'Cannot install FastMM4 - Another memory manager is already installed'; 74 | MemoryAllocatedMsg = 'FastMM4 cannot install since memory has already been ' 75 | + 'allocated through the default memory manager.'#13#10'FastMM4.pas MUST ' 76 | + 'be the first unit in your project''s .dpr file, otherwise memory may ' 77 | + 'be allocated'#13#10'through the default memory manager before FastMM4 ' 78 | + 'gains control. '#13#10#13#10'If you are using an exception trapper ' 79 | + 'like MadExcept (or any tool that modifies the unit initialization ' 80 | + 'order),'#13#10'go into its configuration page and ensure that the ' 81 | + 'FastMM4.pas unit is initialized before any other unit.'; 82 | MemoryAllocatedTitle = 'Cannot install FastMM4 - Memory has already been allocated'; 83 | {Leak checking messages} 84 | LeakLogHeader = 'A memory block has been leaked. The size is: '; 85 | LeakMessageHeader = 'This application has leaked memory. '; 86 | SmallLeakDetail = 'The small block leaks are' 87 | {$ifdef HideExpectedLeaksRegisteredByPointer} 88 | + ' (excluding expected leaks registered by pointer)' 89 | {$endif} 90 | + ':'#13#10; 91 | LargeLeakDetail = 'The sizes of leaked medium and large blocks are' 92 | {$ifdef HideExpectedLeaksRegisteredByPointer} 93 | + ' (excluding expected leaks registered by pointer)' 94 | {$endif} 95 | + ': '; 96 | BytesMessage = ' bytes: '; 97 | AnsiStringBlockMessage = 'AnsiString'; 98 | UnicodeStringBlockMessage = 'UnicodeString'; 99 | LeakMessageFooter = #13#10 100 | {$ifndef HideMemoryLeakHintMessage} 101 | + #13#10'Note: ' 102 | {$ifdef RequireIDEPresenceForLeakReporting} 103 | + 'This memory leak check is only performed if Delphi is currently running on the same computer. ' 104 | {$endif} 105 | {$ifdef FullDebugMode} 106 | {$ifdef LogMemoryLeakDetailToFile} 107 | + 'Memory leak detail is logged to a text file in the same folder as this application. ' 108 | {$else} 109 | + 'Enable the "LogMemoryLeakDetailToFile" to obtain a log file containing detail on memory leaks. ' 110 | {$endif} 111 | {$else} 112 | + 'To obtain a log file containing detail on memory leaks, enable the "FullDebugMode" and "LogMemoryLeakDetailToFile" conditional defines. ' 113 | {$endif} 114 | + 'To disable this memory leak check, undefine "EnableMemoryLeakReporting".'#13#10 115 | {$endif} 116 | + #0; 117 | LeakMessageTitle = 'Memory Leak Detected'; 118 | {$ifdef UseOutputDebugString} 119 | FastMMInstallMsg = 'FastMM has been installed.'; 120 | FastMMInstallSharedMsg = 'Sharing an existing instance of FastMM.'; 121 | FastMMUninstallMsg = 'FastMM has been uninstalled.'; 122 | FastMMUninstallSharedMsg = 'Stopped sharing an existing instance of FastMM.'; 123 | {$endif} 124 | {$ifdef DetectMMOperationsAfterUninstall} 125 | InvalidOperationTitle = 'MM Operation after uninstall.'; 126 | InvalidGetMemMsg = 'FastMM has detected a GetMem call after FastMM was uninstalled.'; 127 | InvalidFreeMemMsg = 'FastMM has detected a FreeMem call after FastMM was uninstalled.'; 128 | InvalidReallocMemMsg = 'FastMM has detected a ReallocMem call after FastMM was uninstalled.'; 129 | InvalidAllocMemMsg = 'FastMM has detected an AllocMem call after FastMM was uninstalled.'; 130 | {$endif} 131 | 132 | implementation 133 | 134 | end. 135 | 136 | 137 | 138 | -------------------------------------------------------------------------------- /IMAGEFORMATS/dib_PaletteEntriesToRGBQuads_fastloop.inc: -------------------------------------------------------------------------------- 1 | { pResult^.rgbRed := pEntry^.peRed; 2 | pResult^.rgbGreen := pEntry^.peGreen; 3 | pResult^.rgbBlue := pEntry^.peBlue; 4 | pResult^.rgbReserved := 0;} 5 | 6 | PInteger(pResult)^ := PInteger(pEntry)^; 7 | b := pResult^.rgbRed; 8 | pResult^.rgbRed := pResult^.rgbBlue; 9 | pResult^.rgbBlue := b; 10 | 11 | inc(pResult); 12 | inc(pEntry); 13 | 14 | PInteger(pResult)^ := PInteger(pEntry)^; 15 | b := pResult^.rgbRed; 16 | pResult^.rgbRed := pResult^.rgbBlue; 17 | pResult^.rgbBlue := b; 18 | 19 | inc(pResult); 20 | inc(pEntry); 21 | 22 | PInteger(pResult)^ := PInteger(pEntry)^; 23 | b := pResult^.rgbRed; 24 | pResult^.rgbRed := pResult^.rgbBlue; 25 | pResult^.rgbBlue := b; 26 | 27 | inc(pResult); 28 | inc(pEntry); 29 | 30 | PInteger(pResult)^ := PInteger(pEntry)^; 31 | b := pResult^.rgbRed; 32 | pResult^.rgbRed := pResult^.rgbBlue; 33 | pResult^.rgbBlue := b; 34 | 35 | inc(pResult); 36 | inc(pEntry); 37 | 38 | PInteger(pResult)^ := PInteger(pEntry)^; 39 | b := pResult^.rgbRed; 40 | pResult^.rgbRed := pResult^.rgbBlue; 41 | pResult^.rgbBlue := b; 42 | 43 | inc(pResult); 44 | inc(pEntry); 45 | 46 | PInteger(pResult)^ := PInteger(pEntry)^; 47 | b := pResult^.rgbRed; 48 | pResult^.rgbRed := pResult^.rgbBlue; 49 | pResult^.rgbBlue := b; 50 | 51 | inc(pResult); 52 | inc(pEntry); 53 | 54 | PInteger(pResult)^ := PInteger(pEntry)^; 55 | b := pResult^.rgbRed; 56 | pResult^.rgbRed := pResult^.rgbBlue; 57 | pResult^.rgbBlue := b; 58 | 59 | inc(pResult); 60 | inc(pEntry); 61 | 62 | PInteger(pResult)^ := PInteger(pEntry)^; 63 | b := pResult^.rgbRed; 64 | pResult^.rgbRed := pResult^.rgbBlue; 65 | pResult^.rgbBlue := b; 66 | 67 | inc(pResult); 68 | inc(pEntry); 69 | 70 | PInteger(pResult)^ := PInteger(pEntry)^; 71 | b := pResult^.rgbRed; 72 | pResult^.rgbRed := pResult^.rgbBlue; 73 | pResult^.rgbBlue := b; 74 | 75 | inc(pResult); 76 | inc(pEntry); 77 | 78 | PInteger(pResult)^ := PInteger(pEntry)^; 79 | b := pResult^.rgbRed; 80 | pResult^.rgbRed := pResult^.rgbBlue; 81 | pResult^.rgbBlue := b; 82 | 83 | inc(pResult); 84 | inc(pEntry); 85 | 86 | PInteger(pResult)^ := PInteger(pEntry)^; 87 | b := pResult^.rgbRed; 88 | pResult^.rgbRed := pResult^.rgbBlue; 89 | pResult^.rgbBlue := b; 90 | 91 | inc(pResult); 92 | inc(pEntry); 93 | 94 | PInteger(pResult)^ := PInteger(pEntry)^; 95 | b := pResult^.rgbRed; 96 | pResult^.rgbRed := pResult^.rgbBlue; 97 | pResult^.rgbBlue := b; 98 | 99 | inc(pResult); 100 | inc(pEntry); 101 | 102 | PInteger(pResult)^ := PInteger(pEntry)^; 103 | b := pResult^.rgbRed; 104 | pResult^.rgbRed := pResult^.rgbBlue; 105 | pResult^.rgbBlue := b; 106 | 107 | inc(pResult); 108 | inc(pEntry); 109 | 110 | PInteger(pResult)^ := PInteger(pEntry)^; 111 | b := pResult^.rgbRed; 112 | pResult^.rgbRed := pResult^.rgbBlue; 113 | pResult^.rgbBlue := b; 114 | 115 | inc(pResult); 116 | inc(pEntry); 117 | 118 | PInteger(pResult)^ := PInteger(pEntry)^; 119 | b := pResult^.rgbRed; 120 | pResult^.rgbRed := pResult^.rgbBlue; 121 | pResult^.rgbBlue := b; 122 | 123 | inc(pResult); 124 | inc(pEntry); 125 | 126 | PInteger(pResult)^ := PInteger(pEntry)^; 127 | b := pResult^.rgbRed; 128 | pResult^.rgbRed := pResult^.rgbBlue; 129 | pResult^.rgbBlue := b; 130 | 131 | inc(pResult); 132 | inc(pEntry); 133 | 134 | -------------------------------------------------------------------------------- /IMAGEFORMATS/dib_PaletteEntriesToRGBQuads_fastloop_end.inc: -------------------------------------------------------------------------------- 1 | { pResult^.rgbRed := pEntry^.peRed; 2 | pResult^.rgbGreen := pEntry^.peGreen; 3 | pResult^.rgbBlue := pEntry^.peBlue; 4 | pResult^.rgbReserved := 0;} 5 | 6 | PInteger(pResult)^ := PInteger(pEntry)^; 7 | b := pResult^.rgbRed; 8 | pResult^.rgbRed := pResult^.rgbBlue; 9 | pResult^.rgbBlue := b; 10 | 11 | inc(pResult); 12 | inc(pEntry); 13 | 14 | PInteger(pResult)^ := PInteger(pEntry)^; 15 | b := pResult^.rgbRed; 16 | pResult^.rgbRed := pResult^.rgbBlue; 17 | pResult^.rgbBlue := b; 18 | 19 | inc(pResult); 20 | inc(pEntry); 21 | 22 | PInteger(pResult)^ := PInteger(pEntry)^; 23 | b := pResult^.rgbRed; 24 | pResult^.rgbRed := pResult^.rgbBlue; 25 | pResult^.rgbBlue := b; 26 | 27 | inc(pResult); 28 | inc(pEntry); 29 | 30 | PInteger(pResult)^ := PInteger(pEntry)^; 31 | b := pResult^.rgbRed; 32 | pResult^.rgbRed := pResult^.rgbBlue; 33 | pResult^.rgbBlue := b; 34 | 35 | inc(pResult); 36 | inc(pEntry); 37 | 38 | PInteger(pResult)^ := PInteger(pEntry)^; 39 | b := pResult^.rgbRed; 40 | pResult^.rgbRed := pResult^.rgbBlue; 41 | pResult^.rgbBlue := b; 42 | 43 | inc(pResult); 44 | inc(pEntry); 45 | 46 | PInteger(pResult)^ := PInteger(pEntry)^; 47 | b := pResult^.rgbRed; 48 | pResult^.rgbRed := pResult^.rgbBlue; 49 | pResult^.rgbBlue := b; 50 | 51 | inc(pResult); 52 | inc(pEntry); 53 | 54 | PInteger(pResult)^ := PInteger(pEntry)^; 55 | b := pResult^.rgbRed; 56 | pResult^.rgbRed := pResult^.rgbBlue; 57 | pResult^.rgbBlue := b; 58 | 59 | inc(pResult); 60 | inc(pEntry); 61 | 62 | PInteger(pResult)^ := PInteger(pEntry)^; 63 | b := pResult^.rgbRed; 64 | pResult^.rgbRed := pResult^.rgbBlue; 65 | pResult^.rgbBlue := b; 66 | 67 | inc(pResult); 68 | inc(pEntry); 69 | 70 | PInteger(pResult)^ := PInteger(pEntry)^; 71 | b := pResult^.rgbRed; 72 | pResult^.rgbRed := pResult^.rgbBlue; 73 | pResult^.rgbBlue := b; 74 | 75 | inc(pResult); 76 | inc(pEntry); 77 | 78 | PInteger(pResult)^ := PInteger(pEntry)^; 79 | b := pResult^.rgbRed; 80 | pResult^.rgbRed := pResult^.rgbBlue; 81 | pResult^.rgbBlue := b; 82 | 83 | inc(pResult); 84 | inc(pEntry); 85 | 86 | PInteger(pResult)^ := PInteger(pEntry)^; 87 | b := pResult^.rgbRed; 88 | pResult^.rgbRed := pResult^.rgbBlue; 89 | pResult^.rgbBlue := b; 90 | 91 | inc(pResult); 92 | inc(pEntry); 93 | 94 | PInteger(pResult)^ := PInteger(pEntry)^; 95 | b := pResult^.rgbRed; 96 | pResult^.rgbRed := pResult^.rgbBlue; 97 | pResult^.rgbBlue := b; 98 | 99 | inc(pResult); 100 | inc(pEntry); 101 | 102 | PInteger(pResult)^ := PInteger(pEntry)^; 103 | b := pResult^.rgbRed; 104 | pResult^.rgbRed := pResult^.rgbBlue; 105 | pResult^.rgbBlue := b; 106 | 107 | inc(pResult); 108 | inc(pEntry); 109 | 110 | PInteger(pResult)^ := PInteger(pEntry)^; 111 | b := pResult^.rgbRed; 112 | pResult^.rgbRed := pResult^.rgbBlue; 113 | pResult^.rgbBlue := b; 114 | 115 | inc(pResult); 116 | inc(pEntry); 117 | 118 | PInteger(pResult)^ := PInteger(pEntry)^; 119 | b := pResult^.rgbRed; 120 | pResult^.rgbRed := pResult^.rgbBlue; 121 | pResult^.rgbBlue := b; 122 | 123 | inc(pResult); 124 | inc(pEntry); 125 | 126 | PInteger(pResult)^ := PInteger(pEntry)^; 127 | b := pResult^.rgbRed; 128 | pResult^.rgbRed := pResult^.rgbBlue; 129 | pResult^.rgbBlue := b; 130 | 131 | -------------------------------------------------------------------------------- /IMAGEFORMATS/dib_RGBQuadsToPaletteEntries_fastloop.inc: -------------------------------------------------------------------------------- 1 | PInteger(pResult)^ := PInteger(pQuad)^; 2 | b := pResult^.peRed; 3 | pResult^.peRed := pResult^.peBlue; 4 | pResult^.peBlue := b; 5 | 6 | inc(pResult); 7 | inc(pQuad); 8 | 9 | PInteger(pResult)^ := PInteger(pQuad)^; 10 | b := pResult^.peRed; 11 | pResult^.peRed := pResult^.peBlue; 12 | pResult^.peBlue := b; 13 | 14 | inc(pResult); 15 | inc(pQuad); 16 | 17 | PInteger(pResult)^ := PInteger(pQuad)^; 18 | b := pResult^.peRed; 19 | pResult^.peRed := pResult^.peBlue; 20 | pResult^.peBlue := b; 21 | 22 | inc(pResult); 23 | inc(pQuad); 24 | 25 | PInteger(pResult)^ := PInteger(pQuad)^; 26 | b := pResult^.peRed; 27 | pResult^.peRed := pResult^.peBlue; 28 | pResult^.peBlue := b; 29 | 30 | inc(pResult); 31 | inc(pQuad); 32 | 33 | PInteger(pResult)^ := PInteger(pQuad)^; 34 | b := pResult^.peRed; 35 | pResult^.peRed := pResult^.peBlue; 36 | pResult^.peBlue := b; 37 | 38 | inc(pResult); 39 | inc(pQuad); 40 | 41 | PInteger(pResult)^ := PInteger(pQuad)^; 42 | b := pResult^.peRed; 43 | pResult^.peRed := pResult^.peBlue; 44 | pResult^.peBlue := b; 45 | 46 | inc(pResult); 47 | inc(pQuad); 48 | 49 | PInteger(pResult)^ := PInteger(pQuad)^; 50 | b := pResult^.peRed; 51 | pResult^.peRed := pResult^.peBlue; 52 | pResult^.peBlue := b; 53 | 54 | inc(pResult); 55 | inc(pQuad); 56 | 57 | PInteger(pResult)^ := PInteger(pQuad)^; 58 | b := pResult^.peRed; 59 | pResult^.peRed := pResult^.peBlue; 60 | pResult^.peBlue := b; 61 | 62 | inc(pResult); 63 | inc(pQuad); 64 | 65 | PInteger(pResult)^ := PInteger(pQuad)^; 66 | b := pResult^.peRed; 67 | pResult^.peRed := pResult^.peBlue; 68 | pResult^.peBlue := b; 69 | 70 | inc(pResult); 71 | inc(pQuad); 72 | 73 | PInteger(pResult)^ := PInteger(pQuad)^; 74 | b := pResult^.peRed; 75 | pResult^.peRed := pResult^.peBlue; 76 | pResult^.peBlue := b; 77 | 78 | inc(pResult); 79 | inc(pQuad); 80 | 81 | PInteger(pResult)^ := PInteger(pQuad)^; 82 | b := pResult^.peRed; 83 | pResult^.peRed := pResult^.peBlue; 84 | pResult^.peBlue := b; 85 | 86 | inc(pResult); 87 | inc(pQuad); 88 | 89 | PInteger(pResult)^ := PInteger(pQuad)^; 90 | b := pResult^.peRed; 91 | pResult^.peRed := pResult^.peBlue; 92 | pResult^.peBlue := b; 93 | 94 | inc(pResult); 95 | inc(pQuad); 96 | 97 | PInteger(pResult)^ := PInteger(pQuad)^; 98 | b := pResult^.peRed; 99 | pResult^.peRed := pResult^.peBlue; 100 | pResult^.peBlue := b; 101 | 102 | inc(pResult); 103 | inc(pQuad); 104 | 105 | PInteger(pResult)^ := PInteger(pQuad)^; 106 | b := pResult^.peRed; 107 | pResult^.peRed := pResult^.peBlue; 108 | pResult^.peBlue := b; 109 | 110 | inc(pResult); 111 | inc(pQuad); 112 | 113 | PInteger(pResult)^ := PInteger(pQuad)^; 114 | b := pResult^.peRed; 115 | pResult^.peRed := pResult^.peBlue; 116 | pResult^.peBlue := b; 117 | 118 | inc(pResult); 119 | inc(pQuad); 120 | 121 | PInteger(pResult)^ := PInteger(pQuad)^; 122 | b := pResult^.peRed; 123 | pResult^.peRed := pResult^.peBlue; 124 | pResult^.peBlue := b; 125 | 126 | inc(pResult); 127 | inc(pQuad); 128 | -------------------------------------------------------------------------------- /IMAGEFORMATS/dib_RGBQuadsToPaletteEntries_fastloop_end.inc: -------------------------------------------------------------------------------- 1 | PInteger(pResult)^ := PInteger(pQuad)^; 2 | b := pResult^.peRed; 3 | pResult^.peRed := pResult^.peBlue; 4 | pResult^.peBlue := b; 5 | 6 | inc(pResult); 7 | inc(pQuad); 8 | 9 | PInteger(pResult)^ := PInteger(pQuad)^; 10 | b := pResult^.peRed; 11 | pResult^.peRed := pResult^.peBlue; 12 | pResult^.peBlue := b; 13 | 14 | inc(pResult); 15 | inc(pQuad); 16 | 17 | PInteger(pResult)^ := PInteger(pQuad)^; 18 | b := pResult^.peRed; 19 | pResult^.peRed := pResult^.peBlue; 20 | pResult^.peBlue := b; 21 | 22 | inc(pResult); 23 | inc(pQuad); 24 | 25 | PInteger(pResult)^ := PInteger(pQuad)^; 26 | b := pResult^.peRed; 27 | pResult^.peRed := pResult^.peBlue; 28 | pResult^.peBlue := b; 29 | 30 | inc(pResult); 31 | inc(pQuad); 32 | 33 | PInteger(pResult)^ := PInteger(pQuad)^; 34 | b := pResult^.peRed; 35 | pResult^.peRed := pResult^.peBlue; 36 | pResult^.peBlue := b; 37 | 38 | inc(pResult); 39 | inc(pQuad); 40 | 41 | PInteger(pResult)^ := PInteger(pQuad)^; 42 | b := pResult^.peRed; 43 | pResult^.peRed := pResult^.peBlue; 44 | pResult^.peBlue := b; 45 | 46 | inc(pResult); 47 | inc(pQuad); 48 | 49 | PInteger(pResult)^ := PInteger(pQuad)^; 50 | b := pResult^.peRed; 51 | pResult^.peRed := pResult^.peBlue; 52 | pResult^.peBlue := b; 53 | 54 | inc(pResult); 55 | inc(pQuad); 56 | 57 | PInteger(pResult)^ := PInteger(pQuad)^; 58 | b := pResult^.peRed; 59 | pResult^.peRed := pResult^.peBlue; 60 | pResult^.peBlue := b; 61 | 62 | inc(pResult); 63 | inc(pQuad); 64 | 65 | PInteger(pResult)^ := PInteger(pQuad)^; 66 | b := pResult^.peRed; 67 | pResult^.peRed := pResult^.peBlue; 68 | pResult^.peBlue := b; 69 | 70 | inc(pResult); 71 | inc(pQuad); 72 | 73 | PInteger(pResult)^ := PInteger(pQuad)^; 74 | b := pResult^.peRed; 75 | pResult^.peRed := pResult^.peBlue; 76 | pResult^.peBlue := b; 77 | 78 | inc(pResult); 79 | inc(pQuad); 80 | 81 | PInteger(pResult)^ := PInteger(pQuad)^; 82 | b := pResult^.peRed; 83 | pResult^.peRed := pResult^.peBlue; 84 | pResult^.peBlue := b; 85 | 86 | inc(pResult); 87 | inc(pQuad); 88 | 89 | PInteger(pResult)^ := PInteger(pQuad)^; 90 | b := pResult^.peRed; 91 | pResult^.peRed := pResult^.peBlue; 92 | pResult^.peBlue := b; 93 | 94 | inc(pResult); 95 | inc(pQuad); 96 | 97 | PInteger(pResult)^ := PInteger(pQuad)^; 98 | b := pResult^.peRed; 99 | pResult^.peRed := pResult^.peBlue; 100 | pResult^.peBlue := b; 101 | 102 | inc(pResult); 103 | inc(pQuad); 104 | 105 | PInteger(pResult)^ := PInteger(pQuad)^; 106 | b := pResult^.peRed; 107 | pResult^.peRed := pResult^.peBlue; 108 | pResult^.peBlue := b; 109 | 110 | inc(pResult); 111 | inc(pQuad); 112 | 113 | PInteger(pResult)^ := PInteger(pQuad)^; 114 | b := pResult^.peRed; 115 | pResult^.peRed := pResult^.peBlue; 116 | pResult^.peBlue := b; 117 | 118 | inc(pResult); 119 | inc(pQuad); 120 | 121 | PInteger(pResult)^ := PInteger(pQuad)^; 122 | b := pResult^.peRed; 123 | pResult^.peRed := pResult^.peBlue; 124 | pResult^.peBlue := b; 125 | -------------------------------------------------------------------------------- /IMAGEFORMATS/dibimage.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/IMAGEFORMATS/dibimage.pas -------------------------------------------------------------------------------- /IMAGEFORMATS/pngimage.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/IMAGEFORMATS/pngimage.pas -------------------------------------------------------------------------------- /IMAGEFORMATS/pnglang.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/IMAGEFORMATS/pnglang.pas -------------------------------------------------------------------------------- /IMAGEFORMATS/xGIF.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/IMAGEFORMATS/xGIF.pas -------------------------------------------------------------------------------- /IMAGEFORMATS/xM8.pas: -------------------------------------------------------------------------------- 1 | // The Heretic II mipmap graphic format is a raster image format introduced by Heretic II game. 2 | // This graphic format is a MipMap, that means it have the full size picture and some other 3 | // pictures each one one half the size of the previous picture.File extenstion for this graphic 4 | // format is m8 (*.m8). Supported bits per pixel for this graphic format is 8bpp. It uses a 256 5 | // color palette, just as 8bpp Windows bitmaps. 6 | /////////////////////////////////////////////////// 7 | // Author: Jim Valavanis, 8 | // E-Mail: jimmyvalavanis@yahoo.gr 9 | // Site : http://www.geocities.com/jimmyvalavanis/ 10 | /////////////////////////////////////////////////// 11 | 12 | // 2018: 13 | // Original version can still be downloaded at my old geocities site at: 14 | // http://www.geocities.ws/jimmyvalavanis/programming/gformats/m8.html 15 | 16 | unit xM8; 17 | 18 | {$P+,S-,W-,R-,T-,X+,H+} 19 | {$C PRELOAD} 20 | 21 | interface 22 | 23 | uses 24 | Windows, Forms, SysUtils, Classes, Graphics; 25 | 26 | type 27 | TM8Bitmap = class(TBitmap) 28 | private 29 | procedure WriteM8StreamData(Stream: TStream); 30 | procedure ReadM8StreamData(Stream: TStream); 31 | protected 32 | procedure WriteData(Stream: TStream); override; 33 | procedure ReadData(Stream: TStream); override; 34 | public 35 | procedure SaveToStream(Stream: TStream); override; 36 | procedure LoadFromStream(Stream: TStream); override; 37 | end; 38 | 39 | resourceString 40 | rsPPMError = 'Error reading M8 file: Wrong file type.'; 41 | 42 | implementation 43 | 44 | { TM8Bitmap } 45 | 46 | type 47 | TQuake2Palette = packed array[0..255] of packed record R, G, B: byte; end; 48 | 49 | // Heretic2 m8 header 50 | Miptex_T_m8 = record 51 | Identifier: integer; // hexa: 02 00 00 00 52 | Name: array[0..31] of char; 53 | Widths: array[0..15] of Longint; 54 | Heights: array[0..15] of Longint; 55 | Offsets: array[0..15] of Longint; 56 | Animname: array[0..31] of char; 57 | Palette: TQuake2Palette; 58 | Flags: Longint; 59 | Contents: Longint; 60 | Value: Longint; 61 | end; 62 | 63 | procedure TM8Bitmap.WriteData(Stream: TStream); 64 | begin 65 | WriteM8StreamData(Stream); 66 | end; 67 | 68 | procedure TM8Bitmap.SaveToStream(Stream: TStream); 69 | begin 70 | WriteM8StreamData(Stream); 71 | end; 72 | 73 | procedure TM8Bitmap.LoadFromStream(Stream: TStream); 74 | begin 75 | ReadM8StreamData(Stream); 76 | end; 77 | 78 | procedure TM8Bitmap.ReadData(Stream: TStream); 79 | begin 80 | ReadM8StreamData(Stream); 81 | end; 82 | 83 | procedure TM8Bitmap.ReadM8StreamData(Stream: TStream); 84 | var 85 | aBitmap: TBitmap; 86 | Header: Miptex_T_m8; 87 | i, j: integer; 88 | P1: PByteArray; 89 | lpal: PLogPalette; 90 | hpal: HPALETTE; 91 | nearBlack: integer; 92 | pos: integer; 93 | begin 94 | pos := Stream.Position; 95 | Stream.Read(Header, SizeOf(Header)); 96 | aBitmap := TBitmap.Create; 97 | GetMem(lpal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 255); 98 | hpal := 0; 99 | try 100 | aBitmap.Width := Header.Widths[0]; 101 | aBitmap.Height := Header.Heights[0]; 102 | aBitmap.PixelFormat := pf8Bit; 103 | 104 | lpal.palVersion := $300; 105 | lpal.palNumEntries := 256; 106 | lpal.palPalEntry[0].peRed := 0; 107 | lpal.palPalEntry[0].peGreen := 0; 108 | lpal.palPalEntry[0].peBlue := 0; 109 | for j := 1 to 255 do 110 | begin 111 | lpal.palPalEntry[j].peRed := Header.Palette[j].r; 112 | lpal.palPalEntry[j].peGreen := Header.Palette[j].g; 113 | lpal.palPalEntry[j].peBlue := Header.Palette[j].b; 114 | end; 115 | nearBlack := 1; 116 | 117 | for j := 255 downto 1 do 118 | begin 119 | if ((lpal.palPalEntry[j].peRed + 120 | lpal.palPalEntry[j].peGreen + 121 | lpal.palPalEntry[j].peBlue) < 122 | (lpal.palPalEntry[nearBlack].peRed + 123 | lpal.palPalEntry[nearBlack].peGreen + 124 | lpal.palPalEntry[nearBlack].peBlue)) and 125 | ((lpal.palPalEntry[j].peRed + 126 | lpal.palPalEntry[j].peGreen + 127 | lpal.palPalEntry[j].peBlue) <> 0) then nearBlack := j; 128 | end; 129 | 130 | for j := 255 downto 1 do 131 | begin 132 | if lpal.palPalEntry[j].peRed + lpal.palPalEntry[j].peGreen + lpal.palPalEntry[j].peBlue = 0 then 133 | lpal.palPalEntry[j] := lpal.palPalEntry[nearBlack]; 134 | end; 135 | 136 | hpal := CreatePalette(lpal^); 137 | 138 | if hpal <> 0 then 139 | aBitmap.Palette := hpal; 140 | 141 | stream.Position := pos + Header.Offsets[0]; 142 | for i := 0 to aBitmap.Height - 1 do 143 | begin 144 | P1 := aBitmap.Scanline[i]; 145 | Stream.Read(P1^, aBitmap.width); 146 | for j := 0 to aBitmap.Width - 1 do 147 | if P1[j] = 0 then P1[j] := nearBlack; 148 | end; 149 | Assign(aBitmap); 150 | finally 151 | aBitmap.Free; 152 | FreeMem(lpal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 255); 153 | if hPal <> 0 then 154 | DeleteObject(hPal); 155 | end; 156 | end; 157 | 158 | type 159 | TColorAppearence = record 160 | color: TColor; 161 | num: integer; 162 | end; 163 | 164 | TColorAppearences = array[0..$FFFF] of TColorAppearence; 165 | PColorAppearences = ^TColorAppearences; 166 | 167 | function AlmostEqualColors(c1, c2: TColor): boolean; 168 | begin 169 | result := sqr(integer(GetRValue(c1)) - integer(GetRValue(c2))) + 170 | sqr(integer(GetGValue(c1)) - integer(GetGValue(c2))) + 171 | sqr(integer(GetBValue(c1)) - integer(GetBValue(c2))) <= 256; 172 | end; 173 | 174 | procedure ForceBitmapTo8bpp(bmp: TBitmap); 175 | // Converts a bitmap to 8 bits per pixel, returns false 176 | // if bitmap has more than 256 unique colors 177 | var 178 | CC: PColorAppearences; 179 | i, j, k: integer; 180 | b: PByteArray; 181 | numC: integer; 182 | c: TColor; 183 | found: boolean; 184 | lpal: PLogPalette; 185 | hpal: HPALETTE; 186 | newBMPData: PByteArray; 187 | dist, dist1: integer; 188 | index: integer; 189 | begin 190 | if bmp.PixelFormat in [pf1bit, pf4bit] then 191 | bmp.PixelFormat := pf8bit 192 | else if bmp.PixelFormat <> pf8bit then 193 | begin 194 | bmp.PixelFormat := pf24bit; 195 | numC := 16; 196 | CC := nil; 197 | ReAllocMem(CC, SizeOf(TColorAppearence)); 198 | // Default Windows Palette 199 | CC[0].color := RGB(0, 0, 0); 200 | CC[0].num := 0; 201 | 202 | GetMem(newBMPData, bmp.Width * bmp.Height); 203 | for i := 0 to bmp.Height - 1 do 204 | begin 205 | b := bmp.ScanLine[i]; 206 | for j := 0 to bmp.Width - 1 do 207 | begin 208 | c := RGB(b[3 * j + 2], b[3 * j + 1], b[3 * j]); 209 | found := false; 210 | for k := 0 to numC - 1 do 211 | begin 212 | // Color already exists in the palette, increase appearences counter 213 | if AlmostEqualColors(CC[k].color, c) then 214 | // if CC[k].color = c then 215 | begin 216 | found := true; 217 | CC[k].num := CC[k].num + 1; 218 | newBMPData[i * bmp.Width + j] := k; 219 | break; 220 | end; 221 | end; 222 | // New color, add it to the palette 223 | if not found then 224 | begin 225 | if numC < 256 then // Less than 256 colors 226 | begin 227 | inc(numC); 228 | ReAllocMem(CC, numC * SizeOf(TColorAppearence)); 229 | newBMPData[i * bmp.Width + j] := numC - 1; 230 | CC[numC - 1].color := c; 231 | CC[numC - 1].num := 1; 232 | end 233 | else 234 | begin 235 | // Find the closest color 236 | dist := MAXINT; 237 | index := 0; 238 | for k := 0 to 255 do 239 | begin 240 | dist1 := abs(integer(GetRValue(CC[k].color)) - integer(GetRValue(c))) * 241 | abs(integer(GetGValue(CC[k].color)) - integer(GetGValue(c))) * 242 | abs(integer(GetBValue(CC[k].color)) - integer(GetBValue(c))); 243 | if dist1 < dist then 244 | begin 245 | dist := dist1; 246 | index := k; 247 | end; 248 | end; 249 | newBMPData[i * bmp.Width + j] := index; 250 | end; 251 | end; 252 | end; 253 | end; 254 | GetMem(lpal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 255); 255 | lpal.palVersion := $300; 256 | lpal.palNumEntries := 256; 257 | for i := 0 to numC - 1 do 258 | begin 259 | lpal.palPalEntry[i].peRed := GetRValue(CC[i].color); 260 | lpal.palPalEntry[i].peGreen := GetGValue(CC[i].color); 261 | lpal.palPalEntry[i].peBlue := GetBValue(CC[i].color); 262 | end; 263 | for i := numC to 255 do 264 | begin 265 | lpal.palPalEntry[i].peRed := 0; 266 | lpal.palPalEntry[i].peGreen := 0; 267 | lpal.palPalEntry[i].peBlue := 0; 268 | end; 269 | bmp.PixelFormat := pf8bit; 270 | hpal := CreatePalette(lpal^); 271 | if hpal <> 0 then bmp.Palette := hpal; 272 | for i := 0 to bmp.Height - 1 do 273 | begin 274 | b := bmp.ScanLine[i]; 275 | for j := 0 to bmp.Width - 1 do 276 | b[j] := newBMPData[i * bmp.Width + j]; 277 | end; 278 | FreeMem(lpal, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 255); 279 | // DeleteObject(hpal); 280 | 281 | FreeMem(newBMPData, bmp.Width * bmp.Height); 282 | ReAllocMem(CC, 0); 283 | end; 284 | end; 285 | 286 | procedure TM8Bitmap.WriteM8StreamData(Stream: TStream); 287 | var 288 | aBitmap: TBitmap; 289 | i: integer; 290 | P1: PByteArray; 291 | Header: Miptex_T_m8; 292 | Entries: array[0..255] of TPaletteEntry; 293 | begin 294 | aBitmap := TBitmap.Create; 295 | try 296 | aBitmap.Assign(self); 297 | if aBitmap.PixelFormat <> pf8bit then 298 | ForceBitmapTo8bpp(aBitmap); 299 | 300 | FillChar(Header, SizeOf(Header), Chr(0)); 301 | GetPaletteEntries(aBitmap.Palette, 0, 255, Entries); 302 | for i := 0 to 255 do 303 | begin 304 | Header.Palette[i].R := Entries[i].peRed; 305 | Header.Palette[i].G := Entries[i].peGreen; 306 | Header.Palette[i].B := Entries[i].peBlue; 307 | end; 308 | Header.Identifier := 2; // Default Heretic2 id 309 | 310 | for i := 0 to 15 do 311 | begin 312 | Header.Widths[i] := aBitmap.Width; 313 | Header.Heights[i] := aBitmap.Height; 314 | Header.Offsets[i] := SizeOf(Header); 315 | end; 316 | Stream.Write(Header, SizeOf(Header)); 317 | for i := 0 to aBitmap.Height - 1 do 318 | begin 319 | P1 := aBitmap.ScanLine[i]; 320 | Stream.Write(P1^, aBitmap.Width); 321 | end; 322 | finally 323 | aBitmap.Free; 324 | end; 325 | end; 326 | 327 | initialization 328 | { Register the TM8Bitmap as a new graphic file format 329 | now all the TPicture storage stuff can access our new 330 | M8 graphic format ! 331 | } 332 | TPicture.RegisterFileFormat('M8','M8 (Heretic 2) Mipmap bitmap', TM8Bitmap); 333 | 334 | finalization 335 | TPicture.UnregisterGraphicClass(TM8Bitmap); 336 | 337 | end. 338 | -------------------------------------------------------------------------------- /IMAGEFORMATS/xPPM.pas: -------------------------------------------------------------------------------- 1 | // Portable Pixelmap is a UNIX raster format for exchanging images in color. Supported bit per pixel 2 | // depth is 24bpp(true color). Both binary and ascii formats are supported. 3 | /////////////////////////////////////////////////// 4 | // Author: Jim Valavanis, 5 | // E-Mail: jimmyvalavanis@yahoo.gr 6 | // Site : http://www.geocities.com/jimmyvalavanis/ 7 | /////////////////////////////////////////////////// 8 | 9 | // 2018: 10 | // Original version can still be downloaded at my old geocities site at: 11 | // http://www.geocities.ws/jimmyvalavanis/programming/gformats/ppm.html 12 | 13 | unit xPPM; 14 | 15 | {$P+,S-,W-,R-,T-,X+,H+} 16 | {$C PRELOAD} 17 | 18 | interface 19 | 20 | uses 21 | Windows, Forms, SysUtils, Classes, Graphics; 22 | 23 | type 24 | TPPMBitmapType = (ppmBinary, ppmAscii); 25 | 26 | TPPMBitmap = class(TBitmap) 27 | private 28 | procedure WritePPMStreamData(Stream: TStream); 29 | procedure ReadPPMStreamData(Stream: TStream); 30 | protected 31 | procedure WriteData(Stream: TStream); override; 32 | procedure ReadData(Stream: TStream); override; 33 | public 34 | Copyright: string; 35 | ppmType: TPPMBitmapType; 36 | constructor Create; override; 37 | procedure SaveToStream(Stream: TStream); override; 38 | procedure LoadFromStream(Stream: TStream); override; 39 | end; 40 | 41 | resourceString 42 | rsCopyrightVJ = '# TPPMBitmap Delphi Component, Copyright 2002, Jim Valavanis'; 43 | rsPPMHeaderBinary = 'P6'; 44 | rsPPMHeaderAscii = 'P3'; 45 | rsPPMError = 'Error reading PPM file: Wrong file type.'; 46 | 47 | implementation 48 | 49 | { TPPMBitmap } 50 | 51 | constructor TPPMBitmap.Create; 52 | begin 53 | Inherited; 54 | Copyright := rsCopyrightVJ; 55 | ppmType := ppmBinary; 56 | end; 57 | 58 | procedure TPPMBitmap.WriteData(Stream: TStream); 59 | begin 60 | WritePPMStreamData(Stream); 61 | end; 62 | 63 | procedure TPPMBitmap.SaveToStream(Stream: TStream); 64 | begin 65 | WritePPMStreamData(Stream); 66 | end; 67 | 68 | procedure TPPMBitmap.LoadFromStream(Stream: TStream); 69 | begin 70 | ReadPPMStreamData(Stream); 71 | end; 72 | 73 | procedure TPPMBitmap.ReadData(Stream: TStream); 74 | begin 75 | ReadPPMStreamData(Stream); 76 | end; 77 | 78 | function FirstWord(s: string): string; 79 | var i: integer; 80 | begin 81 | result := ''; 82 | i := 1; 83 | while (s[i] = ' ') and (i < length(s)) do inc(i); 84 | repeat 85 | if s[i] <> ' ' then result := result + s[i]; 86 | inc(i); 87 | until (i - 1 = length(s)) or (s[i - 1] = ' '); 88 | end; 89 | 90 | function SecondWord(s: string): string; 91 | var i: integer; 92 | begin 93 | result := ''; 94 | i := 1; 95 | while (s[i] = ' ') and (i < length(s)) do inc(i); 96 | while (s[i] <> ' ') and (i < length(s)) do inc(i); 97 | while (s[i] = ' ') and (i < length(s)) do inc(i); 98 | repeat 99 | if s[i] <> ' ' then result := result + s[i]; 100 | inc(i); 101 | until (i - 1 = length(s)) or (s[i - 1] = ' '); 102 | end; 103 | 104 | function ThirdWord(s: string): string; 105 | var i: integer; 106 | begin 107 | result := ''; 108 | i := 1; 109 | while (s[i] = ' ') and (i < length(s)) do inc(i); 110 | while (s[i] <> ' ') and (i < length(s)) do inc(i); 111 | while (s[i] = ' ') and (i < length(s)) do inc(i); 112 | while (s[i] <> ' ') and (i < length(s)) do inc(i); 113 | while (s[i] = ' ') and (i < length(s)) do inc(i); 114 | if i < length(s) then 115 | repeat 116 | if s[i] <> ' ' then result := result + s[i]; 117 | inc(i); 118 | until (i - 1 = length(s)) or (s[i - 1] = ' '); 119 | end; 120 | 121 | type 122 | TDelimeters = set of char; 123 | const 124 | PPMDelimeters: TDelimeters = [#10, ' ']; 125 | 126 | function NextWord(Stream: TStream; Delimeters: TDelimeters): string; 127 | var c: char; 128 | function NextCh: char; 129 | begin 130 | Stream.Read(c, SizeOf(c)); 131 | result := c; 132 | end; 133 | begin 134 | result := ''; 135 | while (Stream.Position < Stream.Size) and (NextCh in Delimeters) do; 136 | if Stream.Position = Stream.size then 137 | exit 138 | else 139 | result := c; 140 | while (Stream.Position < Stream.Size) and not (NextCh in Delimeters) do 141 | result := result + c; 142 | end; 143 | 144 | procedure TPPMBitmap.ReadPPMStreamData(Stream: TStream); 145 | var 146 | aBitmap : TBitmap; 147 | buf : Array [0..8191] of byte; 148 | Header: string; 149 | s: string; 150 | c: char; 151 | i,j: integer; 152 | P1: PByteArray; 153 | begin 154 | Stream.Read(c, SizeOf(c)); 155 | Header := c; 156 | Stream.Read(c, SizeOf(c)); 157 | Header := Header + c; 158 | if Header = rsPPMHeaderBinary then 159 | ppmType := ppmBinary 160 | else if Header = rsPPMHeaderAscii then 161 | ppmType := ppmAscii 162 | else 163 | begin 164 | raise Exception.Create(rsPPMError); 165 | exit; 166 | end; 167 | Stream.Read(c, SizeOf(c)); 168 | if not (c in PPMDelimeters) then 169 | begin 170 | raise Exception.Create(rsPPMError); 171 | exit; 172 | end; 173 | repeat 174 | s := NextWord(Stream, [#10]); 175 | until s[1] <> '#'; // End comment 176 | aBitmap := TBitmap.Create; 177 | aBitmap.Width := StrToInt(FirstWord(s)); 178 | aBitmap.Height := StrToInt(SecondWord(s)); 179 | if ThirdWord(s) = '' then 180 | NextWord(Stream, PPMDelimeters); // Next line (?Bitcount?) not implement, use 255 for writer 181 | aBitmap.PixelFormat := pf24bit; 182 | if ppmType = ppmBinary then for i := 0 to aBitmap.Height - 1 do 183 | begin 184 | Stream.Read(buf, aBitmap.Width * 3); 185 | P1 := aBitmap.Scanline[i]; 186 | for j := 0 to (aBitmap.Width - 1) do 187 | begin 188 | P1[j*3] := buf[j*3+2]; 189 | P1[j*3+1] := buf[j*3+1]; 190 | P1[j*3+2] := buf[j*3]; 191 | end; 192 | end 193 | else 194 | for i := 0 to aBitmap.Height - 1 do 195 | begin 196 | P1 := aBitmap.Scanline[i]; 197 | for j := 0 to (aBitmap.Width - 1) do 198 | begin 199 | P1[j*3+2] := StrToInt(NextWord(Stream, PPMDelimeters)); 200 | P1[j*3+1] := StrToInt(NextWord(Stream, PPMDelimeters)); 201 | P1[j*3] := StrToInt(NextWord(Stream, PPMDelimeters)); 202 | end; 203 | end; 204 | Assign(aBitmap); 205 | aBitmap.Free; 206 | end; 207 | 208 | procedure TPPMBitmap.WritePPMStreamData(Stream: TStream); 209 | var 210 | aBitmap: TBitmap; 211 | buf : Array [0..8191] of byte; 212 | i, j: integer; 213 | P1: PByteArray; 214 | sizeInfo,s: string; 215 | c: char; 216 | begin 217 | aBitmap := TBitmap.Create; 218 | try 219 | aBitmap.Assign(self); 220 | aBitmap.PixelFormat := pf24bit; 221 | c := Chr(10); 222 | if ppmType = ppmBinary then 223 | Stream.Write(PChar(rsPPMHeaderBinary)^, Length(rsPPMHeaderBinary)) 224 | else 225 | Stream.Write(PChar(rsPPMHeaderAscii)^, Length(rsPPMHeaderAscii)); 226 | Stream.Write(c, SizeOf(c)); // write delimeter 227 | Stream.Write(PChar(rsCopyrightVJ)^, Length(rsCopyrightVJ)); 228 | Stream.Write(c, SizeOf(c)); // write delimeter 229 | sizeInfo := IntToStr(aBitmap.Width) + ' ' + IntToStr(aBitmap.Height); 230 | Stream.Write(PChar(sizeInfo)^, Length(sizeInfo)); 231 | Stream.Write(c, SizeOf(c)); // write delimeter 232 | s := IntToStr(255); 233 | Stream.Write(PChar(s)^, Length(s)); 234 | Stream.Write(c, SizeOf(c)); // write delimeter 235 | if ppmType = ppmBinary then for i := 0 to aBitmap.Height - 1 do 236 | begin 237 | P1 := aBitmap.ScanLine[i]; 238 | for j := 0 to (aBitmap.Width - 1) do 239 | begin 240 | buf[j*3] := P1[j*3+2]; 241 | buf[j*3+1] := P1[j*3+1]; 242 | buf[j*3+2] := P1[j*3]; 243 | end; 244 | Stream.Write(buf, aBitmap.Width * 3); 245 | end 246 | else 247 | for i := 0 to aBitmap.Height - 1 do 248 | begin 249 | P1 := aBitmap.ScanLine[i]; 250 | for j := 0 to (aBitmap.Width - 1) do 251 | begin 252 | s := IntToStr(P1[j*3+2]) + ' '; 253 | Stream.Write(PChar(s)^, Length(s)); 254 | s := IntToStr(P1[j*3+1]) + ' '; 255 | Stream.Write(PChar(s)^, Length(s)); 256 | s := IntToStr(P1[j*3]) + ' '; 257 | Stream.Write(PChar(s)^, Length(s)); 258 | end; 259 | end; 260 | finally 261 | aBitmap.Free; 262 | end; 263 | end; 264 | 265 | initialization 266 | { Register the TPPMBitmap as a new graphic file format 267 | now all the TPicture storage stuff can access our new 268 | PPM graphic format ! 269 | } 270 | TPicture.RegisterFileFormat('PPM','Portable Pixelmap', TPPMBitmap); 271 | 272 | finalization 273 | TPicture.UnregisterGraphicClass(TPPMBitmap); 274 | 275 | end. 276 | -------------------------------------------------------------------------------- /IMAGEFORMATS/xStubGraphic.pas: -------------------------------------------------------------------------------- 1 | unit xStubGraphic; 2 | 3 | {$P+,S-,W-,R-,T-,X+,H+} 4 | {$C PRELOAD} 5 | 6 | interface 7 | 8 | uses 9 | Windows, Forms, SysUtils, Classes, Graphics; 10 | 11 | type 12 | 13 | TStubBitmap = class(TBitmap) 14 | private 15 | procedure WriteStubStreamData(Stream: TStream); 16 | procedure ReadStubStreamData(Stream: TStream); 17 | procedure CreateStubGraphic; 18 | protected 19 | procedure WriteData(Stream: TStream); override; 20 | procedure ReadData(Stream: TStream); override; 21 | public 22 | constructor Create; override; 23 | procedure SaveToStream(Stream: TStream); override; 24 | procedure LoadFromStream(Stream: TStream); override; 25 | end; 26 | 27 | TStubPAKBitmap = class(TStubBitmap); 28 | TStubWADBitmap = class(TStubBitmap); 29 | TStubBSPBitmap = class(TStubBitmap); 30 | TStubGRPBitmap = class(TStubBitmap); 31 | TStubPK3Bitmap = class(TStubBitmap); 32 | 33 | implementation 34 | 35 | { TStubBitmap } 36 | 37 | constructor TStubBitmap.Create; 38 | begin 39 | Inherited; 40 | CreateStubGraphic; 41 | end; 42 | 43 | procedure TStubBitmap.WriteData(Stream: TStream); 44 | begin 45 | WriteStubStreamData(Stream); 46 | end; 47 | 48 | procedure TStubBitmap.SaveToStream(Stream: TStream); 49 | begin 50 | WriteStubStreamData(Stream); 51 | end; 52 | 53 | procedure TStubBitmap.LoadFromStream(Stream: TStream); 54 | begin 55 | ReadStubStreamData(Stream); 56 | end; 57 | 58 | procedure TStubBitmap.ReadData(Stream: TStream); 59 | begin 60 | ReadStubStreamData(Stream); 61 | end; 62 | 63 | procedure TStubBitmap.ReadStubStreamData(Stream: TStream); 64 | begin 65 | CreateStubGraphic; 66 | end; 67 | 68 | procedure TStubBitmap.CreateStubGraphic; 69 | var 70 | aBitmap : TBitmap; 71 | begin 72 | aBitmap := TBitmap.Create; 73 | aBitmap.Width := 16; 74 | aBitmap.Height := 16; 75 | aBitmap.PixelFormat := pf4bit; 76 | aBitmap.Canvas.Pen.Width := 1; 77 | aBitmap.Canvas.Pen.Color := clGray; 78 | aBitmap.Canvas.Brush.Color := clWhite; 79 | aBitmap.Canvas.Rectangle(0, 0, 16, 16); 80 | Assign(aBitmap); 81 | aBitmap.Free; 82 | end; 83 | 84 | procedure TStubBitmap.WriteStubStreamData(Stream: TStream); 85 | begin 86 | end; 87 | 88 | initialization 89 | { Register the TStubBitmap as a new graphic file format 90 | now all the TPicture storage stuff can access our new 91 | Stub graphic format ! 92 | } 93 | TPicture.RegisterFileFormat('pak','Stub PAK Graphic', TStubPAKBitmap); 94 | TPicture.RegisterFileFormat('wad','Stub WAD Graphic', TStubWADBitmap); 95 | TPicture.RegisterFileFormat('bsp','Stub BSP Graphic', TStubBSPBitmap); 96 | TPicture.RegisterFileFormat('grp','Stub GRP Graphic', TStubGRPBitmap); 97 | TPicture.RegisterFileFormat('pk3','Stub PK3 Graphic', TStubPK3Bitmap); 98 | 99 | finalization 100 | TPicture.UnregisterGraphicClass(TStubPAKBitmap); 101 | TPicture.UnregisterGraphicClass(TStubWADBitmap); 102 | TPicture.UnregisterGraphicClass(TStubBSPBitmap); 103 | TPicture.UnregisterGraphicClass(TStubGRPBitmap); 104 | TPicture.UnregisterGraphicClass(TStubPK3Bitmap); 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /IMAGEFORMATS/xTGA.pas: -------------------------------------------------------------------------------- 1 | // Truevision Targa is a raster image format that it is most often used to store 2 | // high-color images. It supports one alpha channel per image. The following source 3 | // code supports only 24bpp and 32bpp uncompressed TGA images. 4 | /////////////////////////////////////////////////// 5 | // Author: Jim Valavanis, 6 | // E-Mail: jimmyvalavanis@yahoo.gr 7 | // Site : http://www.geocities.com/jimmyvalavanis/ 8 | /////////////////////////////////////////////////// 9 | 10 | // 2018: 11 | // Original version can still be downloaded at my old geocities site at: 12 | // http://www.geocities.ws/jimmyvalavanis/programming/gformats/tga.html 13 | 14 | unit xTGA; 15 | 16 | {$P+,S-,W-,R-,T-,X+,H+} 17 | {$C PRELOAD} 18 | 19 | interface 20 | 21 | uses 22 | Windows, Forms, SysUtils, Classes, Graphics; 23 | 24 | type 25 | TTGABitmap = class(TBitmap) 26 | private 27 | fAllowExceptions: boolean; 28 | procedure WriteTGAStreamData(Stream: TStream); 29 | procedure ReadTGAStreamData(Stream: TStream); 30 | protected 31 | procedure WriteData(Stream: TStream); override; 32 | procedure ReadData(Stream: TStream); override; 33 | public 34 | constructor Create; override; 35 | procedure SaveToStream(Stream: TStream); override; 36 | procedure LoadFromStream(Stream: TStream); override; 37 | property AllowExceptions: boolean read fAllowExceptions write fAllowExceptions; 38 | end; 39 | 40 | resourceString 41 | rsTGAError = 'Error reading TGA file: Wrong file type.'; 42 | rsErrUnsupported1 = 'Couldn''t load TGA Image. Only 24 and 32bit TGA Images supported.'; 43 | rsErrUnsupported2 = 'Couldn''t load TGA Image. Colormapped TGA images not supported.'; 44 | rsErrUnsupported3 = 'Couldn''t load TGA Image. Only standard 24, 32 bit TGA Images supported.'; 45 | 46 | implementation 47 | 48 | { TTGABitmap } 49 | 50 | type 51 | TTGAHeader = packed record // Header type for TGA images 52 | FileType : Byte; // Offset 1 53 | ColorMapType : Byte; // Offset 2 54 | ImageType : Byte; // Offset 3 55 | ColorMapSpec : array[0..4] of Byte; // Offset 4 56 | OriginX: array [0..1] of Byte; // Offset 9 57 | OriginY: array [0..1] of Byte; // Offset 11 58 | Width : array [0..1] of Byte; // Offset 13 59 | Height : array [0..1] of Byte; // Offset 15 60 | BPP : Byte; // Offset 17 61 | ImageInfo : Byte; // Offset 18 62 | end; 63 | 64 | //OrigX and OrigY show the origin of the image 65 | //TOPLEFT 66 | //BOTTOMLEFT 67 | //BOTTOMRIGHT 68 | //TOPRIGHT 69 | 70 | constructor TTGABitmap.Create; 71 | begin 72 | Inherited Create; 73 | fAllowExceptions := true; 74 | end; 75 | 76 | procedure TTGABitmap.WriteData(Stream: TStream); 77 | begin 78 | WriteTGAStreamData(Stream); 79 | end; 80 | 81 | procedure TTGABitmap.SaveToStream(Stream: TStream); 82 | begin 83 | WriteTGAStreamData(Stream); 84 | end; 85 | 86 | procedure TTGABitmap.LoadFromStream(Stream: TStream); 87 | begin 88 | ReadTGAStreamData(Stream); 89 | end; 90 | 91 | procedure TTGABitmap.ReadData(Stream: TStream); 92 | begin 93 | ReadTGAStreamData(Stream); 94 | end; 95 | 96 | procedure TTGABitmap.ReadTGAStreamData(Stream: TStream); 97 | var 98 | TGAHeader: TTGAHeader; 99 | i: integer; 100 | P1: PByteArray; 101 | h, w: integer; 102 | // ox, oy: integer; 103 | fImage: pointer; 104 | cImage : pointer; 105 | ImageSize: integer; 106 | pImage: pointer; 107 | ColorDepth: integer; 108 | BufferIndex : Integer; 109 | currentByte : Integer; 110 | CurrentPixel : Integer; 111 | numPixels: integer; 112 | Front: PByte; 113 | 114 | procedure MakeStub; 115 | begin 116 | pixelFormat := pf8bit; 117 | Width := 16; 118 | Height := 16; 119 | with Canvas do 120 | begin 121 | Pen.Width := 1; 122 | Pen.Color := clGray; 123 | Brush.Color := clWhite; 124 | Rectangle(0, 0, 16, 16); 125 | end; 126 | end; 127 | 128 | begin 129 | Stream.Read(TGAHeader, SizeOf(TGAHeader)); 130 | 131 | if TGAHeader.ColorMapType <> 0 then 132 | begin 133 | if fAllowExceptions then 134 | raise Exception.Create(rsErrUnsupported2) 135 | else 136 | MakeStub; 137 | exit; 138 | end; 139 | 140 | if not (TGAHeader.BPP in [24, 32]) then 141 | begin 142 | if fAllowExceptions then 143 | raise Exception.Create(rsErrUnsupported1) 144 | else 145 | MakeStub; 146 | exit; 147 | end; 148 | 149 | // Only support 24, 32 bit images 150 | if not (TGAHeader.ImageType in [2, 10]) then // Standard or compressed 24, 32 bit TGA file supported 151 | begin 152 | if fAllowExceptions then 153 | raise Exception.Create(rsErrUnsupported3) 154 | else 155 | MakeStub; 156 | exit; 157 | end; 158 | 159 | w := TGAHeader.Width[0] + TGAHeader.Width[1] * 256; 160 | h := TGAHeader.Height[0] + TGAHeader.Height[1] * 256; 161 | 162 | if TGAHeader.ImageType = 2 then // Uncompressed 163 | begin 164 | Width := w; 165 | Height := h; 166 | if TGAHeader.BPP = 24 then 167 | begin 168 | PixelFormat := pf24bit; 169 | w := w * 3; 170 | for i := h - 1 downto 0 do 171 | begin 172 | P1 := Scanline[i]; 173 | Stream.Read(P1^, w); 174 | end; 175 | end 176 | else 177 | begin 178 | PixelFormat := pf32bit; 179 | w := w * 4; 180 | for i := h - 1 downto 0 do 181 | begin 182 | P1 := Scanline[i]; 183 | Stream.Read(P1^, w); 184 | end; 185 | end; 186 | 187 | end // Compressed 188 | else 189 | begin 190 | CurrentByte := 0; 191 | CurrentPixel := 0; 192 | BufferIndex := 0; 193 | ColorDepth := TGAHeader.BPP div 8; 194 | numPixels := w * h; 195 | ImageSize := numPixels * ColorDepth; 196 | GetMem(fImage, ImageSize + 1); 197 | GetMem(cImage, ImageSize + 1); 198 | Stream.Read(cImage^, ImageSize); 199 | 200 | // Extract pixel information from compressed data 201 | repeat 202 | Front := Pointer(Integer(cImage) + BufferIndex); 203 | Inc(BufferIndex); 204 | if Front^ < 128 then 205 | begin 206 | for i := 0 to Front^ do 207 | begin 208 | PInteger(Integer(fImage) + CurrentByte)^ := PInteger(Integer(cImage) + BufferIndex + I * ColorDepth)^; 209 | CurrentByte := CurrentByte + ColorDepth; 210 | inc(CurrentPixel); 211 | if CurrentPixel = numPixels then 212 | break; 213 | end; 214 | BufferIndex := BufferIndex + (Front^ + 1) * ColorDepth 215 | end 216 | else 217 | begin 218 | for i := 0 to Front^ -128 do 219 | begin 220 | PInteger(Integer(fImage) + CurrentByte)^ := PInteger(Integer(cImage) + BufferIndex)^; 221 | CurrentByte := CurrentByte + ColorDepth; 222 | inc(CurrentPixel); 223 | if CurrentPixel = numPixels then 224 | break; 225 | end; 226 | BufferIndex := BufferIndex + ColorDepth 227 | end; 228 | until CurrentPixel >= numPixels; 229 | 230 | FreeMem(cImage, ImageSize + 1); 231 | 232 | Width := w; 233 | Height := h; 234 | if TGAHeader.BPP = 24 then 235 | begin 236 | PixelFormat := pf24bit; 237 | w := w * 3; 238 | end 239 | else 240 | begin 241 | PixelFormat := pf32bit; 242 | w := w * 4; 243 | end; 244 | 245 | pImage := fImage; 246 | for i := h - 1 downto 0 do 247 | begin 248 | P1 := ScanLine[i]; 249 | Move(pImage^, P1^, w); 250 | pImage := Pointer(Integer(pImage) + w); 251 | end; 252 | 253 | FreeMem(fImage, ImageSize + 1); 254 | end; 255 | 256 | { ox := TGAHeader.OriginX[0] + TGAHeader.OriginX[1] * 256; 257 | oy := TGAHeader.OriginY[0] + TGAHeader.OriginY[1] * 256; 258 | 259 | if (ox = 0) and (oy = 0) then 260 | exit; 261 | 262 | if (ox = 0) and (oy <> 0) then 263 | Canvas.StretchDraw(Rect(0, Height - 1, Width - 1, 0), self) 264 | else if (ox <> 0) and (oy = 0) then 265 | Canvas.StretchDraw(Rect(Width - 1, 0, 0, Height - 1), self) 266 | else 267 | Canvas.StretchDraw(Rect(Width - 1, Height - 1, 0, 0), self);} 268 | 269 | end; 270 | 271 | procedure TTGABitmap.WriteTGAStreamData(Stream: TStream); 272 | var 273 | aBitmap: TBitmap; 274 | TGAHeader: TTGAHeader; 275 | i{,j}: integer; 276 | P1: PByteArray; 277 | // b: byte; 278 | begin 279 | FillChar(TGAHeader, SizeOf(TGAHeader), Chr(0)); 280 | TGAHeader.ImageType := 2; 281 | 282 | aBitmap := TBitmap.Create; 283 | try 284 | aBitmap.Assign(self); 285 | if not (aBitmap.PixelFormat in [pf24bit, pf32bit]) then 286 | aBitmap.PixelFormat := pf24bit; 287 | if aBitmap.PixelFormat = pf24bit then 288 | TGAHeader.BPP := 24 289 | else 290 | TGAHeader.BPP := 32; 291 | TGAHeader.Width[0] := byte(aBitmap.Width); 292 | TGAHeader.Width[1] := aBitmap.Width shr 8; 293 | TGAHeader.Height[0] := byte(aBitmap.Height); 294 | TGAHeader.Height[1] := aBitmap.Height shr 8; 295 | Stream.Write(TGAHeader, SizeOf(TGAHeader)); 296 | 297 | for i := aBitmap.Height - 1 downto 0 do 298 | begin 299 | P1 := aBitmap.ScanLine[i]; 300 | if TGAHeader.BPP = 24 then 301 | begin 302 | { for j := 0 to aBitmap.Width - 1 do 303 | begin 304 | b := P1[j * 3]; 305 | P1[j * 3] := P1[j * 3 + 2]; 306 | P1[j * 3 + 2] := b; 307 | end; } 308 | Stream.Write(P1^, aBitmap.Width * 3); 309 | end 310 | else if TGAHeader.BPP = 32 then 311 | begin 312 | // TGAs are stored BGR and not RGB, so swap the R and B bytes. 313 | { for j := aBitmap.Width - 1 downto 0 do 314 | begin 315 | b := P1[j * 4]; 316 | P1[j * 4] := P1[j * 4 + 2]; 317 | P1[j * 4 + 2] := b; 318 | end;} 319 | Stream.Write(P1^, aBitmap.Width * 4); 320 | end; 321 | end; 322 | 323 | finally 324 | aBitmap.Free; 325 | end; 326 | end; 327 | 328 | initialization 329 | { Register the TTGABitmap as a new graphic file format 330 | now all the TPicture storage stuff can access our new 331 | TGA graphic format ! 332 | } 333 | TPicture.RegisterFileFormat('TGA','TGA Image', TTGABitmap); 334 | 335 | finalization 336 | TPicture.UnregisterGraphicClass(TTGABitmap); 337 | 338 | end. 339 | -------------------------------------------------------------------------------- /IMAGEFORMATS/xWZ.pas: -------------------------------------------------------------------------------- 1 | unit xWZ; 2 | 3 | {$P+,S-,W-,R-,T-,X+,H+} 4 | {$C PRELOAD} 5 | 6 | interface 7 | 8 | uses 9 | Windows, Forms, SysUtils, Classes, Graphics; 10 | 11 | type 12 | TWZ1Bitmap = class(TBitmap) 13 | private 14 | procedure WriteStreamData(Stream: TStream); 15 | procedure ReadStreamData(Stream: TStream); 16 | protected 17 | procedure WriteData(Stream: TStream); override; 18 | procedure ReadData(Stream: TStream); override; 19 | public 20 | procedure SaveToStream(Stream: TStream); override; 21 | procedure LoadFromStream(Stream: TStream); override; 22 | end; 23 | 24 | TWZ2Bitmap = class(TBitmap) 25 | private 26 | procedure WriteStreamData(Stream: TStream); 27 | procedure ReadStreamData(Stream: TStream); 28 | protected 29 | procedure WriteData(Stream: TStream); override; 30 | procedure ReadData(Stream: TStream); override; 31 | public 32 | procedure SaveToStream(Stream: TStream); override; 33 | procedure LoadFromStream(Stream: TStream); override; 34 | end; 35 | 36 | type 37 | EWZException = class(Exception) 38 | end; 39 | 40 | implementation 41 | 42 | const 43 | { error constants } 44 | geNoError = 0; { no errors found } 45 | geNoFile = 1; { gif file not found } 46 | geNotWZ = 2; { file is not a WZ? file } 47 | geUnExpectedEOF = 3; { unexpected EOF } 48 | 49 | ErrName: Array[1..3] of string = ( 50 | 'WZ file not found', 51 | 'Not a WZ file', 52 | 'Unexpected EOF'); 53 | 54 | type 55 | WZStruct=packed record 56 | count : byte; 57 | index : byte; 58 | end; 59 | 60 | PWZBuffer = ^TWZBuffer; 61 | TWZBuffer = array[1..$FFFF] of WZStruct; 62 | 63 | TEntry = packed array[0..255] of TPaletteEntry; { the color table } 64 | 65 | type 66 | GraphicLine = packed array [0..2048] of byte; 67 | PBmLine = ^TBmpLinesStruct; 68 | TBmpLinesStruct = packed record 69 | LineData : GraphicLine; 70 | LineNo : Integer; 71 | end; 72 | TImageSize = packed record 73 | X,Y: SmallInt; 74 | end; 75 | 76 | TLogPal = record 77 | lpal : TLogPalette; 78 | Entries: TEntry; 79 | end; 80 | 81 | type 82 | { This is the actual gif object } 83 | PWZ = ^TWZ; 84 | TWZ = class(TPersistent) 85 | private 86 | FStream : TStream; { The file stream for the WZ file } 87 | Entry : TEntry; { Color table } 88 | LineBuffer : GraphicLine; { array for buffer line output } 89 | ImageSize : TImageSize; 90 | {Conversion Routine Vars} 91 | BmHeader : TBitmapInfoHeader; {File Header for bitmap file} 92 | ImageLines: TList; {Image data} 93 | {Member Functions} 94 | procedure CreateLine(var CurrentY: integer); 95 | procedure Error(ErrCode: integer); 96 | procedure CreateBMHeader; 97 | public 98 | constructor Create; 99 | destructor Destroy; override; 100 | procedure SaveToStream(Stream: TStream); 101 | end; 102 | 103 | PWZ1 = ^TWZ1; 104 | TWZ1 = class(TWZ) 105 | public 106 | procedure LoadFromStream(Stream: TStream); 107 | end; 108 | 109 | PWZ2 = ^TWZ2; 110 | TWZ2 = class(TWZ) 111 | public 112 | procedure LoadFromStream(Stream: TStream); 113 | end; 114 | 115 | { TWZBitmap } 116 | 117 | procedure TWZ1Bitmap.WriteData(Stream: TStream); 118 | begin 119 | WriteStreamData(Stream); 120 | end; 121 | 122 | procedure TWZ1Bitmap.SaveToStream(Stream: TStream); 123 | begin 124 | WriteStreamData(Stream); 125 | end; 126 | 127 | procedure TWZ1Bitmap.LoadFromStream(Stream: TStream); 128 | begin 129 | ReadStreamData(Stream); 130 | end; 131 | 132 | procedure TWZ1Bitmap.ReadData(Stream: TStream); 133 | begin 134 | ReadStreamData(Stream); 135 | end; 136 | 137 | procedure TWZ1Bitmap.ReadStreamData(Stream: TStream); 138 | var 139 | aBitmap : TBitmap; 140 | aWZ : TWZ1; 141 | aStream : TMemoryStream; 142 | begin 143 | aWZ := TWZ1.Create; 144 | try 145 | aWZ.LoadFromStream(Stream); 146 | aStream:=TMemoryStream.Create; 147 | aBitmap:=TBitmap.Create; 148 | try 149 | aWZ.SaveToStream(aStream); 150 | aBitmap.LoadFromStream(aStream); 151 | Assign(aBitmap); 152 | PixelFormat := pf8bit; 153 | finally 154 | aStream.Free; 155 | aBitmap.Free; 156 | end; 157 | finally 158 | aWZ.Free; 159 | end; 160 | end; 161 | 162 | procedure TWZ1Bitmap.WriteStreamData(Stream: TStream); 163 | var 164 | aBitmap: TBitmap; 165 | i,j: integer; 166 | Token: WZStruct; 167 | Pal: TLogPal; 168 | Size: TImageSize; 169 | pLine: PByteArray; 170 | f: TMemoryStream; 171 | begin 172 | aBitmap := TBitmap.Create; 173 | f := TMemoryStream.Create; 174 | try 175 | aBitmap.Assign(self); 176 | if aBitmap.PixelFormat <> pf8Bit then aBitmap.PixelFormat := pf8Bit; 177 | Pal.lPal.palVersion:=$300; 178 | Pal.lPal.palNumEntries:=256; 179 | GetPaletteEntries(aBitmap.Palette,0,256,Pal.Entries); 180 | Size.X := aBitmap.Width; 181 | Size.Y := aBitmap.Height; 182 | f.Write(Size,SizeOf(TImageSize)); 183 | f.Write(Pal.Entries,SizeOf(TEntry)); 184 | for j:=0 to Size.Y-1 do 185 | begin 186 | i := 0; 187 | pLine := aBitmap.ScanLine[j]; 188 | while i < Size.X do 189 | begin 190 | Token.Count := 0; 191 | Token.Index := pLine[i]; 192 | repeat 193 | inc(Token.Count); 194 | inc(i); 195 | until (i>=Size.X-1) or (Token.Count=255) or (pLine[i]<>Token.Index); 196 | f.Write(Token,SizeOf(Token)); 197 | end; 198 | end; 199 | Stream.CopyFrom(f, 0); 200 | finally 201 | aBitmap.Free; 202 | f.Free; 203 | end; 204 | end; 205 | 206 | procedure TWZ2Bitmap.WriteData(Stream: TStream); 207 | begin 208 | WriteStreamData(Stream); 209 | end; 210 | 211 | procedure TWZ2Bitmap.SaveToStream(Stream: TStream); 212 | begin 213 | WriteStreamData(Stream); 214 | end; 215 | 216 | procedure TWZ2Bitmap.LoadFromStream(Stream: TStream); 217 | begin 218 | ReadStreamData(Stream); 219 | end; 220 | 221 | procedure TWZ2Bitmap.ReadData(Stream: TStream); 222 | begin 223 | ReadStreamData(Stream); 224 | end; 225 | 226 | procedure TWZ2Bitmap.ReadStreamData(Stream: TStream); 227 | var 228 | aBitmap : TBitmap; 229 | aWZ : TWZ2; 230 | aStream : TMemoryStream; 231 | begin 232 | aWZ := TWZ2.Create; 233 | try 234 | aWZ.LoadFromStream(Stream); 235 | aStream:=TMemoryStream.Create; 236 | aBitmap:=TBitmap.Create; 237 | try 238 | aWZ.SaveToStream(aStream); 239 | aBitmap.LoadFromStream(aStream); 240 | Assign(aBitmap); 241 | PixelFormat := pf8bit; 242 | finally 243 | aStream.Free; 244 | aBitmap.Free; 245 | end; 246 | finally 247 | aWZ.Free; 248 | end; 249 | end; 250 | 251 | procedure TWZ2Bitmap.WriteStreamData(Stream: TStream); 252 | var 253 | aBitmap: TBitmap; 254 | i,j: integer; 255 | Token: WZStruct; 256 | Pal: TLogPal; 257 | Size: TImageSize; 258 | pLine: PByteArray; 259 | flags: array[1..3] of boolean; 260 | f: TMemoryStream; 261 | begin 262 | aBitmap := TBitmap.Create; 263 | f := TMemoryStream.Create; 264 | try 265 | aBitmap.Assign(self); 266 | if aBitmap.PixelFormat <> pf8Bit then aBitmap.PixelFormat := pf8Bit; 267 | Pal.lPal.palVersion:=$300; 268 | Pal.lPal.palNumEntries:=256; 269 | GetPaletteEntries(aBitmap.Palette,0,256,Pal.Entries); 270 | Size.X := aBitmap.Width; 271 | Size.Y := aBitmap.Height; 272 | f.Write(Size,SizeOf(TImageSize)); 273 | f.Write(Pal.Entries,SizeOf(TEntry)); 274 | pLine := aBitmap.ScanLine[0]; 275 | Token.Count := 0; 276 | Token.Index := pLine[0]; 277 | j := 0; 278 | while j < Size.Y do 279 | begin 280 | i := 0; 281 | while i < Size.X do 282 | begin 283 | repeat 284 | inc(Token.Count); 285 | inc(i); 286 | until (pLine[i]<>Token.Index) or (i=Size.X-1) or (Token.Count=255); 287 | flags[1] := pLine[i]<>Token.Index; 288 | flags[2] := i=Size.X-1; 289 | flags[3] := Token.Count=255; 290 | if flags[1] or flags[3] then 291 | begin 292 | f.Write(Token,SizeOf(Token)); 293 | Token.Count := 0; 294 | Token.Index := pLine[i]; 295 | end; 296 | if flags[2] and (j= SizeOf(TWZBuffer) then 369 | NumRead := SizeOf(TWZBuffer) 370 | else 371 | NumRead := (FStream.Size - FStream.Position); 372 | if NumRead <> 0 then FStream.ReadBuffer(Buf, NumRead); 373 | for i:=1 to NumRead div 2 do 374 | begin 375 | for j := X to Min(X+Buf[i].Count,ImageSize.X) do 376 | LineBuffer[j] := Buf[i].index; 377 | if X + Buf[i].Count > ImageSize.X - 1 then 378 | begin 379 | CreateLine(Y); 380 | X := 0 381 | end 382 | else 383 | X := X + Buf[i].Count 384 | end; 385 | end; 386 | end; 387 | 388 | procedure TWZ2.LoadFromStream(Stream: TStream); 389 | var 390 | Buf : PWZBuffer; 391 | i,j: word; 392 | NumRead: longint; 393 | X,Y: integer; 394 | begin 395 | FStream:=Stream; 396 | if (FStream = nil) then Error(geNoFile); 397 | FStream.Read(ImageSize,SizeOf(ImageSize)); 398 | CreateBMHeader; 399 | ImageLines.Clear; 400 | ImageLines.Capacity := ImageSize.Y; 401 | FStream.Read(Entry,SizeOf(Entry)); 402 | X := 0; 403 | Y := 0; 404 | new(Buf); 405 | while FStream.Position < FStream.Size {?} do 406 | begin 407 | if (FStream.Size - FStream.Position) >= SizeOf(TWZBuffer) then 408 | NumRead := SizeOf(TWZBuffer) 409 | else 410 | NumRead := (FStream.Size - FStream.Position); 411 | if NumRead <> 0 then FStream.ReadBuffer(Buf^, NumRead); 412 | for i:=1 to NumRead div 2 do 413 | begin 414 | repeat 415 | for j := X to Min(X+Buf[i].Count,ImageSize.X) do 416 | LineBuffer[j] := Buf[i].index; 417 | if X + Buf[i].Count > ImageSize.X -1 then 418 | begin 419 | if Y <= ImageSize.Y then 420 | CreateLine(Y) 421 | else 422 | begin 423 | {$I-} 424 | dispose(buf); 425 | {$I+} 426 | exit 427 | end; 428 | Buf[i].Count := Buf[i].Count - ImageSize.X + X + 1; 429 | X := 0 430 | end 431 | else 432 | begin 433 | X := X + Buf[i].Count; 434 | Buf[i].Count := 0 435 | end 436 | until Buf[i].Count <= 0; 437 | end; 438 | end; 439 | dispose(Buf); 440 | end; 441 | 442 | procedure TWZ.CreateLine(var CurrentY: integer); 443 | var 444 | p: PBmLine; 445 | begin 446 | Application.ProcessMessages; 447 | {Create a new bmp line} 448 | New(p); 449 | {Fill in the data} 450 | p^.LineData := LineBuffer; 451 | p^.LineNo := CurrentY; 452 | {Add it to the list of lines} 453 | ImageLines.Add(p); 454 | Inc(CurrentY); 455 | end; 456 | 457 | {Raise exception with a message} 458 | procedure TWZ.Error(ErrCode: integer); 459 | begin 460 | raise EWZException.Create(ErrName[ErrCode]); 461 | end; 462 | 463 | procedure TWZ.SaveToStream(Stream: TStream); 464 | var 465 | BitFile: TBitmapFileHeader; 466 | i: integer; 467 | Line: integer; 468 | ch: char; 469 | p: PBmLine; 470 | x: integer; 471 | begin 472 | with BitFile do begin 473 | bfSize := (3*255) + Sizeof(TBitmapFileHeader) + {Color map info} 474 | Sizeof(TBitmapInfoHeader) + 475 | (ImageSize.X*ImageSize.Y); 476 | bfReserved1 := 0; {not currently used} 477 | bfReserved2 := 0; {not currently used} 478 | bfOffBits := (4*256)+ Sizeof(TBitmapFileHeader)+ 479 | Sizeof(TBitmapInfoHeader); 480 | end; 481 | {Write the file header} 482 | with Stream do begin 483 | Position:=0; 484 | ch:='B'; 485 | Write(ch,1); 486 | ch:='M'; 487 | Write(ch,1); 488 | Write(BitFile.bfSize,sizeof(BitFile.bfSize)); 489 | Write(BitFile.bfReserved1,sizeof(BitFile.bfReserved1)); 490 | Write(BitFile.bfReserved2,sizeof(BitFile.bfReserved2)); 491 | Write(BitFile.bfOffBits,sizeof(BitFile.bfOffBits)); 492 | {Write the bitmap image header info} 493 | Write(BmHeader,sizeof(BmHeader)); 494 | {Write the BGR palete inforamtion to this file} 495 | for i:= 0 to 255 do 496 | begin 497 | Write(Entry[i].peBlue,1); 498 | Write(Entry[i].peGreen,1); 499 | Write(Entry[i].peRed,1); 500 | Write(ch,1); 501 | end; 502 | {Init the Line Counter} 503 | Line := ImageSize.Y; 504 | {Write out File lines in reverse order} 505 | while Line >= 0 do 506 | begin 507 | {Go through the line list in reverse order looking for the 508 | current Line. Use reverse order since non interlaced gifs are 509 | stored top to bottom. Bmp file need to be written bottom to 510 | top} 511 | for i := (ImageLines.Count - 1) downto 0 do 512 | begin 513 | p := ImageLines.Items[i]; 514 | if p^.LineNo = Line then 515 | begin 516 | x := ImageSize.X; 517 | Write(p^.LineData, x); 518 | ch := chr(0); 519 | while (x and 3) <> 0 do { Pad up to 4-byte boundary with zeroes } 520 | begin 521 | Inc(x); 522 | Write(ch, 1); 523 | end; 524 | break; 525 | end; 526 | end; 527 | Dec(Line); 528 | end; 529 | Position:=0; { reset mewmory stream} 530 | end; 531 | end; 532 | 533 | {------------------------------------------------------------------------------} 534 | 535 | initialization 536 | { Register the TWZBitmap as a new graphic file format 537 | now all the TPicture storage stuff can access our new 538 | WZ graphic format ! 539 | } 540 | TPicture.RegisterFileFormat('WZ2','WZ2-Format', TWZ2Bitmap); 541 | TPicture.RegisterFileFormat('WZ1','WZ1-Format', TWZ1Bitmap); 542 | 543 | finalization 544 | TPicture.UnregisterGraphicClass(TWZ2Bitmap); 545 | TPicture.UnregisterGraphicClass(TWZ1Bitmap); 546 | 547 | end. 548 | 549 | -------------------------------------------------------------------------------- /IMAGEFORMATS/zBitmap.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/IMAGEFORMATS/zBitmap.pas -------------------------------------------------------------------------------- /LIBRARY/ABOUTDLG.DCR: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/ABOUTDLG.DCR -------------------------------------------------------------------------------- /LIBRARY/ABOUTLINE.BMP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/ABOUTLINE.BMP -------------------------------------------------------------------------------- /LIBRARY/About.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/About.ddp -------------------------------------------------------------------------------- /LIBRARY/About.pas: -------------------------------------------------------------------------------- 1 | unit About; 2 | 3 | { This is a dialog wrapped in the ABOUTDLG unit 4 | not intended to be used as a standalone unit. 5 | 6 | Do not install this unit, install ABOUTDLG. 7 | } 8 | 9 | interface 10 | 11 | uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls, 12 | Buttons, ExtCtrls, AppEvnts; 13 | 14 | type 15 | TAboutBox = class(TForm) 16 | Button1: TButton; 17 | WinType: TLabel; 18 | WinVersion: TLabel; 19 | Label5: TLabel; 20 | FreeMemory: TLabel; 21 | Label6: TLabel; 22 | FreeResources: TLabel; 23 | UserLabel: TLabel; 24 | UserName: TLabel; 25 | CompanyLabel: TLabel; 26 | CompanyName: TLabel; 27 | DiskFreeSpaceLabel: TLabel; 28 | FreeDisk: TLabel; 29 | Panel1: TPanel; 30 | ProgramIcon: TImage; 31 | ProductName: TLabel; 32 | Version: TLabel; 33 | Copyright: TLabel; 34 | Image1: TImage; 35 | PlusVersion: TLabel; 36 | Panel2: TPanel; 37 | Panel3: TPanel; 38 | Panel4: TPanel; 39 | Comments: TLabel; 40 | ApplicationEvents1: TApplicationEvents; 41 | procedure ApplicationEvents1Activate(Sender: TObject); 42 | private 43 | { Private declarations } 44 | public 45 | { Public declarations } 46 | end; 47 | 48 | implementation 49 | 50 | {$R *.DFM} 51 | 52 | procedure TAboutBox.ApplicationEvents1Activate(Sender: TObject); 53 | begin 54 | if Visible then BringToFront 55 | end; 56 | 57 | end. 58 | 59 | -------------------------------------------------------------------------------- /LIBRARY/Aboutdlg.pas: -------------------------------------------------------------------------------- 1 | unit Aboutdlg; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 7 | Forms, Dialogs, About, Registry; 8 | 9 | type 10 | TAboutDialog = class(TComponent) 11 | private 12 | FProductName: string; 13 | FVersion: string; 14 | FCopyright: string; 15 | FComments: string; 16 | public 17 | function Execute: Boolean; 18 | published 19 | property ProductName: string read FProductName write FProductName; 20 | property Version: string read FVersion write FVersion; 21 | property Copyright: string read FCopyright write FCopyright; 22 | property Comments: string read FComments write FComments; 23 | end; 24 | 25 | procedure Register; 26 | 27 | implementation 28 | 29 | {$R *.dcr} 30 | 31 | procedure Register; 32 | begin 33 | RegisterComponents('TombViewer Components', [TAboutDialog]); 34 | end; 35 | 36 | resourceString 37 | rsFmtDiskFreeMB = '%d MB (%s:\)'; 38 | rsFmtDiskFreeGB = '%d GB (%s:\)'; 39 | rsWinkey = '\SOFTWARE\Microsoft\Windows\CurrentVersion'; 40 | rsWinNTkey = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion'; 41 | rsProductName = 'ProductName'; 42 | rsCurrentVersion = 'CurrentVersion'; 43 | rsCurrentBuildNumber = 'CurrentBuildNumber'; 44 | rsRegisteredOwner = 'RegisteredOwner'; 45 | rsRegisteredOrganization = 'RegisteredOrganization'; 46 | rsVersion = 'Version'; 47 | rsVersionNumber = 'VersionNumber'; 48 | rsPlusVersionNumber = 'Plus! VersionNumber'; 49 | rsFmtVersion = 'Version: %s'; 50 | rsFmtBuild = 'Build: %s'; 51 | rsDiskFreeSpaceLabel = 'Disk free space: '; 52 | rsCompanyLabel = 'Company: '; 53 | rsUserLabel = 'User: '; 54 | 55 | function TAboutDialog.Execute: Boolean; 56 | var 57 | reg: TRegistry; 58 | s: string; 59 | AboutBox: TAboutBox; 60 | dsnum: int64; 61 | begin 62 | AboutBox := TAboutBox.Create(Application.MainForm); 63 | try 64 | AboutBox.ProductName.Caption := ProductName; 65 | AboutBox.Version.Caption := Version; 66 | AboutBox.Copyright.Caption := Copyright; 67 | AboutBox.Comments.Caption := Comments; 68 | AboutBox.Caption := ProductName; 69 | 70 | AboutBox.DiskFreeSpaceLabel.Caption := rsDiskFreeSpaceLabel; 71 | AboutBox.CompanyLabel.Caption := rsCompanyLabel; 72 | AboutBox.UserLabel.Caption := rsUserLabel; 73 | 74 | reg := TRegistry.Create; 75 | try 76 | reg.RootKey := HKey_Local_Machine; 77 | if reg.OpenKey(rsWinNTkey,false) and (reg.ReadString(rsProductName)<>'') then 78 | begin 79 | AboutBox.WinType.Caption := reg.ReadString(rsProductName); 80 | AboutBox.WinVersion.Caption := Format(rsFmtVersion, [reg.ReadString(rsCurrentVersion)]); 81 | AboutBox.PlusVersion.Caption := Format(rsFmtBuild, [reg.ReadString(rsCurrentBuildNumber)]); 82 | AboutBox.UserName.Caption := reg.ReadString(rsRegisteredOwner); 83 | AboutBox.CompanyName.Caption := reg.ReadString(rsRegisteredOrganization); 84 | end 85 | else if reg.OpenKey(rsWinkey,false) then 86 | begin 87 | AboutBox.WinType.Caption := reg.ReadString(rsVersion); 88 | AboutBox.WinVersion.Caption := reg.ReadString(rsVersionNumber); 89 | AboutBox.PlusVersion.Caption := reg.ReadString(rsPlusVersionNumber); 90 | AboutBox.UserName.Caption := reg.ReadString(rsRegisteredOwner); 91 | AboutBox.CompanyName.Caption := reg.ReadString(rsRegisteredOrganization); 92 | end; 93 | finally 94 | reg.Free; 95 | end; 96 | 97 | GetDir(0, s); // Current drive's directory 98 | 99 | dsnum := DiskFree(0) div 1000000; 100 | if dsnum > 100000 then 101 | begin 102 | dsnum := dsnum div 1000; 103 | AboutBox.FreeDisk.Caption := Format(rsFmtDiskFreeGB, [dsnum, s[1]]); 104 | end 105 | else 106 | AboutBox.FreeDisk.Caption := Format(rsFmtDiskFreeMB, [dsnum, s[1]]); 107 | 108 | AboutBox.ProgramIcon.Picture.Graphic := Application.Icon; 109 | AboutBox.ShowModal; 110 | Result := (AboutBox.ModalResult = mrOK); 111 | finally 112 | AboutBox.Free; 113 | end; 114 | end; 115 | 116 | end. 117 | -------------------------------------------------------------------------------- /LIBRARY/AnotherReg.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/AnotherReg.dcr -------------------------------------------------------------------------------- /LIBRARY/AnotherReg.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/AnotherReg.res -------------------------------------------------------------------------------- /LIBRARY/DropDownButton.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/DropDownButton.dcr -------------------------------------------------------------------------------- /LIBRARY/FILEDRAGBTN.DCR: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/FILEDRAGBTN.DCR -------------------------------------------------------------------------------- /LIBRARY/FileMenuHistory.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/FileMenuHistory.dcr -------------------------------------------------------------------------------- /LIBRARY/FileMenuHistory.pas: -------------------------------------------------------------------------------- 1 | // 2018: 2 | // Component to create easily file menu history 3 | // (c) 200? - 2018, Jim Valavanis 4 | // Original version can still be downloaded at my old geocities site at: 5 | // http://www.geocities.ws/jimmyvalavanis/programming/delphi/index.html 6 | 7 | unit FileMenuHistory; 8 | 9 | interface 10 | 11 | uses 12 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 13 | Menus; 14 | 15 | type 16 | TOnOpenEvent = procedure (Sender: TObject; const FileName: TFileName) of object; 17 | 18 | TFileMenuHistory = class(TComponent) 19 | private 20 | { Private declarations } 21 | fMenuItems: array[0..9] of TMenuItem; 22 | fOnOpen: TOnOpenEvent; 23 | fPaths: TStringList; 24 | protected 25 | { Protected declarations } 26 | procedure DoFileOpen(Sender: TObject); 27 | procedure SetMenuItems0(Value: TMenuItem); virtual; 28 | procedure SetMenuItems1(Value: TMenuItem); virtual; 29 | procedure SetMenuItems2(Value: TMenuItem); virtual; 30 | procedure SetMenuItems3(Value: TMenuItem); virtual; 31 | procedure SetMenuItems4(Value: TMenuItem); virtual; 32 | procedure SetMenuItems5(Value: TMenuItem); virtual; 33 | procedure SetMenuItems6(Value: TMenuItem); virtual; 34 | procedure SetMenuItems7(Value: TMenuItem); virtual; 35 | procedure SetMenuItems8(Value: TMenuItem); virtual; 36 | procedure SetMenuItems9(Value: TMenuItem); virtual; 37 | procedure SetMenuItems(index: integer; Value: TMenuItem); virtual; 38 | procedure SetPaths(Value: TStringList); virtual; 39 | public 40 | { Public declarations } 41 | constructor Create(AOwner: TComponent); override; 42 | destructor Destroy; override; 43 | function MenuItem(index: integer): TMenuItem; 44 | procedure AddPath(const FileName: TFileName); virtual; 45 | procedure RefreshMenuItems; virtual; 46 | published 47 | { Published declarations } 48 | property MenuItem0: TMenuItem read fMenuItems[0] write SetMenuItems0; 49 | property MenuItem1: TMenuItem read fMenuItems[1] write SetMenuItems1; 50 | property MenuItem2: TMenuItem read fMenuItems[2] write SetMenuItems2; 51 | property MenuItem3: TMenuItem read fMenuItems[3] write SetMenuItems3; 52 | property MenuItem4: TMenuItem read fMenuItems[4] write SetMenuItems4; 53 | property MenuItem5: TMenuItem read fMenuItems[5] write SetMenuItems5; 54 | property MenuItem6: TMenuItem read fMenuItems[6] write SetMenuItems6; 55 | property MenuItem7: TMenuItem read fMenuItems[7] write SetMenuItems7; 56 | property MenuItem8: TMenuItem read fMenuItems[8] write SetMenuItems8; 57 | property MenuItem9: TMenuItem read fMenuItems[9] write SetMenuItems9; 58 | property Paths: TStringList read fPaths write SetPaths; 59 | property OnOpen:TOnOpenEvent read fOnOpen write fOnOpen; 60 | end; 61 | 62 | procedure Register; 63 | 64 | implementation 65 | 66 | uses Math; 67 | 68 | resourceString 69 | rsRangeCheckError = 'Index out of range.'; 70 | rsFmtMenuCaption = '&%d. %s'; 71 | 72 | procedure Register; 73 | begin 74 | RegisterComponents('TombViewer Components', [TFileMenuHistory]); 75 | end; 76 | 77 | procedure TFileMenuHistory.SetMenuItems0(Value: TMenuItem); 78 | begin 79 | SetMenuItems(0, Value); 80 | end; 81 | 82 | procedure TFileMenuHistory.SetMenuItems1(Value: TMenuItem); 83 | begin 84 | SetMenuItems(1, Value); 85 | end; 86 | 87 | procedure TFileMenuHistory.SetMenuItems2(Value: TMenuItem); 88 | begin 89 | SetMenuItems(2, Value); 90 | end; 91 | 92 | procedure TFileMenuHistory.SetMenuItems3(Value: TMenuItem); 93 | begin 94 | SetMenuItems(3, Value); 95 | end; 96 | 97 | procedure TFileMenuHistory.SetMenuItems4(Value: TMenuItem); 98 | begin 99 | SetMenuItems(4, Value); 100 | end; 101 | 102 | procedure TFileMenuHistory.SetMenuItems5(Value: TMenuItem); 103 | begin 104 | SetMenuItems(5, Value); 105 | end; 106 | 107 | procedure TFileMenuHistory.SetMenuItems6(Value: TMenuItem); 108 | begin 109 | SetMenuItems(6, Value); 110 | end; 111 | 112 | procedure TFileMenuHistory.SetMenuItems7(Value: TMenuItem); 113 | begin 114 | SetMenuItems(7, Value); 115 | end; 116 | 117 | procedure TFileMenuHistory.SetMenuItems8(Value: TMenuItem); 118 | begin 119 | SetMenuItems(8, Value); 120 | end; 121 | 122 | procedure TFileMenuHistory.SetMenuItems9(Value: TMenuItem); 123 | begin 124 | SetMenuItems(9, Value); 125 | end; 126 | 127 | procedure TFileMenuHistory.SetMenuItems(index: integer; Value: TMenuItem); 128 | begin 129 | if (index >= low(fMenuItems)) and (index <= high(fMenuItems)) then 130 | begin 131 | fMenuItems[index] := Value; 132 | fMenuItems[index].OnClick := DoFileOpen; 133 | end 134 | else 135 | raise Exception.Create(rsRangeCheckError); 136 | end; 137 | 138 | function TFileMenuHistory.MenuItem(index: integer): TMenuItem; 139 | begin 140 | if (index >= low(fMenuItems)) and (index <= high(fMenuItems)) then 141 | result := fMenuItems[index] 142 | else 143 | result := nil; 144 | end; 145 | 146 | constructor TFileMenuHistory.Create(AOwner: TComponent); 147 | var i: integer; 148 | begin 149 | Inherited; 150 | for i := low(fMenuItems) to high(fMenuItems) do fMenuItems[i] := nil; 151 | fPaths := TStringList.Create; 152 | end; 153 | 154 | destructor TFileMenuHistory.Destroy; 155 | begin 156 | fPaths.Clear; 157 | fPaths.Free; 158 | Inherited; 159 | end; 160 | 161 | procedure TFileMenuHistory.DoFileOpen(Sender: TObject); 162 | var i: integer; 163 | begin 164 | if Sender <> nil then 165 | begin 166 | for i := low(fMenuItems) to high(fMenuItems) do 167 | begin 168 | if Sender = fMenuItems[i] then 169 | begin 170 | if fPaths.Count > i then 171 | if Assigned(fOnOpen) then fOnOpen(Sender, fPaths[i]); 172 | exit; 173 | end; 174 | end; 175 | end; 176 | end; 177 | 178 | function MkShortName(const fname: string): string; 179 | const 180 | MAXDISPFNAME = 30; 181 | var 182 | i: integer; 183 | begin 184 | if Length(fname) < MAXDISPFNAME then 185 | begin 186 | Result := fname; 187 | exit; 188 | end; 189 | Result := ''; 190 | for i := Length(fname) downto Length(fname) - (MAXDISPFNAME - 6) do 191 | Result := fname[i] + Result; 192 | Result := '...' + Result; 193 | for i := 3 downto 1 do 194 | Result := fname[i] + Result; 195 | end; 196 | 197 | procedure TFileMenuHistory.SetPaths(Value: TStringList); 198 | var i, count: integer; 199 | begin 200 | if Value.Text <> Paths.Text then 201 | begin 202 | fPaths.Clear; 203 | for i := 0 to Value.Count do 204 | if Trim(Value.Strings[i]) <> '' then fPaths.Add(Value.Strings[i]); 205 | end; 206 | for i := low(fMenuItems) to high(fMenuItems) do 207 | if Assigned(fMenuItems[i]) then 208 | fMenuItems[i].Visible := false; 209 | count := 0; 210 | for i := low(fMenuItems) to min(high(fMenuItems), fPaths.Count - 1) do 211 | if Assigned(fMenuItems[i]) then 212 | begin 213 | inc(count); 214 | fMenuItems[i].Visible := true; 215 | fMenuItems[i].Caption := Format(rsFmtMenuCaption, [count, MkShortName(fPaths.Strings[i])]); 216 | end; 217 | end; 218 | 219 | procedure TFileMenuHistory.AddPath(const FileName: TFileName); 220 | var i: integer; 221 | begin 222 | if fPaths.IndexOf(FileName) = -1 then 223 | begin 224 | fPaths.Insert(0, FileName); 225 | if fPaths.Count > high(fMenuItems) then 226 | for i := fPaths.Count - 1 downto high(fMenuItems) do fPaths.Delete(i); 227 | end; 228 | SetPaths(fPaths); 229 | end; 230 | 231 | procedure TFileMenuHistory.RefreshMenuItems; 232 | begin 233 | SetPaths(fPaths); 234 | end; 235 | 236 | end. 237 | 238 | -------------------------------------------------------------------------------- /LIBRARY/MessageBox.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/MessageBox.dcr -------------------------------------------------------------------------------- /LIBRARY/MessageBox.pas: -------------------------------------------------------------------------------- 1 | // 2018: 2 | // Component that ecapsulates a Windows MessageBox 3 | // (c) 200? - 2018, Jim Valavanis 4 | // Original version can still be downloaded at my old geocities site at: 5 | // http://www.geocities.ws/jimmyvalavanis/programming/delphi/index.html 6 | 7 | unit MessageBox; 8 | 9 | interface 10 | 11 | uses 12 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 13 | 14 | type 15 | TMessageBoxButtons = (mbxAbortRetryIgnore, mbxOK, mbxOKCancel, mbxRetryCancel, mbxYesNo, mbxYesNoCancel); 16 | TMessageBoxIcon = (mbxIconExclamation, mbxIconWarning, mbxIconInformation, mbxIconAsterisk, mbxIconQuestion, 17 | mbxIconStop, mbxIconError,mbxIconHand,mbxNoIcon); 18 | TMessageBoxDefButton = (mbxDefButton1, mbxDefButton2, mbxDefButton3, mbxNoDefButton); 19 | TMessageBoxModality = (mbxApplModal, mbxSystemModal, mbxTaskModal, mbxDefModality, mbxNoModality); 20 | TMessageBoxTextAlignment = (mbxLeft, mbxRight); 21 | 22 | TOnMessageBoxBeforeExecuteEvent = procedure(Sender: TObject; var AllowExec: boolean) of object; 23 | 24 | TOnMessageBoxAfterExecuteEvent = procedure(Sender: TObject) of object; 25 | 26 | TMessageBox = class(TComponent) 27 | private 28 | FCaption: string; 29 | FText: string; 30 | FButtons: TMessageBoxButtons; 31 | FIcon: TMessageBoxIcon; 32 | FDefaultButton: TMessageBoxDefButton; 33 | FModality: TMessageBoxModality; 34 | FTextAlignment: TMessageBoxTextAlignment; 35 | FOnTop: boolean; 36 | FReturnValue: integer; 37 | FOnAfterExecute: TOnMessageBoxAfterExecuteEvent; 38 | FOnBeforeExecute: TOnMessageBoxBeforeExecuteEvent; 39 | protected 40 | { Protected declarations } 41 | public 42 | { Public declarations } 43 | property ReturnValue: integer read FReturnValue; 44 | constructor Create(AOWner: TComponent); override; 45 | function Execute: integer; overload; virtual; 46 | function Execute(aText: string): integer; overload; virtual; 47 | function ExecuteFmt(const Args: array of const): integer; virtual; 48 | published 49 | property Caption: string read FCaption write FCaption; 50 | property Text: string read FText write FText; 51 | property Buttons: TMessageBoxButtons read FButtons write FButtons; 52 | property Icon: TMessageBoxIcon read FIcon write FIcon; 53 | property DefaultButton: TMessageBoxDefButton read FDefaultButton write FDefaultButton; 54 | property Modality: TMessageBoxModality read FModality write FModality; 55 | property TextAlignment: TMessageBoxTextAlignment read FTextAlignment write FTextAlignment; 56 | property OnTop: boolean read FOnTop write FOnTop default false; 57 | property OnAfterExecute: TOnMessageBoxAfterExecuteEvent read FOnAfterExecute write FOnAfterExecute; 58 | property OnBeforeExecute: TOnMessageBoxBeforeExecuteEvent read FOnBeforeExecute write FOnBeforeExecute; 59 | end; 60 | 61 | procedure Register; 62 | 63 | implementation 64 | 65 | resourceString 66 | rsText = 'Write your message here.'; 67 | 68 | constructor TMessageBox.Create(AOWner: TComponent); 69 | begin 70 | Inherited Create(AOwner); 71 | FCaption := Application.Title; 72 | FText := rsText; 73 | FButtons := mbxOKCancel; 74 | FIcon := mbxNoIcon; 75 | FDefaultButton := mbxNoDefButton; 76 | FModality := mbxDefModality; 77 | FTextAlignment := mbxLeft; 78 | FOnTop := false; 79 | FReturnValue := -1; 80 | end; 81 | 82 | function TMessageBox.ExecuteFmt(const Args: array of const): integer; 83 | begin 84 | Result := Execute(Format(FText, Args)); 85 | end; 86 | 87 | function TMessageBox.Execute(aText: string): integer; 88 | var FText1: string; 89 | begin 90 | FText1 := FText; 91 | FText := aText; 92 | Result := Execute; 93 | FText := FText1; 94 | end; 95 | 96 | function TMessageBox.Execute: integer; 97 | var 98 | msgCaption, msgText: PChar; 99 | flags: integer; 100 | hWnd: THandle; 101 | AllowExec: boolean; 102 | begin 103 | AllowExec := true; 104 | if Assigned(FOnBeforeExecute) then 105 | FOnBeforeExecute(self, AllowExec); 106 | if not AllowExec then 107 | begin 108 | FReturnValue := -1; 109 | Execute := FReturnValue; 110 | exit; 111 | end; 112 | 113 | flags := 0; 114 | 115 | case FButtons of 116 | mbxAbortRetryIgnore: 117 | flags := flags or MB_ABORTRETRYIGNORE; 118 | mbxOK: 119 | flags := flags or MB_OK; 120 | mbxOKCancel: 121 | flags := flags or MB_OKCANCEL; 122 | mbxRetryCancel: 123 | flags := flags or MB_RETRYCANCEL; 124 | mbxYesNo: 125 | flags := flags or MB_YESNO; 126 | mbxYesNoCancel: 127 | flags := flags or MB_YESNOCANCEL; 128 | end; 129 | 130 | case FIcon of 131 | mbxIconExclamation: 132 | flags := flags or MB_ICONEXCLAMATION; 133 | mbxIconWarning: 134 | flags := flags or MB_ICONWARNING; 135 | mbxIconInformation: 136 | flags := flags or MB_ICONINFORMATION; 137 | mbxIconAsterisk: 138 | flags := flags or MB_ICONASTERISK; 139 | mbxIconQuestion: 140 | flags := flags or MB_ICONQUESTION; 141 | mbxIconStop: 142 | flags := flags or MB_ICONSTOP; 143 | mbxIconError: 144 | flags := flags or MB_ICONERROR; 145 | mbxIconHand: 146 | flags := flags or MB_ICONHAND; 147 | mbxNoIcon: {do nothing} 148 | end; 149 | 150 | case FDefaultButton of 151 | mbxDefButton1: 152 | flags := flags or MB_DEFBUTTON1; 153 | mbxDefButton2: 154 | flags := flags or MB_DEFBUTTON2; 155 | mbxDefButton3: 156 | flags := flags or MB_DEFBUTTON3; 157 | mbxNoDefButton: 158 | end; 159 | 160 | case FModality of 161 | mbxApplModal, mbxDefModality: 162 | begin 163 | hWnd := GetFocus; 164 | flags := flags or MB_APPLMODAL; 165 | end; 166 | mbxSystemModal: 167 | begin 168 | hWnd := GetFocus; 169 | flags := flags or MB_SYSTEMMODAL; 170 | end; 171 | mbxTaskModal: 172 | begin 173 | hWnd := 0; 174 | flags := flags or MB_TASKMODAL; 175 | end; 176 | mbxNoModality: hWnd := GetDesktopWindow; 177 | else 178 | hWnd := GetFocus; 179 | end; 180 | 181 | if FTextAlignment = mbxRight then 182 | flags := flags or MB_RIGHT; 183 | 184 | if FOnTop then 185 | flags := flags or MB_TOPMOST; 186 | 187 | GetMem(msgCaption, Length(FCaption) + 1); 188 | GetMem(msgText, Length(FText) + 1); 189 | StrPLCopy(msgCaption, FCaption, Length(FCaption)); 190 | StrPLCopy(msgText, FText, Length(FText)); 191 | 192 | FReturnValue := Windows.MessageBox(hWnd, msgText, msgCaption, flags); 193 | 194 | FreeMem(msgText); 195 | FreeMem(msgCaption); 196 | 197 | Execute := FReturnValue; 198 | 199 | if Assigned(FOnAfterExecute) then 200 | FOnAfterExecute(self); 201 | end; 202 | 203 | procedure Register; 204 | begin 205 | RegisterComponents('TombViewer Components', [TMessageBox]); 206 | end; 207 | 208 | end. 209 | 210 | -------------------------------------------------------------------------------- /LIBRARY/XPMenu.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/XPMenu.dcr -------------------------------------------------------------------------------- /LIBRARY/binarydata.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/binarydata.pas -------------------------------------------------------------------------------- /LIBRARY/filedrag.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************* 2 | * 3 | * TFileDrag Component - Adds support for dropping files from explorer onto a 4 | * a Delphi form. 5 | * 6 | * Copyright (c) 1996 - Erik C. Nielsen ( 72233.1314@compuserve.com ) 7 | * All Rights Reserved 8 | * 9 | *******************************************************************************} 10 | 11 | unit filedrag; 12 | 13 | interface 14 | 15 | {$R FILEDRAGBTN.DCR} 16 | 17 | uses 18 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 19 | ShellApi; 20 | 21 | type 22 | TFileDrag = class(TComponent) 23 | private 24 | FNameWithPath: TStrings; 25 | FNameOnly: TStrings; 26 | FExtension: TStrings; 27 | FNumDropped: Integer; 28 | FEnabled: Boolean; 29 | FWndHandle: HWND; 30 | FDefProc: Pointer; 31 | FWndProcInstance: Pointer; 32 | FOnDrop: TNotifyEvent; 33 | 34 | procedure DropFiles(hDropHandle: HDrop); 35 | procedure SetEnabled(Value: Boolean); 36 | procedure WndProc(var Msg: TMessage); 37 | procedure InitControl; 38 | procedure DestroyControl; 39 | public 40 | constructor Create(AOwner: TComponent); override; 41 | destructor Destroy; override; 42 | published 43 | property NameWithPath: TStrings read FNameWithPath; 44 | property NameOnly: TStrings read FNameOnly; 45 | property Extension: TStrings read FExtension; 46 | property FileCount: Integer read FNumDropped; 47 | property EnableDrop: Boolean read FEnabled write SetEnabled default True; 48 | property OnDrop: TNotifyEvent read FOnDrop write FOnDrop; 49 | end; 50 | 51 | procedure Register; 52 | 53 | implementation 54 | 55 | procedure Register; 56 | begin 57 | RegisterComponents('TombViewer Components', [TFileDrag]); 58 | end; 59 | 60 | constructor TFileDrag.Create( AOwner: TComponent ); 61 | begin 62 | inherited Create(AOwner); 63 | FNumDropped := 0; 64 | FNameWithPath := TStringList.Create; 65 | FNameOnly := TStringList.Create; 66 | FExtension := TStringList.Create; 67 | FWndHandle := 0; 68 | 69 | InitControl; 70 | SetEnabled(FEnabled); 71 | end; 72 | 73 | destructor TFileDrag.Destroy; 74 | begin 75 | DestroyControl; 76 | SetEnabled(True); 77 | FNameWithPath.Free; 78 | FNameOnly.Free; 79 | FExtension.Free; 80 | inherited Destroy; 81 | end; 82 | 83 | procedure TFileDrag.InitControl; 84 | var 85 | WinCtl: TWinControl; 86 | begin 87 | if Owner is TWinControl then 88 | begin 89 | { Subclass the owner so this control can capture the WM_DROPFILES message } 90 | WinCtl := TWinControl(Owner); 91 | FWndHandle := WinCtl.Handle; 92 | FWndProcInstance := Classes.MakeObjectInstance(WndProc); 93 | FDefProc := Pointer(GetWindowLong( FWndHandle, GWL_WNDPROC)); 94 | SetWindowLong(FWndHandle, GWL_WNDPROC, Longint(FWndProcInstance)); 95 | end 96 | else 97 | FEnabled := False; 98 | end; 99 | 100 | procedure TFileDrag.DestroyControl; 101 | begin 102 | if FWndHandle <> 0 then 103 | begin 104 | { Restore the original window procedure } 105 | SetWindowLong(FWndHandle, GWL_WNDPROC, Longint(FDefProc)); 106 | Classes.FreeObjectInstance(FWndProcInstance); 107 | end 108 | end; 109 | 110 | procedure TFileDrag.SetEnabled( Value: Boolean ); 111 | begin 112 | FEnabled := Value; 113 | { Call Win32 API to register the owner as being able to accept dropped files } 114 | DragAcceptFiles(FWndHandle, FEnabled); 115 | end; 116 | 117 | procedure TFileDrag.DropFiles(hDropHandle: HDrop); 118 | var 119 | pszFileWithPath, pszFile, pszExt: PChar; 120 | iFile, iPos, iStrLen, iTempLen: Integer; 121 | begin 122 | iStrLen := 128; 123 | pszFile := ''; 124 | pszExt := ''; 125 | pszFileWithPath := StrAlloc(iStrLen); 126 | iFile := 0; 127 | 128 | { Clear any existing strings from the string lists } 129 | FNameWithPath.Clear; 130 | FNameOnly.Clear; 131 | FExtension.Clear; 132 | 133 | { Retrieve the number of files being dropped } 134 | FNumDropped := DragQueryFile(hDropHandle, $FFFFFFFF, pszFile, iStrLen); 135 | 136 | { Retrieve each file being dropped } 137 | while iFile < FNumDropped do 138 | begin 139 | { Get the length of this file name } 140 | iTempLen := DragQueryFile(hDropHandle, iFile, nil, 0) + 1; 141 | { If file length > current PChar, delete and allocate one large enough } 142 | if iTempLen > iStrLen then 143 | begin 144 | iStrLen := iTempLen; 145 | StrDispose(pszFileWithPath); 146 | pszFileWithPath := StrAlloc(iStrLen); 147 | end; 148 | { Get the fully qualified file name } 149 | DragQueryFile(hDropHandle, iFile, pszFileWithPath, iStrLen); 150 | { Get the extension and name parts } 151 | iPos := StrLen(pszFileWithPath); 152 | while iPos > 0 do 153 | begin 154 | Dec(iPos); 155 | case pszFileWithPath[iPos] of 156 | '.': pszExt := @pszFileWithPath[iPos + 1]; 157 | '\': begin 158 | pszFile := @pszFileWithPath[iPos + 1]; 159 | iPos := 0; 160 | end 161 | end; 162 | end; 163 | { Add the file names to appropriate lists } 164 | FNameWithPath.Add(StrPas(pszFileWithPath)); 165 | FNameOnly.Add( StrPas(pszFile)); 166 | FExtension.Add(StrPas(pszExt)); 167 | Inc(iFile); 168 | end; 169 | 170 | StrDispose(pszFileWithPath); 171 | 172 | { This will result in the OnDrop method being called, if it is defined } 173 | if Assigned(FOnDrop) then 174 | FOnDrop(Self); 175 | end; 176 | 177 | procedure TFileDrag.WndProc(var Msg: TMessage); 178 | begin 179 | with Msg do 180 | begin 181 | { If message is drop files, process, otherwise call the original window procedure } 182 | if Msg = WM_DROPFILES then 183 | DropFiles(HDrop(wParam)) 184 | else 185 | Result := CallWindowProc(FDefProc, FWndHandle, Msg, WParam, LParam); 186 | end; 187 | end; 188 | 189 | end. 190 | 191 | -------------------------------------------------------------------------------- /LIBRARY/rmBaseEdit.pas: -------------------------------------------------------------------------------- 1 | {================================================================================ 2 | Copyright (C) 1997-2001 Mills Enterprise 3 | 4 | Unit : rmBaseEdit 5 | Purpose : Base Edit class used by other "rmEdit" controls. 6 | Date : 01-15-2000 7 | Author : Ryan J. Mills 8 | Version : 1.80 9 | ================================================================================} 10 | 11 | unit rmBaseEdit; 12 | 13 | interface 14 | 15 | {$I rmcontrols.inc} 16 | 17 | uses Messages, Windows, Classes, StdCtrls; 18 | 19 | type 20 | TrmCustomEdit = class(TCustomEdit) 21 | private 22 | fWantTabs: boolean; 23 | procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; 24 | public 25 | constructor Create(AOwner:TComponent); override; 26 | property BorderStyle; 27 | property ReadOnly; 28 | property WantTabs:boolean read fWantTabs write fWantTabs default false; 29 | end; 30 | 31 | implementation 32 | 33 | { TrmCustomEdit } 34 | 35 | procedure TrmCustomEdit.WMGetDlgCode(var Message: TWMGetDlgCode); 36 | begin 37 | inherited; 38 | 39 | if fWantTabs then 40 | Message.Result := Message.Result or DLGC_WANTTAB; 41 | end; 42 | 43 | constructor TrmCustomEdit.Create(AOwner: TComponent); 44 | begin 45 | inherited; 46 | fWantTabs := false; 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /LIBRARY/rmBtnEdit.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/rmBtnEdit.dcr -------------------------------------------------------------------------------- /LIBRARY/rmBtnEdit.pas: -------------------------------------------------------------------------------- 1 | {================================================================================ 2 | Copyright (C) 1997-2001 Mills Enterprise 3 | 4 | Unit : rmBtnEdit 5 | Purpose : An edit control with a combo type button (or two). Also used as a 6 | basis for a couple of the "rm" combo boxes. 7 | Date : 03-15-1999 8 | Author : Ryan J. Mills 9 | Version : 1.80 10 | ================================================================================} 11 | 12 | unit rmBtnEdit; 13 | 14 | interface 15 | 16 | {$I rmcontrols.inc} 17 | 18 | uses Windows, Classes, StdCtrls, Controls, Messages, SysUtils, 19 | Forms, Graphics, Buttons, rmSpeedBtns, rmBaseEdit; 20 | 21 | type 22 | 23 | { TrmCustomBtnEdit } 24 | 25 | TrmCustomBtnEdit = class(TrmCustomEdit) 26 | private 27 | fundo: string; 28 | FButton1, FButton2: TrmSpeedButton; 29 | fOnBtn1Click, 30 | fOnBtn2Click: TNotifyEvent; 31 | FEditorEnabled: Boolean; 32 | FBtnWidth: integer; 33 | fBtn2IsVisible, 34 | fBtn1IsEnabled, 35 | fBtn2IsEnabled: boolean; 36 | fBtn1DefaultGlyph, 37 | fBtn2DefaultGlyph: boolean; 38 | fUseDefaultGlyphs: boolean; 39 | procedure SetEditRect; 40 | procedure SetBtnWidth(value: integer); 41 | function GetBtn1Enabled: boolean; 42 | function GetBtn1Glyph: TBitMap; 43 | function GetBtn1NumGlyphs: TNumGlyphs; 44 | function GetBtn1Visible: boolean; 45 | function GetBtn2Enabled: boolean; 46 | function GetBtn2Glyph: TBitMap; 47 | function GetBtn2NumGlyphs: TNumGlyphs; 48 | function GetBtn2Visible: boolean; 49 | procedure SetBtn1Enabled(const Value: boolean); 50 | procedure SetBtn1Glyph(value: TBitMap); 51 | procedure SetBtn1NumGlyphs(value: TNumGlyphs); 52 | procedure SetBtn1Visible(value: boolean); 53 | procedure SetBtn2Enabled(const Value: boolean); 54 | procedure SetBtn2Glyph(value: TBitMap); 55 | procedure SetBtn2NumGlyphs(value: TNumGlyphs); 56 | procedure SetBtn2Visible(const Value: boolean); 57 | procedure ResetDefaultGlyphs; 58 | procedure WMSize(var Message: TWMSize); message WM_SIZE; 59 | procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER; 60 | procedure WMPaste(var Message: TWMPaste); message WM_PASTE; 61 | procedure WMCut(var Message: TWMCut); message WM_CUT; 62 | procedure CMSysColorChange(var Message: TMessage); message 63 | CM_SYSCOLORCHANGE; 64 | {$IFDEF D4_OR_HIGHER} 65 | procedure SetEnabled(value: Boolean); reintroduce; 66 | (* reintroduce is D4 Modification *) 67 | function GetEnabled: Boolean; reintroduce; 68 | (* reintroduce is D4 Modification *) 69 | {$ELSE} 70 | procedure SetEnabled(value: Boolean); 71 | function GetEnabled: Boolean; 72 | {$ENDIF} 73 | procedure SetUseDefaultGlyphs(const Value: boolean); 74 | protected 75 | procedure BtnClick(Sender: TObject); virtual; 76 | procedure KeyDown(var Key: Word; Shift: TShiftState); override; 77 | procedure KeyPress(var Key: Char); override; 78 | procedure CreateParams(var Params: TCreateParams); override; 79 | procedure CreateWnd; override; 80 | 81 | function GetButton(index: integer): TrmSpeedButton; 82 | property BtnWidth: integer read FBtnWidth write setBtnWidth stored true 83 | default 16; 84 | property Btn1Enabled: boolean read GetBtn1Enabled write SetBtn1Enabled stored 85 | true default true; 86 | property Btn1Glyph: TBitmap read GetBtn1Glyph write SetBtn1Glyph stored 87 | True; 88 | property Btn1NumGlyphs: TNumGlyphs read GetBtn1NumGlyphs write 89 | SetBtn1NumGlyphs stored true; 90 | property Btn1Visible: boolean read GetBtn1Visible write SetBtn1Visible stored 91 | true default true; 92 | property Btn2Enabled: boolean read GetBtn2Enabled write SetBtn2Enabled stored 93 | true default true; 94 | property Btn2Glyph: TBitmap read GetBtn2Glyph write SetBtn2Glyph stored 95 | True; 96 | property Btn2NumGlyphs: TNumGlyphs read GetBtn2NumGlyphs write 97 | SetBtn2NumGlyphs stored true; 98 | property Btn2Visible: boolean read GetBtn2Visible write SetBtn2Visible stored 99 | true default false; 100 | property UseDefaultGlyphs: boolean read fUseDefaultGlyphs write 101 | SetUseDefaultGlyphs default true; 102 | property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled 103 | default True; 104 | property Enabled: Boolean read GetEnabled write SetEnabled default True; 105 | property OnBtn1Click: TNotifyEvent read fOnBtn1Click write fOnBtn1Click; 106 | property OnBtn2Click: TNotifyEvent read fOnBtn2Click write fOnBtn2Click; 107 | public 108 | constructor Create(AOwner: TComponent); override; 109 | destructor Destroy; override; 110 | procedure SetFocus; override; 111 | end; 112 | 113 | TrmBtnEdit = class(TrmCustomBtnEdit) 114 | published 115 | property Align; 116 | {$IFDEF D4_OR_HIGHER} 117 | property Anchors; 118 | property Constraints; 119 | {$ENDIF} 120 | property AutoSelect; 121 | property AutoSize; 122 | property BtnWidth; 123 | property Btn1Enabled; 124 | property Btn1Glyph; 125 | property Btn1NumGlyphs; 126 | property Btn1Visible; 127 | property Btn2Enabled; 128 | property Btn2Glyph; 129 | property Btn2NumGlyphs; 130 | property Btn2Visible; 131 | property BorderStyle; 132 | property Color; 133 | property Ctl3D; 134 | property DragCursor; 135 | property DragMode; 136 | property EditorEnabled; 137 | property Enabled; 138 | property Font; 139 | property MaxLength; 140 | property ParentColor; 141 | property ParentCtl3D; 142 | property ParentFont; 143 | property ParentShowHint; 144 | property PopupMenu; 145 | property ReadOnly; 146 | property ShowHint; 147 | property TabOrder; 148 | property TabStop; 149 | property Text; 150 | property Visible; 151 | property OnChange; 152 | property OnClick; 153 | property OnDblClick; 154 | property OnDragDrop; 155 | property OnDragOver; 156 | property OnEndDrag; 157 | property OnEnter; 158 | property OnExit; 159 | property OnKeyDown; 160 | property OnKeyPress; 161 | property OnKeyUp; 162 | property OnMouseDown; 163 | property OnMouseMove; 164 | property OnMouseUp; 165 | property OnStartDrag; 166 | property OnBtn1Click; 167 | property OnBtn2Click; 168 | end; 169 | 170 | procedure Register; 171 | 172 | implementation 173 | 174 | {$R rmBtnEdit.res} 175 | 176 | uses 177 | rmLibrary; 178 | 179 | { TrmCustomBtnEdit } 180 | 181 | constructor TrmCustomBtnEdit.Create(AOwner: TComponent); 182 | begin 183 | inherited Create(AOwner); 184 | 185 | fUseDefaultGlyphs := true; 186 | 187 | FButton1 := TrmSpeedButton.Create(Self); 188 | with FButton1 do 189 | begin 190 | Visible := True; 191 | Style := sbsComboButton; 192 | Cursor := crArrow; 193 | Parent := Self; 194 | Align := alRight; 195 | OnClick := BtnClick; 196 | enabled := true; 197 | Layout := blGlyphTop; 198 | end; 199 | fBtn1IsEnabled := true; 200 | fBtn1DefaultGlyph := true; 201 | Btn1Glyph := nil; 202 | 203 | FButton2 := TrmSpeedButton.Create(Self); 204 | with FButton2 do 205 | begin 206 | Visible := false; 207 | Style := sbsComboButton; 208 | Cursor := crArrow; 209 | Parent := Self; 210 | Align := alRight; 211 | OnClick := BtnClick; 212 | Layout := blGlyphTop; 213 | enabled := true; 214 | end; 215 | fBtn2IsEnabled := true; 216 | fBtn2IsVisible := false; 217 | fBtn2DefaultGlyph := true; 218 | Btn2Glyph := nil; 219 | 220 | BtnWidth := 16; 221 | Text := ''; 222 | ControlStyle := ControlStyle - [csSetCaption]; 223 | FEditorEnabled := True; 224 | end; 225 | 226 | destructor TrmCustomBtnEdit.Destroy; 227 | begin 228 | FButton1.free; // := nil; 229 | FButton2.free; // := nil; 230 | inherited Destroy; 231 | end; 232 | 233 | procedure TrmCustomBtnEdit.KeyDown(var Key: Word; Shift: TShiftState); 234 | begin 235 | if (Key = VK_RETURN) then 236 | begin 237 | if ([ssCtrl] = Shift) then 238 | BtnClick(FButton1) 239 | else if ([ssctrl, ssShift] = Shift) then 240 | BtnClick(FButton2) 241 | else if (shift = []) then 242 | begin 243 | setfocus; 244 | inherited KeyDown(key, shift); 245 | end; 246 | end 247 | else if (key = vk_escape) then 248 | begin 249 | if (shift = []) and (text <> fundo) then 250 | begin 251 | text := fundo; 252 | selectall; 253 | end; 254 | end 255 | else 256 | inherited KeyDown(Key, Shift); 257 | end; 258 | 259 | procedure TrmCustomBtnEdit.setfocus; 260 | begin 261 | fundo := text; 262 | inherited; 263 | end; 264 | 265 | procedure TrmCustomBtnEdit.CreateParams(var Params: TCreateParams); 266 | begin 267 | inherited CreateParams(Params); 268 | { Params.Style := Params.Style and not WS_BORDER; } 269 | Params.Style := Params.Style or WS_CLIPCHILDREN or ES_MULTILINE; 270 | end; 271 | 272 | procedure TrmCustomBtnEdit.CreateWnd; 273 | begin 274 | inherited CreateWnd; 275 | SetEditRect; 276 | end; 277 | 278 | procedure TrmCustomBtnEdit.SetEditRect; 279 | var 280 | R: TRect; 281 | begin 282 | SendMessage(Handle, EM_GETRECT, 0, LongInt(@R)); 283 | if FButton1.visible then 284 | R.Right := ClientWidth - fBtnWidth - 1 285 | else 286 | R.right := ClientWidth; 287 | 288 | if FButton2.visible then 289 | R.Right := R.right - fBtnWidth; 290 | 291 | R.Top := 0; 292 | R.Left := 0; 293 | SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R)); 294 | SendMessage(Handle, EM_GETRECT, 0, LongInt(@R)); {debug} 295 | end; 296 | 297 | procedure TrmCustomBtnEdit.WMSize(var Message: TWMSize); 298 | begin 299 | inherited; 300 | if NewStyleControls and Ctl3D then 301 | begin 302 | if fButton2.Visible then 303 | begin 304 | FButton1.SetBounds((width - (fBtnWidth shl 1)) - 4, 0, fBtnWidth, Height - 305 | 4); 306 | FButton2.SetBounds((width - fBtnWidth) - 4, 0, fBtnWidth, Height - 4); 307 | end 308 | else 309 | FButton1.SetBounds((width - fBtnWidth) - 4, 0, fBtnWidth, Height - 4); 310 | end 311 | else 312 | begin 313 | if fButton2.Visible then 314 | begin 315 | FButton1.SetBounds(width - (fBtnWidth shl 1), 1, fBtnWidth, Height - 2); 316 | FButton2.SetBounds(width - fBtnWidth, 1, fBtnWidth, Height - 2); 317 | end 318 | else 319 | FButton1.SetBounds(width - fBtnWidth, 1, fBtnWidth, Height - 2); 320 | end; 321 | if csdesigning in componentstate then 322 | begin 323 | if not fbutton1.visible then 324 | fbutton1.width := 0; 325 | if not fbutton2.visible then 326 | fbutton2.width := 0; 327 | end; 328 | SetEditRect; 329 | end; 330 | 331 | procedure TrmCustomBtnEdit.BtnClick(Sender: TObject); 332 | begin 333 | SetFocus; 334 | if (Sender is TrmSpeedButton) and (TrmSpeedButton(Sender) = fbutton1) and 335 | assigned(fOnBtn1Click) then 336 | fOnBtn1Click(self) 337 | else if (Sender is TrmSpeedButton) and (TrmSpeedButton(Sender) = fbutton2) and 338 | assigned(fOnBtn2Click) then 339 | fOnBtn2Click(self) 340 | end; 341 | 342 | procedure TrmCustomBtnEdit.WMPaste(var Message: TWMPaste); 343 | begin 344 | if not FEditorEnabled or ReadOnly then 345 | Exit; 346 | inherited; 347 | end; 348 | 349 | procedure TrmCustomBtnEdit.WMCut(var Message: TWMPaste); 350 | begin 351 | if not FEditorEnabled or ReadOnly then 352 | Exit; 353 | inherited; 354 | end; 355 | 356 | procedure TrmCustomBtnEdit.CMEnter(var Message: TCMGotFocus); 357 | begin 358 | if AutoSelect and not (csLButtonDown in ControlState) then 359 | SelectAll; 360 | inherited; 361 | end; 362 | 363 | procedure TrmCustomBtnEdit.SetBtn1Glyph(value: TBitMap); 364 | var 365 | bmp: TBitmap; 366 | begin 367 | FButton1.glyph := value; 368 | fBtn1DefaultGlyph := false; 369 | if fUseDefaultGlyphs and (value = nil) then 370 | begin 371 | fBtn1DefaultGlyph := true; 372 | bmp := tbitmap.create; 373 | try 374 | bmp.LoadFromResourceName(HInstance, 'RM_ELLIPSIS'); 375 | ReplaceColors(bmp, clBtnFace, clBtnText); 376 | fButton1.Glyph.Assign(bmp); 377 | finally 378 | bmp.free; 379 | end; 380 | end; 381 | end; 382 | 383 | function TrmCustomBtnEdit.GetBtn1Glyph: TBitMap; 384 | begin 385 | Result := FButton1.glyph; 386 | end; 387 | 388 | procedure TrmCustomBtnEdit.SetBtn2Glyph(value: TBitMap); 389 | var 390 | bmp: TBitmap; 391 | begin 392 | FButton2.glyph := value; 393 | fBtn2DefaultGlyph := false; 394 | 395 | if fUseDefaultGlyphs and (value = nil) then 396 | begin 397 | fBtn2DefaultGlyph := true; 398 | 399 | bmp := tbitmap.create; 400 | try 401 | bmp.LoadFromResourceName(HInstance, 'RM_ELLIPSIS'); 402 | ReplaceColors(bmp, clBtnFace, clBtnText); 403 | fButton2.Glyph.Assign(bmp); 404 | finally 405 | bmp.free; 406 | end; 407 | end; 408 | end; 409 | 410 | function TrmCustomBtnEdit.GetBtn2Glyph: TBitMap; 411 | begin 412 | Result := FButton2.glyph; 413 | end; 414 | 415 | procedure TrmCustomBtnEdit.SetBtn1Visible(value: boolean); 416 | begin 417 | FButton1.visible := value; 418 | fButton2.Visible := FBtn2IsVisible and fButton1.visible; 419 | if fButton2.Visible then 420 | fButton2.Left := fButton1.left + 1; 421 | recreatewnd; 422 | end; 423 | 424 | function TrmCustomBtnEdit.GetBtn1Visible: boolean; 425 | begin 426 | Result := FButton1.visible; 427 | end; 428 | 429 | procedure TrmCustomBtnEdit.SetEnabled(value: Boolean); 430 | begin 431 | inherited enabled := value; 432 | FButton1.enabled := fBtn1IsEnabled and value; 433 | FButton2.Enabled := fBtn2IsEnabled and value; 434 | end; 435 | 436 | procedure TrmCustomBtnEdit.KeyPress(var Key: Char); 437 | begin 438 | if key in [#10, #13] then 439 | key := #0; 440 | inherited; 441 | end; 442 | 443 | function TrmCustomBtnEdit.GetEnabled: Boolean; 444 | begin 445 | Result := inherited Enabled; 446 | end; 447 | 448 | procedure TrmCustomBtnEdit.SetBtnWidth(value: integer); 449 | begin 450 | if value <> FBtnWidth then 451 | begin 452 | FBtnWidth := value; 453 | FButton1.width := FBtnWidth; 454 | FButton2.Width := FBtnWidth; 455 | recreatewnd; 456 | end; 457 | end; 458 | 459 | procedure TrmCustomBtnEdit.SetBtn2Visible(const Value: boolean); 460 | begin 461 | fBtn2IsVisible := Value; 462 | fButton2.Visible := FBtn2IsVisible and FButton1.visible; 463 | if fButton2.Visible then 464 | fButton2.Left := fButton1.left + 1; 465 | if csdesigning in componentstate then 466 | fButton2.Visible := FBtn2IsVisible and FButton1.visible; 467 | recreatewnd; 468 | end; 469 | 470 | function TrmCustomBtnEdit.GetBtn2Visible: boolean; 471 | begin 472 | Result := fBtn2IsVisible; 473 | end; 474 | 475 | function TrmCustomBtnEdit.GetBtn1Enabled: boolean; 476 | begin 477 | Result := fBtn1IsEnabled; 478 | end; 479 | 480 | function TrmCustomBtnEdit.GetBtn2Enabled: boolean; 481 | begin 482 | Result := fBtn2IsEnabled; 483 | end; 484 | 485 | procedure TrmCustomBtnEdit.SetBtn1Enabled(const Value: boolean); 486 | begin 487 | fbutton1.enabled := enabled and value; 488 | fBtn1IsEnabled := value; 489 | end; 490 | 491 | procedure TrmCustomBtnEdit.SetBtn2Enabled(const Value: boolean); 492 | begin 493 | fbutton2.enabled := enabled and value; 494 | fBtn2IsEnabled := value; 495 | end; 496 | 497 | function TrmCustomBtnEdit.GetBtn1NumGlyphs: TNumGlyphs; 498 | begin 499 | Result := fbutton1.NumGlyphs; 500 | end; 501 | 502 | function TrmCustomBtnEdit.GetBtn2NumGlyphs: TNumGlyphs; 503 | begin 504 | Result := fbutton2.NumGlyphs; 505 | end; 506 | 507 | procedure TrmCustomBtnEdit.SetBtn1NumGlyphs(value: TNumGlyphs); 508 | begin 509 | FButton1.numglyphs := value; 510 | end; 511 | 512 | procedure TrmCustomBtnEdit.SetBtn2NumGlyphs(value: TNumGlyphs); 513 | begin 514 | FButton2.numGlyphs := value; 515 | end; 516 | 517 | function TrmCustomBtnEdit.GetButton(index: integer): TrmSpeedButton; 518 | begin 519 | case index of 520 | 1: Result := FButton1; 521 | 2: Result := FButton2; 522 | else 523 | Result := nil; 524 | end; 525 | end; 526 | 527 | procedure TrmCustomBtnEdit.CMSysColorChange(var Message: TMessage); 528 | begin 529 | ResetDefaultGlyphs; 530 | end; 531 | 532 | procedure TrmCustomBtnEdit.SetUseDefaultGlyphs(const Value: boolean); 533 | begin 534 | fUseDefaultGlyphs := Value; 535 | ResetDefaultGlyphs; 536 | end; 537 | 538 | procedure TrmCustomBtnEdit.ResetDefaultGlyphs; 539 | begin 540 | if fBtn1DefaultGlyph then 541 | SetBtn1Glyph(nil); 542 | 543 | if fBtn2DefaultGlyph then 544 | SetBtn2Glyph(nil); 545 | end; 546 | 547 | procedure Register; 548 | begin 549 | RegisterComponents('TombViewer Components', [TrmBtnEdit]); 550 | end; 551 | 552 | end. 553 | 554 | -------------------------------------------------------------------------------- /LIBRARY/rmBtnEdit.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/rmBtnEdit.res -------------------------------------------------------------------------------- /LIBRARY/rmSBSpin.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/rmSBSpin.res -------------------------------------------------------------------------------- /LIBRARY/rmSpeedBtns.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/LIBRARY/rmSpeedBtns.dcr -------------------------------------------------------------------------------- /LIBRARY/rmcontrols.inc: -------------------------------------------------------------------------------- 1 | { 2 | This Compiler definination file was created to help describe different versions 3 | of the Borland Compilers. The verXX is what Borland uses to describe each 4 | different version of the compiler. With this in mind this file defines the following: 5 | 6 | BDx - where x is the version of delphi. eg. BD5 would be defined for Delphi 5 7 | BCBx - where x is the version of C++ Builder 8 | DELPHI_COMPILER - is defined for all Delphi versions of the compiler 9 | BCB_COMPILER - is defined for all C++ Builder versions of the compiler 10 | Unknown_Version - is defined if no compiler version is correctly matched to a verXX 11 | Dx_OR_HIGHER - where x is a Delphi version number. Eg. D4_OR_HIGHER would be 12 | defined for all versions of the compiler from D4 onwards. 13 | BCBx_OR_HIGHER - where x is a C++ Builder version number. Eg. BCB4_OR_HIGHER would be 14 | defined for all versions of the compiler from BCB4 onwards. 15 | 16 | 17 | The following is a quick reference to the verXX and the matching Borland product: 18 | 19 | Ver80 - Delphi 1 20 | Ver90 - Delphi 2 Ver93 - C++ Builder 1 21 | Ver100 - Delphi 3 Ver110 - C++ Builder 3 22 | Ver120 - Delphi 4 Ver125 - C++ Builder 4 23 | Ver130 - Delphi 5 Ver135 - C++ Builder 5 24 | Ver140 - Delphi 6 25 | 26 | Starting with D2 all compilers define WIN32 for the Win32 platform. I would expect 27 | that a new define will appear with the addvent of Kylix. Something like "LINUX"? 28 | 29 | D1 was the only 16-bit version of Delphi released. The was never a 16-Bit version of BCB. 30 | } 31 | 32 | {*$DEFINE rmDebug} 33 | 34 | {$IFDEF WIN32} 35 | {$DEFINE D2_OR_HIGHER} 36 | {$ENDIF} 37 | 38 | {$DEFINE UNKNOWN_COMPILER} 39 | {$UNDEF RMVERSET} 40 | 41 | {$IFDEF VER80} //DELPHI 1 42 | {$DEFINE BD1} 43 | {$DEFINE DELPHI_COMPILER} 44 | {$UNDEF UNKNOWN_COMPILER} 45 | {$DEFINE RMVERSET} 46 | {$ELSE} 47 | {$IFNDEF RMVERSET} 48 | {$DEFINE D1_OR_HIGHER} 49 | {$ENDIF} 50 | {$ENDIF} 51 | 52 | {$IFDEF VER90} //DELPHI 2 53 | {$DEFINE BD2} 54 | {$DEFINE DELPHI_COMPILER} 55 | {$UNDEF UNKNOWN_COMPILER} 56 | {$DEFINE RMVERSET} 57 | {$ELSE} 58 | {$IFNDEF RMVERSET} 59 | {$DEFINE D2_OR_HIGHER} 60 | {$ENDIF} 61 | {$ENDIF} 62 | 63 | {$IFDEF VER93} //BCB 1 64 | {$DEFINE BCB1} 65 | {$DEFINE BCB_COMPILER} 66 | {$UNDEF UNKNOWN_COMPILER} 67 | {$DEFINE RMVERSET} 68 | {$ELSE} 69 | {$IFNDEF RMVERSET} 70 | {$DEFINE BCB1_OR_HIGHER} 71 | {$ENDIF} 72 | {$ENDIF} 73 | 74 | {$IFDEF VER100} //DELPHI 3 75 | {$DEFINE BD3} 76 | {$DEFINE DELPHI_COMPILER} 77 | {$UNDEF UNKNOWN_COMPILER} 78 | {$DEFINE RMVERSET} 79 | {$ELSE} 80 | {$IFNDEF RMVERSET} 81 | {$DEFINE D3_OR_HIGHER} 82 | {$ENDIF} 83 | {$ENDIF} 84 | 85 | {$IFDEF VER110} //BCB 3 86 | {$DEFINE BCB3} 87 | {$DEFINE BCB_COMPILER} 88 | {$UNDEF UNKNOWN_COMPILER} 89 | {$DEFINE RMVERSET} 90 | {$ELSE} 91 | {$IFNDEF RMVERSET} 92 | {$DEFINE BCB3_OR_HIGHER} 93 | {$ENDIF} 94 | {$ENDIF} 95 | 96 | {$IFDEF VER120} //DELPHI 4 97 | {$DEFINE BD4} 98 | {$DEFINE DELPHI_COMPILER} 99 | {$UNDEF UNKNOWN_COMPILER} 100 | {$DEFINE RMVERSET} 101 | {$ELSE} 102 | {$IFNDEF RMVERSET} 103 | {$DEFINE D4_OR_HIGHER} 104 | {$ENDIF} 105 | {$ENDIF} 106 | 107 | {$IFDEF VER125} //BCB 4 108 | {$DEFINE BCB4} 109 | {$DEFINE BCB_COMPILER} 110 | {$UNDEF UNKNOWN_COMPILER} 111 | {$DEFINE RMVERSET} 112 | {$ELSE} 113 | {$IFNDEF RMVERSET} 114 | {$DEFINE BCB4_OR_HIGHER} 115 | {$ENDIF} 116 | {$ENDIF} 117 | 118 | {$IFDEF VER130} //DELPHI 5 119 | {$DEFINE BD5} 120 | {$DEFINE DELPHI_COMPILER} 121 | {$UNDEF UNKNOWN_COMPILER} 122 | {$DEFINE RMVERSET} 123 | {$ELSE} 124 | {$IFNDEF RMVERSET} 125 | {$DEFINE D5_OR_HIGHER} 126 | {$ENDIF} 127 | {$ENDIF} 128 | 129 | {$IFDEF VER135} //BCB5 130 | {$DEFINE BCB5} 131 | {$DEFINE BCB_COMPILER} 132 | {$UNDEF UNKNOWN_COMPILER} 133 | {$DEFINE RMVERSET} 134 | {$ELSE} 135 | {$IFNDEF RMVERSET} 136 | {$DEFINE BCB5_OR_HIGHER} 137 | {$ENDIF} 138 | {$ENDIF} 139 | 140 | {$IFDEF VER140} //DELPHI 6 141 | {$DEFINE BD6} 142 | {$DEFINE DELPHI_COMPILER} 143 | {$UNDEF UNKNOWN_COMPILER} 144 | {$DEFINE RMVERSET} 145 | {$ELSE} 146 | {$IFNDEF RMVERSET} 147 | {$DEFINE D6_OR_HIGHER} 148 | {$ENDIF} 149 | {$ENDIF} 150 | 151 | {$UNDEF RMVERSET} 152 | 153 | {$B-} //Turn off Complete Boolean Evaluation 154 | {$D-} //Turn off the damn Debug Info 155 | -------------------------------------------------------------------------------- /LIBRARY/smoothshow.pas: -------------------------------------------------------------------------------- 1 | {$B-} // Complete Boolean Evaluation 2 | {$T-} // Typed @ operator 3 | {$X+} // Extended syntax 4 | {$P+} // Open string params 5 | {$J+} // Writeable structured consts 6 | {$H+} // Use long strings by default 7 | {$O-} // Optimization 8 | {$R-} // Range-Checking 9 | {$V-} // Var-String Checking 10 | 11 | unit smoothshow; 12 | 13 | interface 14 | 15 | uses 16 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 17 | ExtCtrls; 18 | 19 | type 20 | 21 | { TTRVSmoothShow } 22 | 23 | TMinLoc = (mlCenter, mlTopLeft, mlTopRight, mlBottomLeft, mlBottomRight, mlParentCenter, mlCustom); 24 | 25 | TTRVSmoothShow = class(TComponent) 26 | private 27 | FDelay: Word; 28 | FColor: TColor; 29 | FBorderWidth: TBorderWidth; 30 | FEnabled: Boolean; 31 | FReverse: Boolean; 32 | FMinLocation: TMinLoc; 33 | FMinLeft: Integer; 34 | FMinTop: Integer; 35 | FMinWidth: Word; 36 | FMinHeight: Word; 37 | FOnFinishing: TNotifyEvent; 38 | FOnFinish: TNotifyEvent; 39 | Window: TCustomForm; 40 | OldRgn: HRgn; 41 | Timer: TTimer; 42 | Shadow: TForm; 43 | ThisStep: Integer; 44 | FBusy: Boolean; 45 | StartRect: TRect; 46 | StopRect: TRect; 47 | DiffRect: TRect; 48 | FParentPoint: TPoint; 49 | function GetCustomBounds: TRect; 50 | procedure SetCustomBounds(Value: TRect); 51 | function MinimizedRect: TRect; 52 | function CurrentRect(sStep: Word): TRect; 53 | procedure TimerFired(Sender: TObject); 54 | public 55 | constructor Create(AOwner: TComponent); override; 56 | procedure Execute(const frm: TForm; const ParentControl: TControl; const reverse: boolean); 57 | property Busy: Boolean read FBusy; 58 | property CustomBounds: TRect read GetCustomBounds write SetCustomBounds; 59 | published 60 | property Color: TColor read FColor write FColor default clBlack; 61 | property BorderWidth: TBorderWidth read FBorderWidth write FBorderWidth default 2; 62 | property Delay: Word read FDelay write FDelay default 25; 63 | property Enabled: Boolean read FEnabled write FEnabled default True; 64 | property MinLocation: TMinLoc read FMinLocation write FMinLocation default mlParentCenter; 65 | property MinLeft: Integer read FMinLeft write FMinLeft default 0; 66 | property MinTop: Integer read FMinTop write FMinTop default 0; 67 | property MinWidth: Word read FMinWidth write FMinWidth default 27; 68 | property MinHeight: Word read FMinHeight write FMinHeight default 27; 69 | property OnFinishing: TNotifyEvent read FOnFinishing write FOnFinishing; 70 | property OnFinish: TNotifyEvent read FOnFinish write FOnFinish; 71 | end; 72 | 73 | procedure FormSmoothShow(const frm: TForm; const fprnt: TControl); 74 | 75 | procedure FormSmoothHide(const frm: TForm; const fprnt: TControl); 76 | 77 | implementation 78 | 79 | { TTRVSmoothShow } 80 | 81 | constructor TTRVSmoothShow.Create(AOwner: TComponent); 82 | begin 83 | inherited Create(AOwner); 84 | FParentPoint.X := Screen.DesktopLeft + Screen.DesktopWidth div 2; 85 | FParentPoint.Y := Screen.DesktopTop + Screen.DesktopHeight div 2; 86 | FDelay := 25; 87 | FColor := clBlack; 88 | FEnabled := True; 89 | FReverse := False; 90 | FMinLocation := mlParentCenter; 91 | FBorderWidth := 2; 92 | CustomBounds := Rect(0, 0, 27, 27); 93 | FBusy := False; 94 | end; 95 | 96 | function TTRVSmoothShow.GetCustomBounds: TRect; 97 | begin 98 | SetRect(Result, MinLeft, MinTop, MinLeft + MinWidth, MinTop + MinHeight); 99 | end; 100 | 101 | procedure TTRVSmoothShow.SetCustomBounds(Value: TRect); 102 | begin 103 | With Value do 104 | begin 105 | FMinLeft := Left; 106 | FMinTop := Top; 107 | FMinWidth := Right - Left; 108 | FMinHeight := Bottom - Top; 109 | end; 110 | end; 111 | 112 | function TTRVSmoothShow.MinimizedRect: TRect; 113 | begin 114 | case MinLocation of 115 | mlParentCenter: 116 | SetRect(Result, FParentPoint.X, FParentPoint.Y, 0, 0); 117 | mlCenter: 118 | SetRect(Result, Screen.DesktopLeft + Screen.DesktopWidth div 2, 119 | Screen.DesktopTop + Screen.DesktopHeight div 2, 0, 0); 120 | mlTopLeft: 121 | SetRect(Result, Screen.DesktopLeft, Screen.DesktopTop, 0, 0); 122 | mlTopRight: 123 | SetRect(Result, Screen.DesktopLeft + Screen.DesktopWidth, 124 | Screen.DesktopTop, 0, 0); 125 | mlBottomLeft: 126 | SetRect(Result, Screen.DesktopLeft, Screen.DesktopTop + 127 | Screen.DesktopHeight, 0, 0); 128 | mlBottomRight: 129 | SetRect(Result, Screen.DesktopLeft + Screen.DesktopWidth, 130 | Screen.DesktopTop + Screen.DesktopHeight, 0, 0); 131 | else 132 | SetRect(Result, MinLeft, MinTop, MinWidth, MinHeight); 133 | end; 134 | end; 135 | 136 | function TTRVSmoothShow.CurrentRect(sStep: Word): TRect; 137 | begin 138 | Result.Left := StartRect.Left + (sStep * DiffRect.Left) div 100; 139 | Result.Top := StartRect.Top + (sStep * DiffRect.Top) div 100; 140 | Result.Right := StartRect.Right + (sStep * DiffRect.Right) div 100; 141 | Result.Bottom := StartRect.Bottom + (sStep * DiffRect.Bottom) div 100; 142 | end; 143 | 144 | procedure TTRVSmoothShow.Execute(const frm: TForm; const ParentControl: TControl; const reverse: boolean); 145 | var 146 | Rgn: HRgn; 147 | begin 148 | freverse := reverse; 149 | 150 | if ParentControl <> nil then 151 | FParentPoint := ParentControl.ClientToScreen( 152 | Point( 153 | ParentControl.Width div 2, 154 | ParentControl.Height div 2) 155 | ) 156 | else 157 | begin 158 | FParentPoint.X := Screen.DesktopLeft + Screen.DesktopWidth div 2; 159 | FParentPoint.Y := Screen.DesktopTop + Screen.DesktopHeight div 2; 160 | end; 161 | 162 | Window := TCustomForm(frm); 163 | if not Assigned(Window) then 164 | Exit; 165 | 166 | if not FBusy and (Enabled or (csDesigning in ComponentState)) then 167 | begin 168 | FBusy := True; 169 | if freverse then 170 | begin 171 | SetRect(StartRect, Window.Left, Window.Top, Window.Width, Window.Height); 172 | StopRect := MinimizedRect; 173 | end 174 | else 175 | begin 176 | StartRect := MinimizedRect; 177 | SetRect(StopRect, Window.Left, Window.Top, Window.Width, Window.Height); 178 | end; 179 | DiffRect.Left := StopRect.Left - StartRect.Left; 180 | DiffRect.Top := StopRect.Top - StartRect.Top; 181 | DiffRect.Right := StopRect.Right - StartRect.Right; 182 | DiffRect.Bottom := StopRect.Bottom - StartRect.Bottom; 183 | Shadow := TForm.Create(Application); 184 | Shadow.BorderStyle := bsNone; 185 | Shadow.Color := Color; 186 | OldRgn := 0; 187 | GetWindowRgn(Window.Handle, OldRgn); 188 | Rgn := CreateRectRgn(0, 0, 0, 0); 189 | SetWindowRgn(Window.Handle, Rgn, True); 190 | ThisStep := 0; 191 | Timer := TTimer.Create(Self); 192 | Timer.Interval := Delay; 193 | Timer.OnTimer := TimerFired; 194 | TimerFired(Self); 195 | end; 196 | end; 197 | 198 | procedure TTRVSmoothShow.TimerFired(Sender: TObject); 199 | var 200 | Rgn1, Rgn2: HRgn; 201 | begin 202 | with CurrentRect(ThisStep) do Shadow.SetBounds(Left, Top, Right, Bottom); 203 | Rgn1 := CreateRectRgn(0, 0, Shadow.Width, Shadow.Height); 204 | Rgn2 := CreateRectRgn(BorderWidth, BorderWidth, Shadow.Width - BorderWidth, Shadow.Height - BorderWidth); 205 | CombineRgn(Rgn1, Rgn1, Rgn2, RGN_DIFF); 206 | DeleteObject(Rgn2); 207 | SetWindowRgn(Shadow.Handle, Rgn1, True); 208 | if not Shadow.Visible then Shadow.Show; 209 | Shadow.Update; 210 | if ThisStep >= 100 then 211 | begin 212 | Timer.Free; 213 | if not (csDesigning in ComponentState) and Assigned(OnFinishing) then 214 | OnFinishing(Self); 215 | Shadow.Free; 216 | if not FReverse then 217 | begin 218 | SetWindowRgn(Window.Handle, OldRgn, True); 219 | Window.Update; 220 | end; 221 | FBusy := False; 222 | if not (csDesigning in ComponentState) and Assigned(OnFinish) then 223 | OnFinish(Self); 224 | end; 225 | ThisStep := (3 * ThisStep div 2) + 2; 226 | if ThisStep > 100 then ThisStep := 100; 227 | end; 228 | 229 | var 230 | fsmooth: TTRVSmoothShow; 231 | 232 | procedure FormSmoothShow(const frm: TForm; const fprnt: TControl); 233 | begin 234 | fsmooth.Execute(frm, fprnt, false); 235 | end; 236 | 237 | procedure FormSmoothHide(const frm: TForm; const fprnt: TControl); 238 | begin 239 | fsmooth.Execute(frm, fprnt, true); 240 | end; 241 | 242 | initialization 243 | fsmooth := TTRVSmoothShow.Create(nil); 244 | 245 | finalization 246 | fsmooth.Free; 247 | 248 | end. 249 | 250 | -------------------------------------------------------------------------------- /QUAKEVIEWER/ImageList1.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/ImageList1.bmp -------------------------------------------------------------------------------- /QUAKEVIEWER/OpenQuakeMapFrm.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/OpenQuakeMapFrm.ddp -------------------------------------------------------------------------------- /QUAKEVIEWER/QuickInfoFrm.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/QuickInfoFrm.ddp -------------------------------------------------------------------------------- /QUAKEVIEWER/QuickInfoFrm.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // QuakeViewer: 3D Viewer for Quake I, II, III, RTCW, Half-Life etc 4 | // Copyright (C) 2004-2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Quick Help Form 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | // New Site: https://sourceforge.net/projects/quakeviewer/ 27 | // Old Site: http://www.geocities.ws/jimmyvalavanis/applications/quakeviewer.html 28 | //------------------------------------------------------------------------------ 29 | 30 | {$I defs.inc} 31 | 32 | unit QuickInfoFrm; 33 | 34 | interface 35 | 36 | uses 37 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 38 | ExtCtrls, StdCtrls, AnotherReg; 39 | 40 | type 41 | TQuickInfoForm = class(TForm) 42 | Panel1: TPanel; 43 | Panel2: TPanel; 44 | OKBtn: TButton; 45 | Bevel1: TBevel; 46 | Panel3: TPanel; 47 | Memo1: TMemo; 48 | Panel4: TPanel; 49 | Label1: TLabel; 50 | Label2: TLabel; 51 | procedure Label2Click(Sender: TObject); 52 | procedure FormCreate(Sender: TObject); 53 | procedure FormDestroy(Sender: TObject); 54 | procedure FormShow(Sender: TObject); 55 | procedure FormHide(Sender: TObject); 56 | private 57 | { Private declarations } 58 | FormRestorer1: TFormRestorer; 59 | public 60 | { Public declarations } 61 | end; 62 | 63 | var 64 | QuickInfoForm: TQuickInfoForm; 65 | 66 | implementation 67 | 68 | {$R *.DFM} 69 | 70 | uses 71 | se_utils, qv_globals, smoothshow, unit1; 72 | 73 | procedure TQuickInfoForm.Label2Click(Sender: TObject); 74 | begin 75 | VisitHtmlPage(handle, rsHomePage); 76 | end; 77 | 78 | procedure TQuickInfoForm.FormCreate(Sender: TObject); 79 | begin 80 | FormRestorer1 := TFormRestorer.Create(self); 81 | FormRestorer1.ParentKey := DXViewerForm.AppConfigKey1; 82 | FormRestorer1.Name := 'FormRestorer1'; 83 | FormRestorer1.Restoring := frPositionOnly; 84 | FormRestorer1.Restore; 85 | end; 86 | 87 | procedure TQuickInfoForm.FormDestroy(Sender: TObject); 88 | begin 89 | FormRestorer1.Store; 90 | FormRestorer1.Free; 91 | end; 92 | 93 | procedure TQuickInfoForm.FormShow(Sender: TObject); 94 | begin 95 | FormSmoothShow(self, DXViewerForm); 96 | end; 97 | 98 | procedure TQuickInfoForm.FormHide(Sender: TObject); 99 | begin 100 | FormSmoothHide(self, DXViewerForm); 101 | end; 102 | 103 | end. 104 | -------------------------------------------------------------------------------- /QUAKEVIEWER/Splash.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/Splash.ddp -------------------------------------------------------------------------------- /QUAKEVIEWER/Splash.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // QuakeViewer: 3D Viewer for Quake I, II, III, RTCW, Half-Life etc 4 | // Copyright (C) 2004-2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Splash Form 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | // New Site: https://sourceforge.net/projects/quakeviewer/ 27 | // Old Site: http://www.geocities.ws/jimmyvalavanis/applications/quakeviewer.html 28 | //------------------------------------------------------------------------------ 29 | 30 | {$I defs.inc} 31 | 32 | unit Splash; 33 | 34 | interface 35 | 36 | uses 37 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 38 | ExtCtrls, StdCtrls; 39 | 40 | type 41 | TSplashForm = class(TForm) 42 | Panel1: TPanel; 43 | Image1: TImage; 44 | VersionLabel: TLabel; 45 | Label3: TLabel; 46 | Label1: TLabel; 47 | Timer1: TTimer; 48 | procedure FormCreate(Sender: TObject); 49 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 50 | procedure FormShow(Sender: TObject); 51 | procedure Timer1Timer(Sender: TObject); 52 | private 53 | counter: integer; 54 | public 55 | { Public declarations } 56 | end; 57 | 58 | var 59 | SplashForm: TSplashForm; 60 | 61 | implementation 62 | 63 | {$R *.DFM} 64 | 65 | procedure TSplashForm.FormCreate(Sender: TObject); 66 | begin 67 | Update; 68 | end; 69 | 70 | procedure TSplashForm.FormClose(Sender: TObject; var Action: TCloseAction); 71 | begin 72 | Action := caFree; 73 | end; 74 | 75 | procedure TSplashForm.FormShow(Sender: TObject); 76 | begin 77 | counter := 10; 78 | Timer1.Enabled := true; 79 | end; 80 | 81 | procedure TSplashForm.Timer1Timer(Sender: TObject); 82 | begin 83 | dec(counter); 84 | if counter < 0 then 85 | begin 86 | Timer1.Enabled := False; 87 | Close; 88 | end; 89 | end; 90 | 91 | end. 92 | -------------------------------------------------------------------------------- /QUAKEVIEWER/Unit1.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/Unit1.ddp -------------------------------------------------------------------------------- /QUAKEVIEWER/Unit1.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/Unit1.pas -------------------------------------------------------------------------------- /QUAKEVIEWER/dots.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/dots.bmp -------------------------------------------------------------------------------- /QUAKEVIEWER/file.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/file.bmp -------------------------------------------------------------------------------- /QUAKEVIEWER/quakeviewer_128.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/quakeviewer_128.ico -------------------------------------------------------------------------------- /QUAKEVIEWER/quakeviewer_32.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/quakeviewer_32.ico -------------------------------------------------------------------------------- /QUAKEVIEWER/quakeviewer_48.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/quakeviewer_48.ico -------------------------------------------------------------------------------- /QUAKEVIEWER/quakeviewer_64.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QUAKEVIEWER/quakeviewer_64.ico -------------------------------------------------------------------------------- /QUAKEVIEWER/qv_argv.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // QuakeViewer: 3D Viewer for Quake I, II, III, RTCW, Half-Life etc 4 | // Copyright (C) 2004-2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Command line managment 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | // New Site: https://sourceforge.net/projects/quakeviewer/ 27 | // Old Site: http://www.geocities.ws/jimmyvalavanis/applications/quakeviewer.html 28 | //------------------------------------------------------------------------------ 29 | 30 | {$I defs.inc} 31 | 32 | unit qv_argv; 33 | 34 | interface 35 | 36 | function QV_CheckParam(const check: string): integer; 37 | 38 | function QV_GetParam(const id: integer): string; 39 | 40 | implementation 41 | 42 | uses SysUtils; 43 | 44 | const 45 | MAXARGS = 256; 46 | 47 | var 48 | myargc: integer; 49 | myargv: array[0..MAXARGS] of string; 50 | 51 | function QV_CheckParam(const check: string): integer; 52 | var 53 | i: integer; 54 | uCheck: string; 55 | begin 56 | uCheck := UpperCase(check); 57 | for i := 1 to myargc - 1 do 58 | if uCheck = myargv[i] then 59 | begin 60 | result := i; 61 | exit; 62 | end; 63 | result := 0; 64 | end; 65 | 66 | function QV_GetParam(const id: integer): string; 67 | begin 68 | if id < myargc then 69 | result := myargv[id] 70 | else 71 | result := ''; 72 | end; 73 | 74 | procedure QV_InitArgv; 75 | var 76 | i: integer; 77 | begin 78 | myargc := ParamCount + 1; 79 | for i := 0 to myargc - 1 do 80 | myargv[i] := UpperCase(ParamStr(i)); 81 | for i := myargc to MAXARGS do 82 | myargv[i] := ''; 83 | end; 84 | 85 | initialization 86 | QV_InitArgv; 87 | 88 | end. 89 | 90 | -------------------------------------------------------------------------------- /QUAKEVIEWER/qv_globals.pas: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // QuakeViewer: 3D Viewer for Quake I, II, III, RTCW, Half-Life etc 4 | // Copyright (C) 2004-2018 by Jim Valavanis 5 | // 6 | // This program is free software; you can redistribute it and/or 7 | // modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation; either version 2 9 | // of the License, or (at your option) any later version. 10 | // 11 | // This program is distributed in the hope that it will be useful, 12 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | // 16 | // You should have received a copy of the GNU General Public License 17 | // along with this program; if not, write to the Free Software 18 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 19 | // 02111-1307, USA. 20 | // 21 | // DESCRIPTION: 22 | // Global variables 23 | // 24 | //------------------------------------------------------------------------------ 25 | // E-Mail: jimmyvalavanis@yahoo.gr 26 | // New Site: https://sourceforge.net/projects/quakeviewer/ 27 | // Old Site: http://www.geocities.ws/jimmyvalavanis/applications/quakeviewer.html 28 | //------------------------------------------------------------------------------ 29 | 30 | {$I defs.inc} 31 | 32 | unit qv_globals; 33 | 34 | interface 35 | 36 | resourcestring 37 | rsHomePage = 'https://sourceforge.net/projects/quakeviewer/'; 38 | 39 | implementation 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /QuakeViewer.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=1 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir=..\bin 94 | UnitOutputDir=..\dcu\QuakeViewer 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclaxserver;DelphiX_for5;TV_Package1 99 | Conditionals=QUAKEVIEWER 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir=C:\Program Files\Borland\Delphi7\Bin\ 112 | [Version Info] 113 | IncludeVerInfo=1 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=7 117 | Release=1 118 | Build=102 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=1033 125 | CodePage=1252 126 | [Version Info Keys] 127 | CompanyName=Jim Valavanis 128 | FileDescription=Quake Viewer 129 | FileVersion=1.7.1.102 130 | InternalName=QuakeViewer 131 | LegalCopyright=(c) 2004-2018, Jim Valavanis 132 | LegalTrademarks=Quake Viewer 133 | OriginalFilename=QuakeViewer.exe 134 | ProductName=Quake 3D Level Viewer 135 | ProductVersion=1.7 136 | Comments=https://sourceforge.net/projects/quakeviewer/ 137 | [HistoryLists\hlConditionals] 138 | Count=1 139 | Item0=QUAKEVIEWER 140 | [HistoryLists\hlUnitAliases] 141 | Count=1 142 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 143 | [HistoryLists\hlUnitOutputDirectory] 144 | Count=2 145 | Item0=..\dcu\QuakeViewer 146 | Item1=..\dcu 147 | [HistoryLists\hlOutputDirectorry] 148 | Count=2 149 | Item0=..\bin 150 | Item1=..\bin\QuakeViewer 151 | -------------------------------------------------------------------------------- /QuakeViewer.dpr: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // 3 | // QuakeViewer: 3D Viewer for the games Quake I, II, III, Half-Life, 4 | // Counter Strike, Hexen 2, Heretic 2 and RTCW. 5 | // Copyright (C) 2004-2018 by Jim Valavanis 6 | // 7 | // This program is free software; you can redistribute it and/or 8 | // modify it under the terms of the GNU General Public License 9 | // as published by the Free Software Foundation; either version 2 10 | // of the License, or (at your option) any later version. 11 | // 12 | // This program is distributed in the hope that it will be useful, 13 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | // GNU General Public License for more details. 16 | // 17 | // You should have received a copy of the GNU General Public License 18 | // along with this program; if not, write to the Free Software 19 | // Foundation, inc., 59 Temple Place - Suite 330, Boston, MA 20 | // 02111-1307, USA. 21 | // 22 | // DESCRIPTION: 23 | // Main Programm 24 | // 25 | //------------------------------------------------------------------------------ 26 | // E-Mail: jimmyvalavanis@yahoo.gr 27 | // New Site: https://sourceforge.net/projects/quakeviewer/ 28 | // Old Site: http://www.geocities.ws/jimmyvalavanis/applications/quakeviewer.html 29 | //------------------------------------------------------------------------------ 30 | 31 | program QuakeViewer; 32 | 33 | uses 34 | FastMM4 in 'FASTMM\FastMM4.pas', 35 | FastMM4Messages in 'FASTMM\FastMM4Messages.pas', 36 | Forms, 37 | se_DirectX in 'ENGINE\se_DirectX.pas', 38 | se_WADS in 'ENGINE\se_WADS.pas', 39 | se_D3DUtils in 'ENGINE\se_D3DUtils.pas', 40 | se_DXClasses in 'ENGINE\se_DXClasses.pas', 41 | se_DXDUtils in 'ENGINE\se_DXDUtils.pas', 42 | se_DXMeshes in 'ENGINE\se_DXMeshes.pas', 43 | se_DXTables in 'ENGINE\se_DXTables.pas', 44 | se_DXTextureEffects in 'ENGINE\se_DXTextureEffects.pas', 45 | se_DXDraws in 'ENGINE\se_DXDraws.pas', 46 | se_DXClass in 'ENGINE\se_DXClass.pas', 47 | se_DXConsts in 'ENGINE\se_DXConsts.pas', 48 | se_DXTexImg in 'ENGINE\se_DXTexImg.pas', 49 | se_DXRender in 'ENGINE\se_DXRender.pas', 50 | se_DXInput in 'ENGINE\se_DXInput.pas', 51 | se_Main in 'ENGINE\se_Main.pas', 52 | se_MyD3DUtils in 'ENGINE\se_MyD3DUtils.pas', 53 | se_TempDXDraw in 'ENGINE\se_TempDXDraw.pas' {TempDXDrawForm}, 54 | se_QuakeTypes in 'ENGINE\se_QuakeTypes.pas', 55 | se_Quake2Utils in 'ENGINE\se_Quake2Utils.pas', 56 | se_ZipFile in 'ENGINE\se_ZipFile.pas', 57 | se_Utils in 'ENGINE\se_Utils.pas', 58 | se_IDSoftData in 'ENGINE\se_IDSoftData.pas', 59 | se_RTLCompileParams in 'ENGINE\se_RTLCompileParams.pas', 60 | zBitmap in 'IMAGEFORMATS\zBitmap.pas', 61 | pcximage in 'IMAGEFORMATS\pcximage.pas', 62 | pngimage in 'IMAGEFORMATS\pngimage.pas', 63 | pnglang in 'IMAGEFORMATS\pnglang.pas', 64 | xGif in 'IMAGEFORMATS\xGIF.pas', 65 | xM8 in 'IMAGEFORMATS\xM8.pas', 66 | xPPM in 'IMAGEFORMATS\xPPM.pas', 67 | xStubGraphic in 'IMAGEFORMATS\xStubGraphic.pas', 68 | dibimage in 'IMAGEFORMATS\dibimage.pas', 69 | xTGA in 'IMAGEFORMATS\xTGA.pas', 70 | xWZ in 'IMAGEFORMATS\xWZ.pas', 71 | XPMenu in 'LIBRARY\XPMenu.pas', 72 | About in 'LIBRARY\About.pas' {AboutBox}, 73 | Aboutdlg in 'LIBRARY\Aboutdlg.pas', 74 | AnotherReg in 'LIBRARY\AnotherReg.pas', 75 | binarydata in 'LIBRARY\binarydata.pas', 76 | DropDownButton in 'LIBRARY\DropDownButton.pas', 77 | MessageBox in 'LIBRARY\MessageBox.pas', 78 | rmBaseEdit in 'LIBRARY\rmBaseEdit.pas', 79 | rmBtnEdit in 'LIBRARY\rmBtnEdit.pas', 80 | rmLibrary in 'LIBRARY\rmLibrary.pas', 81 | rmSpeedBtns in 'LIBRARY\rmSpeedBtns.pas', 82 | smoothshow in 'LIBRARY\smoothshow.pas', 83 | zlibpas in 'ZLIB\zlibpas.pas', 84 | Unit1 in 'QUAKEVIEWER\Unit1.pas' {DXViewerForm}, 85 | OpenQuakeMapFrm in 'QUAKEVIEWER\OpenQuakeMapFrm.pas' {ImportQuakeMapForm}, 86 | QuickInfoFrm in 'QUAKEVIEWER\QuickInfoFrm.pas' {QuickInfoForm}, 87 | Splash in 'QUAKEVIEWER\Splash.pas' {SplashForm}, 88 | qv_argv in 'QUAKEVIEWER\qv_argv.pas', 89 | qv_globals in 'QUAKEVIEWER\qv_globals.pas'; 90 | 91 | {$R *.RES} 92 | 93 | begin 94 | Application.Initialize; 95 | Application.Title := 'QuakeViewer'; 96 | Application.CreateForm(TDXViewerForm, DXViewerForm); 97 | Application.Run; 98 | end. 99 | -------------------------------------------------------------------------------- /QuakeViewer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/QuakeViewer.res -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # QuakeViewer 2 | QuakeViewer is a Windows application that enables you to freely navigate inside maps of games Quake1, Quake2, Quake3, Half-Life, Heretic2, Hexen2 and RTCW 3 | 4 | ## Features 5 | Freely navigate inside the maps using first person view 6 | 7 | Export screenshots in image files 8 | 9 | Copy screenshots to the clipboard 10 | 11 | 12 | ## Downloads 13 | [version 1.7.1.101 (20181027 - win32)](https://sourceforge.net/projects/quakeviewer/files/QuakeViewer_1.7/QuakeViewer_1.7.1.101_bin.zip/download) 14 | 15 | 16 | ## Screenshots 17 | 18 | ![Screenshot 1](https://i.postimg.cc/yxYK4Lg9/Image1.jpg "Screenshot 1") 19 | 20 | ![Screenshot 2](https://i.postimg.cc/pVqxYM4B/Image2.jpg "Screenshot 2") 21 | 22 | ![Screenshot 3](https://i.postimg.cc/63hKmk3t/Image3.jpg "Screenshot 3") 23 | 24 | -------------------------------------------------------------------------------- /ZLIB/adler32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/adler32.obj -------------------------------------------------------------------------------- /ZLIB/compress.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/compress.obj -------------------------------------------------------------------------------- /ZLIB/crc32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/crc32.obj -------------------------------------------------------------------------------- /ZLIB/deflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/deflate.obj -------------------------------------------------------------------------------- /ZLIB/gzio.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/gzio.obj -------------------------------------------------------------------------------- /ZLIB/infback.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/infback.obj -------------------------------------------------------------------------------- /ZLIB/inffast.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/inffast.obj -------------------------------------------------------------------------------- /ZLIB/inflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/inflate.obj -------------------------------------------------------------------------------- /ZLIB/inftrees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/inftrees.obj -------------------------------------------------------------------------------- /ZLIB/trees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/trees.obj -------------------------------------------------------------------------------- /ZLIB/uncompr.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/uncompr.obj -------------------------------------------------------------------------------- /ZLIB/z125_adler32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_adler32.obj -------------------------------------------------------------------------------- /ZLIB/z125_compress.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_compress.obj -------------------------------------------------------------------------------- /ZLIB/z125_crc32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_crc32.obj -------------------------------------------------------------------------------- /ZLIB/z125_deflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_deflate.obj -------------------------------------------------------------------------------- /ZLIB/z125_infback.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_infback.obj -------------------------------------------------------------------------------- /ZLIB/z125_inffast.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_inffast.obj -------------------------------------------------------------------------------- /ZLIB/z125_inflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_inflate.obj -------------------------------------------------------------------------------- /ZLIB/z125_inftrees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_inftrees.obj -------------------------------------------------------------------------------- /ZLIB/z125_trees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jval1972/QuakeViewer/4c6afbcc548090a65e3b3f2e693e6b0af458d57b/ZLIB/z125_trees.obj -------------------------------------------------------------------------------- /defs.inc: -------------------------------------------------------------------------------- 1 | {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$MINSTACKSIZE $00004000} 3 | {$MAXSTACKSIZE $00F42400} 4 | {$IMAGEBASE $00400000} 5 | {$APPTYPE GUI} 6 | 7 | {$IFDEF NOCLASSES} 8 | Error. You must UNDEF NOCLASSES to compile this 9 | {$ENDIF} 10 | 11 | {$IFDEF QUAKEVIEWER} 12 | {$DEFINE NO_D3DTRIANGLES} 13 | {$DEFINE NO_D3DSTUBOBJECTS} 14 | {$DEFINE NO_D3DBILLBOARDS} 15 | {$DEFINE NO_D3DCUBES} 16 | {$DEFINE NO_D3DSPHERES} 17 | {$DEFINE NO_D3DCONES} 18 | {$DEFINE NO_D3DCYLINDERS} 19 | {$DEFINE NO_D3DRINGS} 20 | {$DEFINE NO_D3DPLUGINS} 21 | {$DEFINE NO_D3DTEXTS} 22 | {$DEFINE NO_D3DPROCEDURALOBJECTS} 23 | {$DEFINE NO_SCRIPTS} 24 | {$DEFINE NO_AVI} 25 | {$DEFINE NO_D3DSOUNDS} 26 | {$DEFINE NO_DOOMTHINGS} 27 | {$DEFINE NO_D3DEXOBJECTS} 28 | {$DEFINE NO_D3DSECTORCOLLECTIONS} 29 | {$DEFINE NO_D3DACTORS} 30 | {$DEFINE NO_TOMBRAIDERSUPPORT} 31 | {$DEFINE NO_DUKE3DSUPPORT} 32 | {$DEFINE NO_OLDSTREAMINGRUTINES} 33 | {$DEFINE NO_MESSAGESCAN} 34 | {$DEFINE NO_OBJECTDRAWINGNOTIFY} 35 | {$DEFINE NO_GLOBALID} 36 | {$DEFINE NO_DXTABLES} 37 | {$DEFINE NO_DOOMSUPPORT} 38 | {$DEFINE NO_TEXTUREEFFECTS} 39 | {$DEFINE NO_DXMESHES} 40 | {$DEFINE NO_D3DEXTRARTLPOLYGONS} 41 | {$ENDIF} 42 | 43 | {$IFDEF TOMBVIEWER} 44 | {$DEFINE NO_IDSOFTGAMESSUPPORT} 45 | {$DEFINE NO_DOOMTHINGS} 46 | {$DEFINE NO_D3DTEXTS} 47 | {$DEFINE NO_D3DTRIANGLES} 48 | {$DEFINE NO_D3DBILLBOARDS} 49 | {$DEFINE NO_D3DCUBES} 50 | {$DEFINE NO_D3DSPHERES} 51 | {$DEFINE NO_D3DCONES} 52 | {$DEFINE NO_D3DCYLINDERS} 53 | {$DEFINE NO_D3DRINGS} 54 | {$DEFINE NO_D3DPLUGINS} 55 | {$DEFINE NO_D3DPROCEDURALOBJECTS} 56 | {$DEFINE NO_SCRIPTS} 57 | {$DEFINE NO_AVI} 58 | {$DEFINE NO_D3DSOUNDS} 59 | {$DEFINE NO_D3DEXOBJECTS} 60 | {$DEFINE NO_D3DSECTORCOLLECTIONS} 61 | {$DEFINE NO_D3DACTORS} 62 | {$DEFINE NO_DUKE3DSUPPORT} 63 | {$DEFINE NO_OLDSTREAMINGRUTINES} 64 | {$DEFINE NO_MESSAGESCAN} 65 | {$DEFINE NO_OBJECTDRAWINGNOTIFY} 66 | {$DEFINE NO_D3DGENERICRTLPOLYGONS} 67 | {$DEFINE NO_GLOBALID} 68 | {$DEFINE NO_DXTABLES} 69 | {$DEFINE NO_DOOMSUPPORT} 70 | {$DEFINE NO_QUAKESUPPORT} 71 | {$DEFINE NO_TEXTUREEFFECTS} 72 | {$DEFINE NO_DXMESHES} 73 | {$DEFINE NO_D3DEXTRARTLPOLYGONS} 74 | {$ENDIF} 75 | 76 | {$IFDEF DOOMVIEWER} 77 | {$DEFINE NO_D3DTRIANGLES} 78 | {$DEFINE NO_D3DBILLBOARDS} 79 | {$DEFINE NO_D3DCUBES} 80 | {$DEFINE NO_D3DSPHERES} 81 | {$DEFINE NO_D3DCONES} 82 | {$DEFINE NO_D3DCYLINDERS} 83 | {$DEFINE NO_D3DRINGS} 84 | {$DEFINE NO_D3DPLUGINS} 85 | {$DEFINE NO_D3DTEXTS} 86 | {$DEFINE NO_D3DPROCEDURALOBJECTS} 87 | {$DEFINE NO_SCRIPTS} 88 | {$DEFINE NO_AVI} 89 | {$DEFINE NO_D3DACTORS} 90 | {$DEFINE NO_D3DSOUNDS} 91 | {$DEFINE NO_TOMBRAIDERSUPPORT} 92 | {$DEFINE NO_DUKE3DSUPPORT} 93 | {$DEFINE NO_OLDSTREAMINGRUTINES} 94 | {$DEFINE NO_MESSAGESCAN} 95 | {$DEFINE ICONICSECTORCOLLECTIONS} 96 | {$DEFINE NO_OBJECTDRAWINGNOTIFY} 97 | {$DEFINE NO_D3DGENERICRTLPOLYGONS} 98 | {$DEFINE NO_GLOBALID} 99 | {$DEFINE NO_DXTABLES} 100 | {$DEFINE NO_QUAKESUPPORT} 101 | {$DEFINE NO_TEXTUREEFFECTS} 102 | {$DEFINE NO_DXMESHES} 103 | {$ENDIF} 104 | 105 | {$IFDEF HUNTER} 106 | {$DEFINE NO_D3DTRIANGLES} 107 | {$DEFINE NO_D3DBILLBOARDS} 108 | {$DEFINE NO_D3DCONES} 109 | {$DEFINE NO_D3DRINGS} 110 | {$DEFINE NO_D3DPLUGINS} 111 | {$DEFINE NO_D3DPROCEDURALOBJECTS} 112 | {$DEFINE NO_AVI} 113 | {$DEFINE NO_IDSOFTGAMESSUPPORT} 114 | {$DEFINE NO_DOOMTHINGS} 115 | {$DEFINE NO_SCRIPTS} 116 | {$DEFINE NO_TOMBRAIDERSUPPORT} 117 | {$DEFINE NO_MESSAGESCAN} 118 | {$DEFINE NO_DUKE3DSUPPORT} 119 | {$DEFINE NO_MESSAGESCAN} 120 | {$DEFINE NO_D3DGENERICRTLPOLYGONS} 121 | {$DEFINE NO_DXTABLES} 122 | {$DEFINE NO_DOOMSUPPORT} 123 | {$DEFINE NO_QUAKESUPPORT} 124 | {$DEFINE NO_TEXTUREEFFECTS} 125 | {$DEFINE NO_DXMESHES} 126 | {$DEFINE NO_D3DEXTRARTLPOLYGONS} 127 | {$ENDIF} 128 | 129 | {$IFDEF MD2VIEWER} 130 | {$DEFINE NO_D3DTRIANGLES} 131 | {$DEFINE NO_D3DSTUBOBJECTS} 132 | {$DEFINE NO_D3DBILLBOARDS} 133 | {$DEFINE NO_D3DCUBES} 134 | {$DEFINE NO_D3DSPHERES} 135 | {$DEFINE NO_D3DCONES} 136 | {$DEFINE NO_D3DCYLINDERS} 137 | {$DEFINE NO_D3DRINGS} 138 | {$DEFINE NO_D3DPLUGINS} 139 | {$DEFINE NO_D3DTEXTS} 140 | {$DEFINE NO_D3DPROCEDURALOBJECTS} 141 | {$DEFINE NO_SCRIPTS} 142 | {$DEFINE NO_AVI} 143 | {$DEFINE NO_D3DSOUNDS} 144 | {$DEFINE NO_DOOMTHINGS} 145 | {$DEFINE NO_D3DEXOBJECTS} 146 | {$DEFINE NO_D3DSECTORCOLLECTIONS} 147 | {$DEFINE NO_IDSOFTGAMESSUPPORT} 148 | {$DEFINE NO_TOMBRAIDERSUPPORT} 149 | {$DEFINE NO_DUKE3DSUPPORT} 150 | {$DEFINE NO_OLDSTREAMINGRUTINES} 151 | {$DEFINE NO_MESSAGESCAN} 152 | {$DEFINE NO_OBJECTDRAWINGNOTIFY} 153 | {$DEFINE NO_D3DGENERICRTLPOLYGONS} 154 | {$DEFINE NO_GLOBALID} 155 | {$DEFINE NO_DXTABLES} 156 | {$DEFINE NO_DOOMSUPPORT} 157 | {$DEFINE NO_QUAKESUPPORT} 158 | {$DEFINE NO_TEXTUREEFFECTS} 159 | {$DEFINE NO_DXMESHES} 160 | {$DEFINE NO_D3DEXTRARTLPOLYGONS} 161 | {$ENDIF} 162 | 163 | {$IFDEF DUKEVIEWER} 164 | {$DEFINE NO_D3DTRIANGLES} 165 | {$DEFINE NO_D3DBILLBOARDS} 166 | {$DEFINE NO_D3DCUBES} 167 | {$DEFINE NO_D3DSPHERES} 168 | {$DEFINE NO_D3DCONES} 169 | {$DEFINE NO_D3DCYLINDERS} 170 | {$DEFINE NO_D3DRINGS} 171 | {$DEFINE NO_D3DPLUGINS} 172 | {$DEFINE NO_D3DTEXTS} 173 | {$DEFINE NO_D3DPROCEDURALOBJECTS} 174 | {$DEFINE NO_SCRIPTS} 175 | {$DEFINE NO_AVI} 176 | {$DEFINE NO_D3DSOUNDS} 177 | {$DEFINE NO_DOOMTHINGS} 178 | {$DEFINE NO_D3DEXOBJECTS} 179 | {$DEFINE NO_D3DSECTORCOLLECTIONS} 180 | {$DEFINE NO_D3DACTORS} 181 | {$DEFINE NO_IDSOFTGAMESSUPPORT} 182 | {$DEFINE NO_TOMBRAIDERSUPPORT} 183 | {$DEFINE NO_OLDSTREAMINGRUTINES} 184 | {$DEFINE NO_MESSAGESCAN} 185 | {$DEFINE NO_OBJECTDRAWINGNOTIFY} 186 | {$DEFINE NO_D3DGENERICRTLPOLYGONS} 187 | {$DEFINE NO_GLOBALID} 188 | {$DEFINE NO_DXTABLES} 189 | {$DEFINE NO_DOOMSUPPORT} 190 | {$DEFINE NO_QUAKESUPPORT} 191 | {$DEFINE NO_TEXTUREEFFECTS} 192 | {$DEFINE NO_DXMESHES} 193 | {$DEFINE NO_D3DEXTRARTLPOLYGONS} 194 | {$ENDIF} 195 | 196 | {$IFDEF TEXTUREEFFECTS} 197 | {$DEFINE NO_DXTABLES} 198 | {$ENDIF} 199 | 200 | {$IFDEF DESIGNER} 201 | {$UNDEF NO_SCRIPTS} 202 | {$UNDEF NO_D3DTRIANGLES} 203 | {$UNDEF NO_D3DSTUBOBJECTS} 204 | {$UNDEF NO_D3DEXOBJECTS} 205 | {$UNDEF NO_D3DBILLBOARDS} 206 | {$UNDEF NO_D3DCUBES} 207 | {$UNDEF NO_D3DSPHERES} 208 | {$UNDEF NO_D3DCONES} 209 | {$UNDEF NO_D3DCYLINDERS} 210 | {$UNDEF NO_D3DPLUGINS} 211 | {$UNDEF NO_D3DRINGS} 212 | {$UNDEF NO_D3DSECTORCOLLECTIONS} 213 | {$UNDEF NO_D3DTEXTS} 214 | {$UNDEF NO_D3DPROCEDURALOBJECTS} 215 | {$UNDEF NO_D3DACTORS} 216 | {$UNDEF NO_D3DSOUNDS} 217 | {$UNDEF NO_AVI} 218 | {$UNDEF NO_DOOMTHINGS} 219 | {$UNDEF NO_IDSOFTGAMESSUPPORT} 220 | {$UNDEF NO_TOMBRAIDERSUPPORT} 221 | {$UNDEF NO_DUKE3DSUPPORT} 222 | {$UNDEF NO_OLDSTREAMINGRUTINES} 223 | {$UNDEF NO_MESSAGESCAN} 224 | {$UNDEF NO_OBJECTDRAWINGNOTIFY} 225 | {$UNDEF ICONICSECTORCOLLECTIONS} 226 | {$UNDEF NO_D3DGENERICRTLPOLYGONS} 227 | {$UNDEF NO_GLOBALID} 228 | {$UNDEF NO_DXTABLES} 229 | {$UNDEF NO_DOOMSUPPORT} 230 | {$UNDEF NO_QUAKESUPPORT} 231 | {$UNDEF NO_TEXTUREEFFECTS} 232 | {$UNDEF NO_DXMESHES} 233 | {$UNDEF NO_D3DEXTRARTLPOLYGONS} 234 | {$ENDIF} 235 | 236 | --------------------------------------------------------------------------------