🐛 Fix moving of items freeing the item in the process

Reviewed-on: #4

.drone.yml

@@ -0,0 +1,68 @@
+---
+kind: pipeline
+type: docker
+name: default
+
+steps:
+  - name: Build
+    image: git.aksdb.de/aksdb/centred:builder-221016
+    commands:
+      - ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.win32" -B Client/CentrED.lpr
+      - ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.Linux.x64" -B Client/CentrED.lpr
+      - ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.win32" -B Server/cedserver.lpi
+      - ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.Linux.x64" -B Server/cedserver.lpi
+
+  - name: Package
+    image: git.aksdb.de/aksdb/centred:builder-221016
+    commands:
+      - mkdir -p dist/client.win32 dist/client.linux.x64 dist/server.win32 dist/server.linux.x64
+      - cp Client.bin/nodraw.txt Client.bin/ColorLight.xml dist/client.linux.x64/
+      - cp Client.bin/nodraw.txt Client.bin/ColorLight.xml dist/client.win32/
+      - cp Client.bin/CentrED.x64 dist/client.linux.x64/CentrED
+      - cp Client.bin/CentrED.exe dist/client.win32/CentrED.exe
+      - cp Server.bin/cedserver.x64 dist/server.linux.x64/cedserver
+      - cp Server.bin/cedserver.exe dist/server.win32/cedserver.exe
+      - cd dist/client.win32 && zip ../CentrED.win32.zip *
+      - cd ../client.linux.x64 && tar czf ../CentrED.linux.x64.tgz *
+      - cd ../server.win32 && zip ../Server.win32.zip *
+      - cd ../server.linux.x64 && tar czf ../Server.linux.x64.tgz *
+
+  - name: Upload Client (win32)
+    image: vividboarder/drone-webdav
+    settings:
+      file: dist/CentrED.win32.zip
+      destination: https://aksdb.de/snapshots/CentrED/
+      username: centred
+      password:
+        from_secret: snapshots_password
+
+  - name: Upload Client (linux x64)
+    image: vividboarder/drone-webdav
+    settings:
+      file: dist/CentrED.linux.x64.tgz
+      destination: https://aksdb.de/snapshots/CentrED/
+      username: centred
+      password:
+        from_secret: snapshots_password
+
+  - name: Upload Server (win32)
+    image: vividboarder/drone-webdav
+    settings:
+      file: dist/Server.win32.zip
+      destination: https://aksdb.de/snapshots/CentrED/
+      username: centred
+      password:
+        from_secret: snapshots_password
+
+  - name: Upload Server (linux x64)
+    image: vividboarder/drone-webdav
+    settings:
+      file: dist/Server.linux.x64.tgz
+      destination: https://aksdb.de/snapshots/CentrED/
+      username: centred
+      password:
+        from_secret: snapshots_password
+
+trigger:
+  branch:
+    - master

.gitignore

@@ -1,8 +1,7 @@
-#syntax: regexp
-#(?<!\.(pas|lfm|lpr|lpi))$
-syntax: glob
 obj/*
 bin/*
+Client.bin/*
+Server.bin/*
 doc/*
 pasdoc/*
 Setup/*
@@ -23,3 +22,4 @@ Setup/*
 *.compiled
 *.sh
 *.exe
+*.res

Client.bin/ColorLight.xml

@@ -0,0 +1,975 @@
+<?xml version="1.0" ?>
+<ColorLight Version="1 (24.08.2014)" Server="uoquint.ru" Author="StaticZ">
+
+	<Colors> <!-- NOTE: ALLOWED ONLY COLORS WITH IDs FROM 1 TO 15 -->
+		<Color id="1"  r="0xFF" g="0xFF" b="0xFF" name="Default"/>
+		<Color id="2"  r="0xFF" g="0xFF" b="0xFF" name="Bright White"/>
+		<Color id="3"  r="0xE0" g="0xE0" b="0xE0" name="White"/>
+		<Color id="4"  r="0xFF" g="0x80" b="0x00" name="Bright Orange"/>
+		<Color id="5"  r="0xB6" g="0x5C" b="0x00" name="Thin Orange"/>
+		<Color id="6"  r="0xFF" g="0xFF" b="0x00" name="Bright Yellow"/>
+		<Color id="7"  r="0x80" g="0x80" b="0x00" name="Thin Yellow"/>
+		<Color id="8"  r="0xB6" g="0xB6" b="0x00" name="Yellow"/>
+		<Color id="9"  r="0x80" g="0x80" b="0xFF" name="Bright Lilac"/>
+		<Color id="10" r="0x00" g="0x00" b="0xFF" name="Bright Blue"/>
+		<Color id="11" r="0x00" g="0x00" b="0x80" name="Thin Blue"/>
+		<Color id="12" r="0x00" g="0xFF" b="0x00" name="Bright Green"/>
+		<Color id="13" r="0x00" g="0x80" b="0x00" name="Thin Green"/>
+		<Color id="14" r="0xFF" g="0x00" b="0x00" name="Bright Red"/>
+		<Color id="15" r="0xFF" g="0x00" b="0xFF" name="Bright Pink"/>
+	</Colors>	
+	
+	<Sources>
+			
+		<!-- Original Tiles -->
+		<Item ID="0x398C" color="2" />
+		<Item ID="0x398D" color="2" />
+		<Item ID="0x398E" color="2" />
+		<Item ID="0x398F" color="2" />
+		<Item ID="0x3990" color="2" />
+		<Item ID="0x3991" color="2" />
+		<Item ID="0x3992" color="2" />
+		<Item ID="0x3993" color="2" />
+		<Item ID="0x3994" color="2" />
+		<Item ID="0x3995" color="2" />
+		<Item ID="0x3996" color="2" />
+		<Item ID="0x3997" color="2" />
+		<Item ID="0x3998" color="2" />
+		<Item ID="0x3999" color="2" />
+		<Item ID="0x399A" color="2" />
+		<Item ID="0x399B" color="2" />
+		<Item ID="0x399C" color="2" />
+		<Item ID="0x399D" color="2" />
+		<Item ID="0x399E" color="2" />
+		<Item ID="0x399F" color="2" />
+
+		<Item ID="0x088C" color="5" />
+		<Item ID="0x0FAC" color="4" />
+		<Item ID="0x0FB1" color="8" />
+		<Item ID="0x1647" color="7" />
+		<Item ID="0x19BB" color="14" />
+		<Item ID="0x1F2B" color="14" />
+
+		<Item ID="0x1ECD" color="13" />
+		<Item ID="0x1ECE" color="13" />
+		<Item ID="0x1ECF" color="13" />
+		<Item ID="0x1ED0" color="13" />
+		<Item ID="0x1ED1" color="13" />
+		<Item ID="0x1ED2" color="13" />
+
+		<Item ID="0x19AB" color="8" />
+		<Item ID="0x19AC" color="8" />
+		<Item ID="0x19AD" color="8" />
+		<Item ID="0x19AE" color="8" />
+		<Item ID="0x19AF" color="8" />
+		<Item ID="0x19B0" color="8" />
+		<Item ID="0x19B1" color="8" />
+		<Item ID="0x19B2" color="8" />
+		<Item ID="0x19B3" color="8" />
+		<Item ID="0x19B4" color="8" />
+		<Item ID="0x19B5" color="8" />
+		<Item ID="0x19B6" color="8" />
+
+		<Item ID="0x197A" color="8" />
+		<Item ID="0x197B" color="8" />
+		<Item ID="0x197C" color="8" />
+		<Item ID="0x197D" color="8" />
+		<Item ID="0x197E" color="8" />
+		<Item ID="0x197F" color="8" />
+		<Item ID="0x1980" color="8" />
+		<Item ID="0x1981" color="8" />
+		<Item ID="0x1982" color="8" />
+		<Item ID="0x1983" color="8" />
+		<Item ID="0x1984" color="8" />
+		<Item ID="0x1985" color="8" />
+		<Item ID="0x1986" color="8" />
+		<Item ID="0x1987" color="8" />
+		<Item ID="0x1988" color="8" />
+		<Item ID="0x1989" color="8" />
+		<Item ID="0x198A" color="8" />
+		<Item ID="0x198B" color="8" />
+		<Item ID="0x198C" color="8" />
+		<Item ID="0x198D" color="8" />
+		<Item ID="0x198E" color="8" />
+		<Item ID="0x198F" color="8" />
+		<Item ID="0x1990" color="8" />
+		<Item ID="0x1991" color="8" />
+		<Item ID="0x1992" color="8" />
+		<Item ID="0x1993" color="8" />
+		<Item ID="0x1994" color="8" />
+		<Item ID="0x1995" color="8" />
+		<Item ID="0x1996" color="8" />
+		<Item ID="0x1997" color="8" />
+		<Item ID="0x1998" color="8" />
+		<Item ID="0x1999" color="8" />
+		<Item ID="0x199A" color="8" />
+		<Item ID="0x199B" color="8" />
+		<Item ID="0x199C" color="8" />
+		<Item ID="0x199D" color="8" />
+		<Item ID="0x199E" color="8" />
+		<Item ID="0x199F" color="8" />
+		<Item ID="0x19A0" color="8" />
+		<Item ID="0x19A1" color="8" />
+		<Item ID="0x19A2" color="8" />
+		<Item ID="0x19A3" color="8" />
+		<Item ID="0x19A4" color="8" />
+		<Item ID="0x19A5" color="8" />
+		<Item ID="0x19A6" color="8" />
+		<Item ID="0x19A7" color="8" />
+		<Item ID="0x19A8" color="8" />
+		<Item ID="0x19A9" color="8" />
+
+		<Item ID="0x1853" color="7" />
+		<Item ID="0x1854" color="7" />
+		<Item ID="0x1855" color="7" />
+		<Item ID="0x1856" color="7" />
+		<Item ID="0x1857" color="7" />
+		<Item ID="0x1858" color="7" />
+		<Item ID="0x1859" color="7" />
+		<Item ID="0x185A" color="7" />
+
+		<Item ID="0x1849" color="7" />
+		<Item ID="0x184A" color="7" />
+		<Item ID="0x184B" color="7" />
+		<Item ID="0x184C" color="7" />
+		<Item ID="0x184D" color="7" />
+		<Item ID="0x184E" color="7" />
+		<Item ID="0x184F" color="7" />
+		<Item ID="0x1850" color="7" />
+
+		<Item ID="0x0DE1" color="5" />
+		<Item ID="0x0DE2" color="5" />
+		<Item ID="0x0DE3" color="5" />
+		<Item ID="0x0DE4" color="5" />
+		<Item ID="0x0DE5" color="5" />
+		<Item ID="0x0DE6" color="5" />
+		<Item ID="0x0DE7" color="5" />
+		<Item ID="0x0DE8" color="5" />
+		<Item ID="0x0DE9" color="5" />
+		<Item ID="0x0DEA" color="5" />
+
+
+		<Item ID="0x0B26" color="2" />
+		<Item ID="0x0B27" color="2" />
+		<Item ID="0x0B28" color="2" />
+		<Item ID="0x0B20" color="2" />
+		<Item ID="0x0B21" color="2" />
+		<Item ID="0x0B22" color="2" />
+		<Item ID="0x0B23" color="2" />
+		<Item ID="0x0B24" color="2" />
+		<Item ID="0x0B25" color="2" />
+		<Item ID="0x0B1A" color="2" />
+		<Item ID="0x0B1B" color="2" />
+		<Item ID="0x0B1C" color="2" />
+		<Item ID="0x0B1D" color="2" />
+		<Item ID="0x0B1E" color="2" />
+		<Item ID="0x0B1F" color="2" />
+
+		<Item ID="0x0A15" color="2" />
+		<Item ID="0x0A16" color="2" />
+		<Item ID="0x0A17" color="2" />
+		<Item ID="0x0A18" color="2" />
+		<Item ID="0x0A19" color="2" />
+		<Item ID="0x0A1A" color="2" />
+		<Item ID="0x0A1B" color="2" />
+		<Item ID="0x0A1C" color="2" />
+		<Item ID="0x0A1D" color="2" />
+		<Item ID="0x0A1E" color="2" />
+		<Item ID="0x0A1F" color="2" />
+		<Item ID="0x0A20" color="2" />
+		<Item ID="0x0A21" color="2" />
+		<Item ID="0x0A22" color="2" />
+		<Item ID="0x0A23" color="2" />
+		<Item ID="0x0A24" color="2" />
+		<Item ID="0x0A25" color="2" />
+		<Item ID="0x0A26" color="2" />
+		<Item ID="0x0A27" color="2" />
+		<Item ID="0x0A28" color="2" />
+		<Item ID="0x0A29" color="2" />
+
+		<Item ID="0x09FB" color="4" />
+		<Item ID="0x09FC" color="4" />
+		<Item ID="0x09FD" color="4" />
+		<Item ID="0x09FE" color="4" />
+		<Item ID="0x09FF" color="4" />
+		<Item ID="0x0A00" color="4" />
+		<Item ID="0x0A01" color="4" />
+		<Item ID="0x0A02" color="4" />
+		<Item ID="0x0A03" color="4" />
+		<Item ID="0x0A04" color="4" />
+		<Item ID="0x0A05" color="4" />
+		<Item ID="0x0A06" color="4" />
+		<Item ID="0x0A07" color="4" />
+		<Item ID="0x0A08" color="4" />
+		<Item ID="0x0A09" color="4" />
+		<Item ID="0x0A0A" color="4" />
+		<Item ID="0x0A0B" color="4" />
+		<Item ID="0x0A0C" color="4" />
+		<Item ID="0x0A0D" color="4" />
+		<Item ID="0x0A0E" color="4" />
+		<Item ID="0x0A0F" color="4" />
+		<Item ID="0x0A10" color="4" />
+		<Item ID="0x0A11" color="4" />
+		<Item ID="0x0A12" color="4" />
+		<Item ID="0x0A13" color="4" />
+		<Item ID="0x0A14" color="4" />
+
+		<Item ID="0x1FD4" color="9" />
+		<Item ID="0x0F6C" color="9" />
+
+		<Item ID="0x40FE" color="14" />
+		<Item ID="0x40FF" color="10" />
+		<Item ID="0x4100" color="12" />
+		<Item ID="0x4101" color="15" />
+
+		<Item ID="0x3E27" color="5" />
+		<Item ID="0x3E28" color="5" />
+		<Item ID="0x3E29" color="5" />
+		<Item ID="0x3E2A" color="5" />
+		<Item ID="0x3E2B" color="5" />
+		<Item ID="0x3E2C" color="5" />
+		<Item ID="0x3E2D" color="5" />
+		<Item ID="0x3E2E" color="5" />
+		<Item ID="0x3E2F" color="5" />
+		<Item ID="0x3E30" color="5" />
+		<Item ID="0x3E31" color="5" />
+		<Item ID="0x3E32" color="5" />
+		<Item ID="0x3E33" color="5" />
+		<Item ID="0x3E34" color="5" />
+		<Item ID="0x3E35" color="5" />
+		<Item ID="0x3E36" color="5" />
+		<Item ID="0x3E37" color="5" />
+		<Item ID="0x3E38" color="5" />
+		<Item ID="0x3E39" color="5" />
+		<Item ID="0x3E3A" color="5" />
+
+		<Item ID="0x3E02" color="13" />
+		<Item ID="0x3E03" color="13" />
+		<Item ID="0x3E04" color="13" />
+		<Item ID="0x3E05" color="13" />
+		<Item ID="0x3E06" color="13" />
+		<Item ID="0x3E07" color="13" />
+		<Item ID="0x3E08" color="13" />
+		<Item ID="0x3E09" color="13" />
+		<Item ID="0x3E0A" color="13" />
+		<Item ID="0x3E0B" color="13" />
+
+		<Item ID="0x398C" color="5" />
+		<Item ID="0x398D" color="5" />
+		<Item ID="0x398E" color="5" />
+		<Item ID="0x398F" color="5" />
+		<Item ID="0x3990" color="5" />
+		<Item ID="0x3991" color="5" />
+		<Item ID="0x3992" color="5" />
+		<Item ID="0x3993" color="5" />
+		<Item ID="0x3994" color="5" />
+		<Item ID="0x3995" color="5" />
+		<Item ID="0x3996" color="5" />
+		<Item ID="0x3997" color="5" />
+		<Item ID="0x3998" color="5" />
+		<Item ID="0x3999" color="5" />
+		<Item ID="0x399A" color="5" />
+		<Item ID="0x399B" color="5" />
+		<Item ID="0x399C" color="5" />
+		<Item ID="0x399D" color="5" />
+		<Item ID="0x399E" color="5" />
+		<Item ID="0x399F" color="5" />
+
+		<Item ID="0x3967" color="11" />
+		<Item ID="0x3968" color="11" />
+		<Item ID="0x3969" color="11" />
+		<Item ID="0x396A" color="11" />
+		<Item ID="0x396B" color="11" />
+		<Item ID="0x396C" color="11" />
+		<Item ID="0x396D" color="11" />
+		<Item ID="0x396E" color="11" />
+		<Item ID="0x396F" color="11" />
+		<Item ID="0x3970" color="11" />
+		<Item ID="0x3971" color="11" />
+		<Item ID="0x3972" color="11" />
+		<Item ID="0x3973" color="11" />
+		<Item ID="0x3974" color="11" />
+		<Item ID="0x3975" color="11" />
+		<Item ID="0x3976" color="11" />
+		<Item ID="0x3977" color="11" />
+		<Item ID="0x3978" color="11" />
+		<Item ID="0x3979" color="11" />
+		<Item ID="0x397A" color="11" />
+
+		<Item ID="0x3946" color="11" />
+		<Item ID="0x3947" color="11" />
+		<Item ID="0x3948" color="11" />
+		<Item ID="0x3949" color="11" />
+		<Item ID="0x394A" color="11" />
+		<Item ID="0x394B" color="11" />
+		<Item ID="0x394C" color="11" />
+		<Item ID="0x394D" color="11" />
+		<Item ID="0x394E" color="11" />
+		<Item ID="0x394F" color="11" />
+		<Item ID="0x3950" color="11" />
+		<Item ID="0x3951" color="11" />
+		<Item ID="0x3952" color="11" />
+		<Item ID="0x3953" color="11" />
+		<Item ID="0x3954" color="11" />
+		<Item ID="0x3955" color="11" />
+		<Item ID="0x3956" color="11" />
+		<Item ID="0x3957" color="11" />
+		<Item ID="0x3958" color="11" />
+		<Item ID="0x3959" color="11" />
+		<Item ID="0x395A" color="11" />
+		<Item ID="0x395B" color="11" />
+		<Item ID="0x395C" color="11" />
+		<Item ID="0x395D" color="11" />
+		<Item ID="0x395E" color="11" />
+		<Item ID="0x395F" color="11" />
+		<Item ID="0x3960" color="11" />
+		<Item ID="0x3961" color="11" />
+		<Item ID="0x3962" color="11" />
+		<Item ID="0x3963" color="11" />
+		<Item ID="0x3964" color="11" />
+
+		<Item ID="0x3914" color="13" />
+		<Item ID="0x3915" color="13" />
+		<Item ID="0x3916" color="13" />
+		<Item ID="0x3917" color="13" />
+		<Item ID="0x3918" color="13" />
+		<Item ID="0x3919" color="13" />
+		<Item ID="0x391A" color="13" />
+		<Item ID="0x391B" color="13" />
+		<Item ID="0x391C" color="13" />
+		<Item ID="0x391D" color="13" />
+		<Item ID="0x391E" color="13" />
+		<Item ID="0x391F" color="13" />
+		<Item ID="0x3920" color="13" />
+		<Item ID="0x3921" color="13" />
+		<Item ID="0x3922" color="13" />
+		<Item ID="0x3923" color="13" />
+		<Item ID="0x3924" color="13" />
+		<Item ID="0x3925" color="13" />
+		<Item ID="0x3926" color="13" />
+		<Item ID="0x3927" color="13" />
+		<Item ID="0x3928" color="13" />
+		<Item ID="0x3929" color="13" />
+
+		<Item ID="0x3547" color="5" />
+		<Item ID="0x3548" color="5" />
+		<Item ID="0x3549" color="5" />
+		<Item ID="0x354A" color="5" />
+		<Item ID="0x354B" color="5" />
+		<Item ID="0x354C" color="5" />
+
+		<Item ID="0x343B" color="5" />
+		<Item ID="0x343C" color="5" />
+		<Item ID="0x343D" color="5" />
+		<Item ID="0x343E" color="5" />
+		<Item ID="0x343F" color="5" />
+		<Item ID="0x3440" color="5" />
+		<Item ID="0x3441" color="5" />
+		<Item ID="0x3442" color="5" />
+		<Item ID="0x3443" color="5" />
+		<Item ID="0x3444" color="5" />
+		<Item ID="0x3445" color="5" />
+		<Item ID="0x3446" color="5" />
+		<Item ID="0x3447" color="5" />
+		<Item ID="0x3448" color="5" />
+		<Item ID="0x3449" color="5" />
+		<Item ID="0x344A" color="5" />
+		<Item ID="0x344B" color="5" />
+		<Item ID="0x344C" color="5" />
+		<Item ID="0x344D" color="5" />
+		<Item ID="0x344E" color="5" />
+		<Item ID="0x344F" color="5" />
+		<Item ID="0x3450" color="5" />
+		<Item ID="0x3451" color="5" />
+		<Item ID="0x3452" color="5" />
+		<Item ID="0x3453" color="5" />
+		<Item ID="0x3454" color="5" />
+		<Item ID="0x3455" color="5" />
+		<Item ID="0x3456" color="5" />
+		<Item ID="0x3457" color="5" />
+		<Item ID="0x3458" color="5" />
+		<Item ID="0x3459" color="5" />
+		<Item ID="0x345A" color="5" />
+		<Item ID="0x345B" color="5" />
+		<Item ID="0x345C" color="5" />
+		<Item ID="0x345D" color="5" />
+		<Item ID="0x345E" color="5" />
+		<Item ID="0x345F" color="5" />
+		<Item ID="0x3460" color="5" />
+		<Item ID="0x3461" color="5" />
+		<Item ID="0x3462" color="5" />
+		<Item ID="0x3463" color="5" />
+		<Item ID="0x3464" color="5" />
+		<Item ID="0x3465" color="5" />
+		<Item ID="0x3466" color="5" />
+		<Item ID="0x3467" color="5" />
+		<Item ID="0x3468" color="5" />
+		<Item ID="0x3469" color="5" />
+		<Item ID="0x346A" color="5" />
+		<Item ID="0x346B" color="5" />
+		<Item ID="0x346C" color="5" />
+
+		<Item ID="0x306A" color="5" />
+		<Item ID="0x306B" color="5" />
+		<Item ID="0x306C" color="5" />
+		<Item ID="0x306D" color="5" />
+		<Item ID="0x306E" color="5" />
+		<Item ID="0x306F" color="5" />
+		<Item ID="0x3070" color="5" />
+		<Item ID="0x3071" color="5" />
+		<Item ID="0x3072" color="5" />
+		<Item ID="0x3073" color="5" />
+		<Item ID="0x3074" color="5" />
+		<Item ID="0x3075" color="5" />
+		<Item ID="0x3076" color="5" />
+		<Item ID="0x3077" color="5" />
+		<Item ID="0x3078" color="5" />
+		<Item ID="0x3079" color="5" />
+		<Item ID="0x307A" color="5" />
+		<Item ID="0x307B" color="5" />
+		<Item ID="0x307C" color="5" />
+		<Item ID="0x307D" color="5" />
+		<Item ID="0x307E" color="5" />
+		<Item ID="0x307F" color="5" />
+		<Item ID="0x3080" color="5" />
+		<Item ID="0x3081" color="5" />
+		<Item ID="0x3082" color="5" />
+		<Item ID="0x3083" color="5" />
+		<Item ID="0x3084" color="5" />
+		<Item ID="0x3085" color="5" />
+		<Item ID="0x3086" color="5" />
+		<Item ID="0x3087" color="5" />
+		<Item ID="0x3088" color="5" />
+		<Item ID="0x3089" color="5" />
+		<Item ID="0x308A" color="5" />
+		<Item ID="0x308B" color="5" />
+		<Item ID="0x308C" color="5" />
+		<Item ID="0x308D" color="5" />
+		<Item ID="0x308E" color="5" />
+		<Item ID="0x308F" color="5" />
+		<Item ID="0x3090" color="5" />
+		<Item ID="0x3091" color="5" />
+		<Item ID="0x3092" color="5" />
+		<Item ID="0x3093" color="5" />
+		<Item ID="0x3094" color="5" />
+		<Item ID="0x3095" color="5" />
+		<Item ID="0x3096" color="5" />
+		<Item ID="0x3097" color="5" />
+		<Item ID="0x3098" color="5" />
+		<Item ID="0x3099" color="5" />
+		<Item ID="0x309A" color="5" />
+		<Item ID="0x309B" color="5" />
+		<Item ID="0x309C" color="5" />
+		<Item ID="0x309D" color="5" />
+		<Item ID="0x309E" color="5" />
+		<Item ID="0x309F" color="5" />
+		<Item ID="0x30A0" color="5" />
+		<Item ID="0x30A1" color="5" />
+		<Item ID="0x30A2" color="5" />
+		<Item ID="0x30A3" color="5" />
+		<Item ID="0x30A4" color="5" />
+		<Item ID="0x30A5" color="5" />
+		<Item ID="0x30A6" color="5" />
+		<Item ID="0x30A7" color="5" />
+		<Item ID="0x30A8" color="5" />
+		<Item ID="0x30A9" color="5" />
+		<Item ID="0x30AA" color="5" />
+		<Item ID="0x30AB" color="5" />
+		<Item ID="0x30AC" color="5" />
+		<Item ID="0x30AD" color="5" />
+		<Item ID="0x30AE" color="5" />
+		<Item ID="0x30AF" color="5" />
+		<Item ID="0x30B0" color="5" />
+		<Item ID="0x30B1" color="5" />
+		<Item ID="0x30B2" color="5" />
+		<Item ID="0x30B3" color="5" />
+		<Item ID="0x30B4" color="5" />
+		<Item ID="0x30B5" color="5" />
+		<Item ID="0x30B6" color="5" />
+		<Item ID="0x30B7" color="5" />
+		<Item ID="0x30B8" color="5" />
+		<Item ID="0x30B9" color="5" />
+		<Item ID="0x30BA" color="5" />
+		<Item ID="0x30BB" color="5" />
+		<Item ID="0x30BC" color="5" />
+		<Item ID="0x30BD" color="5" />
+		<Item ID="0x30BE" color="5" />
+		<Item ID="0x30BF" color="5" />
+		<Item ID="0x30C0" color="5" />
+		<Item ID="0x30C1" color="5" />
+		<Item ID="0x30C2" color="5" />
+		<Item ID="0x30C3" color="5" />
+		<Item ID="0x30C4" color="5" />
+		<Item ID="0x30C5" color="5" />
+		<Item ID="0x30C6" color="5" />
+		<Item ID="0x30C7" color="5" />
+		<Item ID="0x30C8" color="5" />
+		<Item ID="0x30C9" color="5" />
+		<Item ID="0x30CA" color="5" />
+		<Item ID="0x30CB" color="5" />
+		<Item ID="0x30CC" color="5" />
+		<Item ID="0x30CD" color="5" />
+		<Item ID="0x30CE" color="5" />
+		<Item ID="0x30CF" color="5" />
+		<Item ID="0x30D0" color="5" />
+		<Item ID="0x30D1" color="5" />
+		<Item ID="0x30D2" color="5" />
+		<Item ID="0x30D3" color="5" />
+		<Item ID="0x30D4" color="5" />
+		<Item ID="0x30D5" color="5" />
+		<Item ID="0x30D6" color="5" />
+		<Item ID="0x30D7" color="5" />
+		<Item ID="0x30D8" color="5" />
+		<Item ID="0x30D9" color="5" />
+		<Item ID="0x30DA" color="5" />
+		<Item ID="0x30DB" color="5" />
+		<Item ID="0x30DC" color="5" />
+		<Item ID="0x30DD" color="5" />
+		<Item ID="0x30DE" color="5" />
+		<Item ID="0x30DF" color="5" />
+		<Item ID="0x30E0" color="5" />
+		<Item ID="0x30E1" color="5" />
+		<Item ID="0x30E2" color="5" />
+		<Item ID="0x30E3" color="5" />
+		<Item ID="0x30E4" color="5" />
+		<Item ID="0x30E5" color="5" />
+		<Item ID="0x30E6" color="5" />
+		<Item ID="0x30E7" color="5" />
+		<Item ID="0x30E8" color="5" />
+		<Item ID="0x30E9" color="5" />
+		<Item ID="0x30EA" color="5" />
+		<Item ID="0x30EB" color="5" />
+		<Item ID="0x30EC" color="5" />
+		<Item ID="0x30ED" color="5" />
+		<Item ID="0x30EE" color="5" />
+		<Item ID="0x30EF" color="5" />
+		<Item ID="0x30F0" color="5" />
+		<Item ID="0x30F1" color="5" />
+		<Item ID="0x30F2" color="5" />
+		<Item ID="0x30F3" color="5" />
+		<Item ID="0x30F4" color="5" />
+		<Item ID="0x30F5" color="5" />
+		<Item ID="0x30F6" color="5" />
+		<Item ID="0x30F7" color="5" />
+		<Item ID="0x30F8" color="5" />
+		<Item ID="0x30F9" color="5" />
+		<Item ID="0x30FA" color="5" />
+		<Item ID="0x30FB" color="5" />
+		<Item ID="0x30FC" color="5" />
+		<Item ID="0x30FD" color="5" />
+		<Item ID="0x30FE" color="5" />
+		<Item ID="0x30FF" color="5" />
+		<Item ID="0x3100" color="5" />
+		<Item ID="0x3101" color="5" />
+		<Item ID="0x3102" color="5" />
+		<Item ID="0x3103" color="5" />
+		<Item ID="0x3104" color="5" />
+		<Item ID="0x3105" color="5" />
+		<Item ID="0x3106" color="5" />
+		<Item ID="0x3107" color="5" />
+		<Item ID="0x3108" color="5" />
+		<Item ID="0x3109" color="5" />
+		<Item ID="0x310A" color="5" />
+		<Item ID="0x310B" color="5" />
+		<Item ID="0x310C" color="5" />
+		<Item ID="0x310D" color="5" />
+		<Item ID="0x310E" color="5" />
+		<Item ID="0x310F" color="5" />
+		<Item ID="0x3110" color="5" />
+		<Item ID="0x3111" color="5" />
+		<Item ID="0x3112" color="5" />
+		<Item ID="0x3113" color="5" />
+		<Item ID="0x3114" color="5" />
+		<Item ID="0x3115" color="5" />
+		<Item ID="0x3116" color="5" />
+		<Item ID="0x3117" color="5" />
+		<Item ID="0x3118" color="5" />
+		<Item ID="0x3119" color="5" />
+		<Item ID="0x311A" color="5" />
+		<Item ID="0x311B" color="5" />
+		<Item ID="0x311C" color="5" />
+		<Item ID="0x311D" color="5" />
+		<Item ID="0x311E" color="5" />
+		<Item ID="0x311F" color="5" />
+		<Item ID="0x3120" color="5" />
+		<Item ID="0x3121" color="5" />
+		<Item ID="0x3122" color="5" />
+		<Item ID="0x3123" color="5" />
+		<Item ID="0x3124" color="5" />
+		<Item ID="0x3127" color="5" />
+		<Item ID="0x3128" color="5" />
+		<Item ID="0x3129" color="5" />
+		<Item ID="0x312A" color="5" />
+		<Item ID="0x312D" color="5" />
+		<Item ID="0x312E" color="5" />
+		<Item ID="0x312F" color="5" />
+		<Item ID="0x3130" color="5" />
+		<Item ID="0x314C" color="5" />
+		<Item ID="0x314D" color="5" />
+		<Item ID="0x314E" color="5" />
+		<Item ID="0x314F" color="5" />
+		<Item ID="0x3150" color="5" />
+		<Item ID="0x3151" color="5" />
+		<Item ID="0x3152" color="5" />
+		<Item ID="0x3153" color="5" />
+		<Item ID="0x3154" color="5" />
+		<Item ID="0x3155" color="5" />
+		<Item ID="0x3156" color="5" />
+		<Item ID="0x3157" color="5" />
+		<Item ID="0x3158" color="5" />
+		<Item ID="0x3159" color="5" />
+		<Item ID="0x315A" color="5" />
+		<Item ID="0x315B" color="5" />
+		<Item ID="0x315C" color="5" />
+		<Item ID="0x315D" color="5" />
+		<Item ID="0x315E" color="5" />
+		<Item ID="0x315F" color="5" />
+		<Item ID="0x3160" color="5" />
+		<Item ID="0x3161" color="5" />
+		<Item ID="0x3162" color="5" />
+		<Item ID="0x3163" color="5" />
+		<Item ID="0x3164" color="5" />
+		<Item ID="0x3165" color="5" />
+		<Item ID="0x3166" color="5" />
+		<Item ID="0x3167" color="5" />
+		<Item ID="0x3168" color="5" />
+		<Item ID="0x3169" color="5" />
+		<Item ID="0x316A" color="5" />
+		<Item ID="0x316B" color="5" />
+		<Item ID="0x316C" color="5" />
+		<Item ID="0x316D" color="5" />
+		<Item ID="0x316E" color="5" />
+		<Item ID="0x316F" color="5" />
+		<Item ID="0x3170" color="5" />
+		<Item ID="0x3171" color="5" />
+		<Item ID="0x3172" color="5" />
+		<Item ID="0x3173" color="5" />
+		<Item ID="0x3174" color="5" />
+		<Item ID="0x3175" color="5" />
+		<Item ID="0x3176" color="5" />
+		<Item ID="0x3177" color="5" />
+		<Item ID="0x3178" color="5" />
+		<Item ID="0x3179" color="5" />
+		<Item ID="0x317A" color="5" />
+		<Item ID="0x317B" color="5" />
+		<Item ID="0x317C" color="5" />
+		<Item ID="0x317D" color="5" />
+		<Item ID="0x317E" color="5" />
+		<Item ID="0x317F" color="5" />
+		<Item ID="0x3180" color="5" />
+		<Item ID="0x3181" color="5" />
+		<Item ID="0x3183" color="5" />
+		<Item ID="0x3184" color="5" />
+		<Item ID="0x3185" color="5" />
+		<Item ID="0x3186" color="5" />
+		<Item ID="0x3187" color="5" />
+		<Item ID="0x3188" color="5" />
+		<Item ID="0x3189" color="5" />
+		<Item ID="0x318A" color="5" />
+		<Item ID="0x318B" color="5" />
+		<Item ID="0x318C" color="5" />
+		<Item ID="0x318D" color="5" />
+		<Item ID="0x318E" color="5" />
+		<Item ID="0x318F" color="5" />
+		<Item ID="0x3190" color="5" />
+		<Item ID="0x3191" color="5" />
+		<Item ID="0x3192" color="5" />
+		<Item ID="0x3193" color="5" />
+		<Item ID="0x3194" color="5" />
+		<Item ID="0x3195" color="5" />
+		<Item ID="0x3196" color="5" />
+		<Item ID="0x3197" color="5" />
+		<Item ID="0x3198" color="5" />
+		<Item ID="0x3199" color="5" />
+		<Item ID="0x319A" color="5" />
+		<Item ID="0x319B" color="5" />
+		<Item ID="0x319C" color="5" />
+		<Item ID="0x319D" color="5" />
+		<Item ID="0x319E" color="5" />
+		<Item ID="0x319F" color="5" />
+		<Item ID="0x31A0" color="5" />
+		<Item ID="0x31A1" color="5" />
+		<Item ID="0x31A2" color="5" />
+		<Item ID="0x31A3" color="5" />
+		<Item ID="0x31A4" color="5" />
+		<Item ID="0x31A5" color="5" />
+		<Item ID="0x31A6" color="5" />
+		<Item ID="0x31A7" color="5" />
+		<Item ID="0x31A8" color="5" />
+		<Item ID="0x31A9" color="5" />
+		<Item ID="0x31AA" color="5" />
+		<Item ID="0x31AB" color="5" />
+		<Item ID="0x31AC" color="5" />
+		<Item ID="0x31AD" color="5" />
+		<Item ID="0x31AE" color="5" />
+		<Item ID="0x31AF" color="5" />
+		<Item ID="0x31F4" color="5" />
+		<Item ID="0x31F5" color="5" />
+		<Item ID="0x31F6" color="5" />
+		<Item ID="0x31F7" color="5" />
+		<Item ID="0x31F8" color="5" />
+		<Item ID="0x31F9" color="5" />
+		<Item ID="0x31FA" color="5" />
+		<Item ID="0x31FB" color="5" />
+		<Item ID="0x3209" color="5" />
+		<Item ID="0x320A" color="5" />
+		<Item ID="0x320D" color="5" />
+		<Item ID="0x320E" color="5" />
+		<Item ID="0x320F" color="5" />
+		<Item ID="0x3210" color="5" />
+		<Item ID="0x3211" color="5" />
+		<Item ID="0x3213" color="5" />
+		<Item ID="0x3214" color="5" />
+		<Item ID="0x3215" color="5" />
+		<Item ID="0x3216" color="5" />
+		<Item ID="0x3217" color="5" />
+		<Item ID="0x3218" color="5" />
+		<Item ID="0x321A" color="5" />
+		<Item ID="0x321B" color="5" />
+		<Item ID="0x321C" color="5" />
+		<Item ID="0x321D" color="5" />
+		<Item ID="0x321E" color="5" />
+		<Item ID="0x3220" color="5" />
+		<Item ID="0x3221" color="5" />
+		<Item ID="0x3222" color="5" />
+		<Item ID="0x3223" color="5" />
+		<Item ID="0x3224" color="5" />
+		<Item ID="0x3226" color="5" />
+		<Item ID="0x3227" color="5" />
+		<Item ID="0x3228" color="5" />
+		<Item ID="0x3229" color="5" />
+		<Item ID="0x322A" color="5" />
+		<Item ID="0x322C" color="5" />
+		<Item ID="0x322D" color="5" />
+		<Item ID="0x322E" color="5" />
+		<Item ID="0x322F" color="5" />
+		<Item ID="0x3230" color="5" />
+		<Item ID="0x3231" color="5" />
+		<Item ID="0x3232" color="5" />
+		<Item ID="0x3233" color="5" />
+		<Item ID="0x3234" color="5" />
+		<Item ID="0x3236" color="5" />
+		<Item ID="0x3237" color="5" />
+		<Item ID="0x3238" color="5" />
+		<Item ID="0x3239" color="5" />
+		<Item ID="0x323A" color="5" />
+		<Item ID="0x323B" color="5" />
+		<Item ID="0x323C" color="5" />
+		<Item ID="0x323D" color="5" />
+		<Item ID="0x323E" color="5" />
+		<Item ID="0x323F" color="5" />
+		<Item ID="0x3241" color="5" />
+		<Item ID="0x3242" color="5" />
+		<Item ID="0x3243" color="5" />
+		<Item ID="0x3244" color="5" />
+		<Item ID="0x3245" color="5" />
+		<Item ID="0x3246" color="5" />
+		<Item ID="0x3247" color="5" />
+		<Item ID="0x3248" color="5" />
+		<Item ID="0x3249" color="5" />
+		<Item ID="0x324A" color="5" />
+		<Item ID="0x324B" color="5" />
+		<Item ID="0x324C" color="5" />
+		<Item ID="0x324D" color="5" />
+		<Item ID="0x324E" color="5" />
+		<Item ID="0x324F" color="5" />
+		<Item ID="0x3250" color="5" />
+		<Item ID="0x3251" color="5" />
+		<Item ID="0x3252" color="5" />
+		<Item ID="0x3253" color="5" />
+		<Item ID="0x3254" color="5" />
+		<Item ID="0x3255" color="5" />
+		<Item ID="0x3256" color="5" />
+		<Item ID="0x3257" color="5" />
+		<Item ID="0x3258" color="5" />
+		<Item ID="0x3259" color="5" />
+		<Item ID="0x325A" color="5" />
+		<Item ID="0x325B" color="5" />
+		<Item ID="0x325C" color="5" />
+		<Item ID="0x325D" color="5" />
+		<Item ID="0x325E" color="5" />
+		<Item ID="0x325F" color="5" />
+		<Item ID="0x3260" color="5" />
+		<Item ID="0x3261" color="5" />
+		<Item ID="0x3262" color="5" />
+		<Item ID="0x3263" color="5" />
+		<Item ID="0x3264" color="5" />
+		<Item ID="0x3265" color="5" />
+		<Item ID="0x3266" color="5" />
+		<Item ID="0x3267" color="5" />
+		<Item ID="0x3268" color="5" />
+		<Item ID="0x3269" color="5" />
+		<Item ID="0x326A" color="5" />
+		<Item ID="0x326B" color="5" />
+		<Item ID="0x326C" color="5" />
+		<Item ID="0x326D" color="5" />
+		<Item ID="0x326E" color="5" />
+		<Item ID="0x326F" color="5" />
+		<Item ID="0x3270" color="5" />
+		<Item ID="0x3271" color="5" />
+		<Item ID="0x3272" color="5" />
+		<Item ID="0x3273" color="5" />
+		<Item ID="0x3274" color="5" />
+		<Item ID="0x3275" color="5" />
+		<Item ID="0x3276" color="5" />
+		<Item ID="0x3277" color="5" />
+		<Item ID="0x3278" color="5" />
+		<Item ID="0x3279" color="5" />
+		<Item ID="0x327A" color="5" />
+		<Item ID="0x327B" color="5" />
+		<Item ID="0x327C" color="5" />
+		<Item ID="0x327D" color="5" />
+		<Item ID="0x327E" color="5" />
+		<Item ID="0x327F" color="5" />
+		<Item ID="0x3280" color="5" />
+		<Item ID="0x3281" color="5" />
+		<Item ID="0x3282" color="5" />
+		<Item ID="0x3283" color="5" />
+		<Item ID="0x3284" color="5" />
+		<Item ID="0x3285" color="5" />
+		<Item ID="0x3286" color="5" />
+		<Item ID="0x3287" color="5" />
+		<Item ID="0x3288" color="5" />
+		<Item ID="0x3289" color="5" />
+		<Item ID="0x328A" color="5" />
+		<Item ID="0x328B" color="5" />
+		<Item ID="0x328C" color="5" />
+		<Item ID="0x328D" color="5" />
+		<Item ID="0x328E" color="5" />
+		<Item ID="0x328F" color="5" />
+		<Item ID="0x3290" color="5" />
+		<Item ID="0x3291" color="5" />
+		<Item ID="0x3292" color="5" />
+		<Item ID="0x3293" color="5" />
+		<Item ID="0x3294" color="5" />
+		<Item ID="0x3295" color="5" />
+		<Item ID="0x3296" color="5" />
+		<Item ID="0x3297" color="5" />
+		<Item ID="0x3298" color="5" />
+		<Item ID="0x3299" color="5" />
+		<Item ID="0x329A" color="5" />
+		<Item ID="0x329B" color="5" />
+
+		<Item ID="0x12EE" color="5" />
+		<Item ID="0x12EF" color="5" />
+		<Item ID="0x12F0" color="5" />
+		<Item ID="0x12F1" color="5" />
+		<Item ID="0x12F2" color="5" />
+		<Item ID="0x12F4" color="5" />
+		<Item ID="0x12F5" color="5" />
+		<Item ID="0x12F6" color="5" />
+		<Item ID="0x12F7" color="5" />
+		<Item ID="0x12F8" color="5" />
+		<Item ID="0x12F9" color="5" />
+		<Item ID="0x12FA" color="5" />
+		<Item ID="0x12FB" color="5" />
+		<Item ID="0x12FC" color="5" />
+		<Item ID="0x12FD" color="5" />
+		<Item ID="0x12FE" color="5" />
+		<Item ID="0x1300" color="5" />
+		<Item ID="0x1301" color="5" />
+		<Item ID="0x1302" color="5" />
+		<Item ID="0x1303" color="5" />
+		<Item ID="0x1304" color="5" />
+		<Item ID="0x1306" color="5" />
+		<Item ID="0x1307" color="5" />
+		<Item ID="0x1308" color="5" />
+		<Item ID="0x1309" color="5" />
+		<Item ID="0x130A" color="5" />
+		<Item ID="0x130C" color="5" />
+		<Item ID="0x130D" color="5" />
+		<Item ID="0x130E" color="5" />
+		<Item ID="0x130F" color="5" />
+		<Item ID="0x1310" color="5" />
+		<Item ID="0x1312" color="5" />
+		<Item ID="0x1313" color="5" />
+		<Item ID="0x1314" color="5" />
+		<Item ID="0x1315" color="5" />
+		<Item ID="0x1316" color="5" />
+		<Item ID="0x1318" color="5" />
+		<Item ID="0x1319" color="5" />
+		<Item ID="0x131A" color="5" />
+		<Item ID="0x131B" color="5" />
+		<Item ID="0x131C" color="5" />
+		<Item ID="0x131E" color="5" />
+		<Item ID="0x131F" color="5" />
+		<Item ID="0x1320" color="5" />
+		<Item ID="0x1321" color="5" />
+		<Item ID="0x1322" color="5" />
+		<Item ID="0x1323" color="5" />
+		<Item ID="0x1324" color="5" />
+		<Item ID="0x1325" color="5" />
+		<Item ID="0x1326" color="5" />
+		<Item ID="0x1327" color="5" />
+		<Item ID="0x1328" color="5" />
+		<Item ID="0x1329" color="5" />
+		<Item ID="0x132A" color="5" />
+		<Item ID="0x132B" color="5" />
+		<Item ID="0x132C" color="5" />
+		<Item ID="0x132D" color="5" />
+		<Item ID="0x132E" color="5" />
+		<Item ID="0x132F" color="5" />
+		<Item ID="0x1330" color="5" />
+		<Item ID="0x1331" color="5" />
+		<Item ID="0x1332" color="5" />
+		<Item ID="0x1333" color="5" />
+		<Item ID="0x1334" color="5" />
+		<Item ID="0x1335" color="5" />
+		<Item ID="0x1336" color="5" />
+		<Item ID="0x1337" color="5" />
+		<Item ID="0x1338" color="5" />
+		<Item ID="0x1339" color="5" />
+		<Item ID="0x133A" color="5" />
+		<Item ID="0x133B" color="5" />
+		<Item ID="0x133C" color="5" />
+		<Item ID="0x133D" color="5" />
+		<Item ID="0x133E" color="5" />
+		<Item ID="0x133F" color="5" />
+		<Item ID="0x1340" color="5" />
+		<Item ID="0x1341" color="5" />
+		<Item ID="0x1342" color="5" />
+		<Item ID="0x1343" color="5" />
+		<Item ID="0x1344" color="5" />
+		<Item ID="0x1345" color="5" />
+		<Item ID="0x1346" color="5" />
+		<Item ID="0x1347" color="5" />
+		<Item ID="0x1348" color="5" />
+		<Item ID="0x1349" color="5" />
+		<Item ID="0x134A" color="5" />
+		<Item ID="0x134B" color="5" />
+		<Item ID="0x134C" color="5" />
+		<Item ID="0x134D" color="5" />
+
+		<Item ID="0x0E5C" color="11" />
+		<Item ID="0x0E5D" color="11" />
+		<Item ID="0x0E5E" color="11" />
+		<Item ID="0x0E5F" color="11" />
+		<Item ID="0x0E60" color="11" />
+		<Item ID="0x0E61" color="11" />
+		<Item ID="0x0E62" color="11" />
+		<Item ID="0x0E63" color="11" />
+		<Item ID="0x0E64" color="11" />
+		<Item ID="0x0E65" color="11" />
+		<Item ID="0x0E66" color="11" />
+		<Item ID="0x0E67" color="11" />
+		<Item ID="0x0E68" color="11" />
+		<Item ID="0x0E69" color="11" />
+		<Item ID="0x0E6A" color="11" />
+
+		<Item ID="0x0E31" color="14" />
+		<Item ID="0x0E32" color="14" />
+		<Item ID="0x0E33" color="14" />
+
+		<Item ID="0x0E2D" color="3" />
+		<Item ID="0x0E2E" color="3" />
+		<Item ID="0x0E2F" color="3" />
+		<Item ID="0x0E30" color="3" />
+
+
+		<!-- Original virtual sources -->
+		<Item ID="0x1646" color="2"/>
+		<Item ID="0x1647" color="2"/>
+
+	</Sources>
+	
+</ColorLight>

Client.bin/nodraw.txt

@@ -1,13 +1,13 @@
-# This file contains a list of all tiles to be ignored when the "NoDraw"
-# option is not active.
-# Lines starting with T are terrain tiles, S indicated static tiles.
-# A - between numbers indicates a range of tiles.
-
-#Terrain
-T$2
-
-#Statics
-S$1
-S$2198-$21A4
-S$21BC
-S$5690
+# This file contains a list of all tiles to be ignored when the "NoDraw"
+# option is not active.
+# Lines starting with T are terrain tiles, S indicated static tiles.
+# A - between numbers indicates a range of tiles.
+
+#Terrain
+T$2
+
+#Statics
+S$1
+S$2198-$21A4
+S$21BC
+S$5690

Client/Assets.rc

@@ -0,0 +1,5 @@
+LEFTTOPARROW		RCDATA "Overlay/LeftTopArrow.tga"
+TOPARROW			RCDATA "Overlay/TopArrow.tga"
+VIRTUALLAYER		RCDATA "Overlay/VirtualLayer.tga"
+DEJAVU				RCDATA "GLFont/DejaVu.png"
+DEJAVUDAT			RCDATA "GLFont/DejaVu.fnt"

Client/CentrED.lpi

@@ -1,379 +1,671 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="7"/>
+    <Version Value="12"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
-        <AlwaysBuild Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
-      <TargetFileExt Value=".exe"/>
       <Title Value="CentrED"/>
-      <LFMResourceType Value="res"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
       <Icon Value="0"/>
     </General>
     <LazDoc Paths="../doc"/>
     <VersionInfo>
       <UseVersionInfo Value="True"/>
-      <CurrentMajorRevNr Value="6"/>
-      <CurrentMinorRevNr Value="1"/>
-      <CurrentBuildNr Value="209"/>
-      <ProjectVersion Value="0.6.1.209"/>
-      <CompanyName Value="AKS DataBasis"/>
-      <FileDescription Value="UO CentrED"/>
-      <InternalName Value="CentrED"/>
-      <LegalCopyright Value="Andreas Schneider"/>
-      <OriginalFilename Value="CentrED.exe"/>
-      <ProductName Value="CentrED"/>
+      <AutoIncrementBuild Value="True"/>
+      <MinorVersionNr Value="7"/>
+      <BuildNr Value="263"/>
+      <StringTable CompanyName="AKS DataBasis" FileDescription="UO CentrED" InternalName="CentrED" LegalCopyright="(c) 2022 Andreas Schneider and StaticZ" OriginalFilename="CentrED.exe" ProductName="CentrED" ProductVersion="0.7.0"/>
     </VersionInfo>
+    <BuildModes Count="8">
+      <Item1 Name="default" Default="True"/>
+      <Item2 Name="Release.Win32">
+        <MacroValues Count="1">
+          <Macro1 Name="LCLWidgetType" Value="win32"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+            <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="i386"/>
+            <TargetOS Value="win32"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <UseLineInfoUnit Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+            <CustomOptions Value="-dNoLogging"/>
+          </Other>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="Release.Win64">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+            <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <TargetOS Value="win64"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <UseLineInfoUnit Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+            <CustomOptions Value="-dNoLogging"/>
+          </Other>
+        </CompilerOptions>
+      </Item3>
+      <Item4 Name="Release.Linux.x86">
+        <MacroValues Count="1">
+          <Macro2 Name="LCLWidgetType" Value="gtk2"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED.x86"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+            <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="i386"/>
+            <TargetOS Value="linux"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <UseLineInfoUnit Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+            <CustomOptions Value="-dNoLogging"/>
+          </Other>
+        </CompilerOptions>
+      </Item4>
+      <Item5 Name="Release.Linux.x64">
+        <MacroValues Count="1">
+          <Macro2 Name="LCLWidgetType" Value="gtk2"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED.x64"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+            <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <TargetOS Value="linux"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <UseLineInfoUnit Value="False"/>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+            <CustomOptions Value="-dNoLogging"/>
+          </Other>
+        </CompilerOptions>
+      </Item5>
+      <Item6 Name="Debug.Win32">
+        <MacroValues Count="1">
+          <Macro1 Name="LCLWidgetType" Value="win32"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <OverflowChecks Value="True"/>
+            </Checks>
+            <TargetCPU Value="i386"/>
+            <TargetOS Value="win32"/>
+          </CodeGeneration>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+          </Other>
+        </CompilerOptions>
+      </Item6>
+      <Item7 Name="Debug.Linux.x86">
+        <MacroValues Count="1">
+          <Macro2 Name="LCLWidgetType" Value="gtk2"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <OverflowChecks Value="True"/>
+            </Checks>
+            <TargetCPU Value="i386"/>
+            <TargetOS Value="linux"/>
+          </CodeGeneration>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+            <CustomOptions Value="-dNoLogging"/>
+          </Other>
+        </CompilerOptions>
+      </Item7>
+      <Item8 Name="Debug.Linux.x64">
+        <MacroValues Count="1">
+          <Macro2 Name="LCLWidgetType" Value="gtk2"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="../Client.bin/CentrED"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+            <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
+            <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <CStyleOperator Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <OverflowChecks Value="True"/>
+            </Checks>
+            <TargetCPU Value="x86_64"/>
+            <TargetOS Value="linux"/>
+          </CodeGeneration>
+          <Other>
+            <CompilerMessages>
+              <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
+            </CompilerMessages>
+            <CustomOptions Value="-dNoLogging"/>
+          </Other>
+        </CompilerOptions>
+      </Item8>
+      <SharedMatrixOptions Count="2">
+        <Item1 ID="851019893220" Modes="Release.Win32,Debug.Win32" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/>
+        <Item2 ID="521965364444" Modes="Release.Linux.x86,Release.Linux.x64,Debug.Linux.x86,Debug.Linux.x64" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/>
+      </SharedMatrixOptions>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
+      <environment>
+        <UserOverrides Count="1">
+          <Variable0 Name="HEAPTRC" Value="log=CentrED.trc"/>
+        </UserOverrides>
+      </environment>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+          </local>
+          <environment>
+            <UserOverrides Count="1">
+              <Variable0 Name="HEAPTRC" Value="log=CentrED.trc"/>
+            </UserOverrides>
+          </environment>
+        </Mode0>
+      </Modes>
     </RunParams>
-    <RequiredPackages Count="5">
+    <RequiredPackages Count="6">
       <Item1>
-        <PackageName Value="multiloglaz"/>
+        <PackageName Value="laz.virtualtreeview_package"/>
       </Item1>
       <Item2>
-        <PackageName Value="LazOpenGLContext"/>
-        <MinVersion Valid="True"/>
+        <PackageName Value="LCLBase"/>
+        <MinVersion Major="1" Release="1" Valid="True"/>
       </Item2>
       <Item3>
-        <PackageName Value="LCL"/>
+        <PackageName Value="multiloglaz"/>
       </Item3>
       <Item4>
-        <PackageName Value="lnetvisual"/>
-        <MinVersion Minor="5" Release="3" Valid="True"/>
+        <PackageName Value="LazOpenGLContext"/>
       </Item4>
       <Item5>
-        <PackageName Value="virtualtreeview_package"/>
-        <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
+        <PackageName Value="LCL"/>
       </Item5>
+      <Item6>
+        <PackageName Value="lnetvisual"/>
+        <MinVersion Minor="5" Release="3" Valid="True"/>
+      </Item6>
     </RequiredPackages>
-    <Units Count="46">
+    <Units Count="49">
       <Unit0>
         <Filename Value="CentrED.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="CentrED"/>
       </Unit0>
       <Unit1>
         <Filename Value="UfrmMain.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmMain"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmMain"/>
       </Unit1>
       <Unit2>
         <Filename Value="UdmNetwork.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="dmNetwork"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="DataModule"/>
-        <UnitName Value="UdmNetwork"/>
       </Unit2>
       <Unit3>
         <Filename Value="UfrmLogin.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmLogin"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmLogin"/>
       </Unit3>
       <Unit4>
         <Filename Value="UfrmInitialize.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmInitialize"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmInitialize"/>
       </Unit4>
       <Unit5>
         <Filename Value="UfrmAccountControl.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmAccountControl"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmAccountControl"/>
       </Unit5>
       <Unit6>
         <Filename Value="UfrmEditAccount.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmEditAccount"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmEditAccount"/>
       </Unit6>
       <Unit7>
         <Filename Value="Tools/UfrmDrawSettings.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmDrawSettings"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmDrawSettings"/>
       </Unit7>
       <Unit8>
         <Filename Value="Tools/UfrmBoundaries.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmBoundaries"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmBoundaries"/>
       </Unit8>
       <Unit9>
         <Filename Value="Tools/UfrmElevateSettings.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmElevateSettings"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmElevateSettings"/>
       </Unit9>
       <Unit10>
         <Filename Value="UOverlayUI.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UOverlayUI"/>
       </Unit10>
       <Unit11>
-        <Filename Value="UResourceManager.pas"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="UResourceManager"/>
-      </Unit11>
-      <Unit12>
         <Filename Value="Tools/UfrmConfirmation.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmConfirmation"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmConfirmation"/>
-      </Unit12>
-      <Unit13>
+      </Unit11>
+      <Unit12>
         <Filename Value="Tools/UfrmMoveSettings.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmMoveSettings"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmMoveSettings"/>
-      </Unit13>
-      <Unit14>
+      </Unit12>
+      <Unit13>
         <Filename Value="UfrmAbout.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmAbout"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmAbout"/>
-      </Unit14>
-      <Unit15>
+      </Unit13>
+      <Unit14>
         <Filename Value="Tools/UfrmHueSettings.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmHueSettings"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmHueSettings"/>
-      </Unit15>
-      <Unit16>
+      </Unit14>
+      <Unit15>
         <Filename Value="UfrmRadar.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmRadarMap"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmRadar"/>
-      </Unit16>
-      <Unit17>
+      </Unit15>
+      <Unit16>
         <Filename Value="UfrmLargeScaleCommand.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmLargeScaleCommand"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmLargeScaleCommand"/>
-      </Unit17>
-      <Unit18>
+      </Unit16>
+      <Unit17>
         <Filename Value="Tools/UfrmVirtualLayer.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmVirtualLayer"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmVirtualLayer"/>
-      </Unit18>
-      <Unit19>
+      </Unit17>
+      <Unit18>
         <Filename Value="Tools/UfrmFilter.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmFilter"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmFilter"/>
-      </Unit19>
-      <Unit20>
+      </Unit18>
+      <Unit19>
         <Filename Value="UGUIPlatformUtils.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UGUIPlatformUtils"/>
-      </Unit20>
-      <Unit21>
+      </Unit19>
+      <Unit20>
         <Filename Value="UPlatformTypes.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UPlatformTypes"/>
-      </Unit21>
-      <Unit22>
+      </Unit20>
+      <Unit21>
         <Filename Value="UfrmRegionControl.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmRegionControl"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmRegionControl"/>
-      </Unit22>
-      <Unit23>
+      </Unit21>
+      <Unit22>
         <Filename Value="UPacketHandlers.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UPacketHandlers"/>
-      </Unit23>
-      <Unit24>
+      </Unit22>
+      <Unit23>
         <Filename Value="UPackets.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UPackets"/>
-      </Unit24>
-      <Unit25>
+      </Unit23>
+      <Unit24>
         <Filename Value="ULandscape.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ULandscape"/>
-      </Unit25>
-      <Unit26>
+      </Unit24>
+      <Unit25>
         <Filename Value="UGameResources.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UGameResources"/>
-      </Unit26>
-      <Unit27>
+      </Unit25>
+      <Unit26>
         <Filename Value="UAdminHandling.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UAdminHandling"/>
-      </Unit27>
-      <Unit28>
+      </Unit26>
+      <Unit27>
         <Filename Value="Tools/UfrmToolWindow.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmToolWindow"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmToolWindow"/>
-      </Unit28>
-      <Unit29>
+      </Unit27>
+      <Unit28>
         <Filename Value="../Logging.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="Logging"/>
-      </Unit29>
-      <Unit30>
+      </Unit28>
+      <Unit29>
         <Filename Value="../UOLib/UStatics.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UStatics"/>
-      </Unit30>
-      <Unit31>
+      </Unit29>
+      <Unit30>
         <Filename Value="../UOLib/UWorldItem.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UWorldItem"/>
-      </Unit31>
-      <Unit32>
+      </Unit30>
+      <Unit31>
         <Filename Value="../UOLib/UMap.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UMap"/>
-      </Unit32>
-      <Unit33>
+      </Unit31>
+      <Unit32>
         <Filename Value="../UOLib/UTiledata.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UTiledata"/>
-      </Unit33>
-      <Unit34>
+      </Unit32>
+      <Unit33>
         <Filename Value="UGLFont.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UGLFont"/>
-      </Unit34>
-      <Unit35>
+      </Unit33>
+      <Unit34>
         <Filename Value="../UOLib/UAnimData.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UAnimData"/>
-      </Unit35>
-      <Unit36>
+      </Unit34>
+      <Unit35>
         <Filename Value="../MulProvider/UTileDataProvider.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UTileDataProvider"/>
-      </Unit36>
-      <Unit37>
+      </Unit35>
+      <Unit36>
         <Filename Value="../MulProvider/UAnimDataProvider.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UAnimDataProvider"/>
-      </Unit37>
-      <Unit38>
+      </Unit36>
+      <Unit37>
         <Filename Value="../MulProvider/UMulManager.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UMulManager"/>
-      </Unit38>
-      <Unit39>
+      </Unit37>
+      <Unit38>
         <Filename Value="../MulProvider/UArtProvider.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UArtProvider"/>
-      </Unit39>
-      <Unit40>
+      </Unit38>
+      <Unit39>
         <Filename Value="../MulProvider/UTexmapProvider.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UTexmapProvider"/>
+      </Unit39>
+      <Unit40>
+        <Filename Value="../version.inc"/>
+        <IsPartOfProject Value="True"/>
       </Unit40>
       <Unit41>
-        <Filename Value="../version.inc"/>
+        <Filename Value="ULightManager.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit41>
       <Unit42>
-        <Filename Value="ULightManager.pas"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="ULightManager"/>
-      </Unit42>
-      <Unit43>
         <Filename Value="../UOLib/ULight.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ULight"/>
-      </Unit43>
-      <Unit44>
+      </Unit42>
+      <Unit43>
         <Filename Value="../MulProvider/ULightProvider.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ULightProvider"/>
-      </Unit44>
-      <Unit45>
+      </Unit43>
+      <Unit44>
         <Filename Value="Tools/UfrmLightlevel.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="frmLightlevel"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit44>
+      <Unit45>
+        <Filename Value="UfrmChangePassword.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="frmChangePassword"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UfrmLightlevel"/>
       </Unit45>
+      <Unit46>
+        <Filename Value="USelectionHelper.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit46>
+      <Unit47>
+        <Filename Value="UActions.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit47>
+      <Unit48>
+        <Filename Value="UUoaDesigns.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit48>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="11"/>
     <Target>
-      <Filename Value="../bin/CentrED"/>
+      <Filename Value="../Client.bin/CentrED"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)/;../Imaging/;../"/>
-      <OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/>
+      <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
+      <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
       <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
-      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/;../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
         <CStyleOperator Value="False"/>
-        <UseAnsiStrings Value="True"/>
       </SyntaxOptions>
     </Parsing>
     <CodeGeneration>
-      <SmartLinkUnit Value="True"/>
+      <Checks>
+        <RangeChecks Value="True"/>
+      </Checks>
       <Optimizations>
-        <OptimizationLevel Value="3"/>
+        <OptimizationLevel Value="0"/>
       </Optimizations>
     </CodeGeneration>
     <Linking>
       <Debugging>
-        <UseLineInfoUnit Value="False"/>
-        <StripSymbols Value="True"/>
+        <DebugInfoType Value="dsStabs"/>
       </Debugging>
-      <LinkSmart Value="True"/>
-      <Options>
-        <Win32>
-          <GraphicApplication Value="True"/>
-        </Win32>
-      </Options>
     </Linking>
     <Other>
       <CompilerMessages>
-        <IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
+        <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
       </CompilerMessages>
-      <CustomOptions Value="-FE../bin/
--dNoLogging"/>
-      <CompilerPath Value="$(CompPath)"/>
+      <CustomOptions Value="-B"/>
     </Other>
   </CompilerOptions>
 </CONFIG>

Client/CentrED.lpr

@@ -1,52 +1,60 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-program CentrED;
-
-{$mode objfpc}{$H+}
-
-uses
-  {$IFDEF UNIX}{$IFDEF UseCThreads}
-  cthreads,
-  {$ENDIF}{$ENDIF}
-  SysUtils,
-  Interfaces, // this includes the LCL widgetset
-  Forms, LResources, UdmNetwork;
-
-{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
-
-function GetApplicationName: String;
-begin
-  Result := 'CentrED';
-end;
-
-begin
-  {$I CentrED.lrs}
-  OnGetApplicationName := @GetApplicationName;
-  Application.Initialize;
-  Application.CreateForm(TdmNetwork, dmNetwork);
-  Application.Run;
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2012 Andreas Schneider
+ *)
+program CentrED;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFNDEF NoLogging}heaptrc, Logging, filechannel,{$ENDIF}
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  SysUtils,
+  Interfaces, // this includes the LCL widgetset
+  Forms, UdmNetwork;
+
+{$R CentrED.res}
+{$R Assets.rc} // Beware: you need 'windres', which is part of mingw-binutils on *nix!
+
+function GetApplicationName: String;
+begin
+  Result := 'CentrED';
+end;
+
+begin
+  {$IFNDEF NoLogging}
+  SetHeapTraceOutput('CentrED.trc');
+  Logger.Channels.Add(TFileChannel.Create('CentrED.log'));
+  {$ENDIF}
+
+  OnGetApplicationName := @GetApplicationName;
+
+  Application.Scaled := True;
+  Application.Initialize;
+  Application.CreateForm(TdmNetwork, dmNetwork);
+  Application.Run;
+end.
+

Client/ResourceList.txt

@@ -1,5 +0,0 @@
-Overlay/LeftTopArrow.tga
-Overlay/TopArrow.tga
-Overlay/VirtualLayer.tga
-GLFont/DejaVu.png
-GLFont/DejaVu.fnt

Client/Tools/UfrmBoundaries.lfm

@@ -1,109 +1,278 @@
 inherited frmBoundaries: TfrmBoundaries
-  Left = 290
-  Height = 164
-  Top = 171
-  Width = 205
+  Left = 445
+  Height = 208
+  Top = 332
+  Width = 406
+  AutoSize = True
   Caption = 'Boundaries'
-  ClientHeight = 164
-  ClientWidth = 205
-  object lblMaxZ: TLabel[0]
+  ClientHeight = 208
+  ClientWidth = 406
+  OnCreate = FormCreate
+  object gbZRestriction: TGroupBox[0]
     AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = seMaxZ
-    AnchorSideTop.Side = asrCenter
-    Left = 8
-    Height = 16
-    Top = 89
-    Width = 68
-    BorderSpacing.Left = 8
-    Caption = 'Maximum Z:'
-    Layout = tlCenter
-    ParentColor = False
-  end
-  object lblMinZ: TLabel[1]
-    AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = seMinZ
-    AnchorSideTop.Side = asrCenter
-    Left = 8
-    Height = 16
-    Top = 12
-    Width = 67
-    BorderSpacing.Left = 8
-    Caption = 'Minimum Z:'
-    Layout = tlCenter
-    ParentColor = False
-  end
-  object tbMinZ: TTrackBar[2]
-    AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = seMinZ
-    AnchorSideTop.Side = asrBottom
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 8
-    Height = 36
-    Top = 41
-    Width = 189
-    Frequency = 10
-    Max = 127
-    Min = -128
-    OnChange = tbMinZChange
-    PageSize = 1
-    Position = -128
-    Anchors = [akTop, akLeft, akRight]
-    BorderSpacing.Around = 8
+    AnchorSideTop.Control = Owner
+    Left = 4
+    Height = 204
+    Top = 4
+    Width = 200
+    AutoSize = True
+    BorderSpacing.Left = 4
+    BorderSpacing.Top = 4
+    Caption = 'Restrict Height'
+    ClientHeight = 180
+    ClientWidth = 198
+    Constraints.MinWidth = 200
     TabOrder = 0
+    object lblMinZ: TLabel
+      AnchorSideLeft.Control = tbMinZ
+      AnchorSideTop.Control = seMinZ
+      AnchorSideTop.Side = asrCenter
+      Left = 4
+      Height = 23
+      Top = 9
+      Width = 93
+      Caption = 'Minimum Z:'
+      Color = clDefault
+      Layout = tlCenter
+      ParentColor = False
+      Transparent = False
+    end
+    object seMinZ: TSpinEdit
+      AnchorSideTop.Control = gbZRestriction
+      AnchorSideRight.Control = gbZRestriction
+      AnchorSideRight.Side = asrBottom
+      Left = 132
+      Height = 33
+      Top = 4
+      Width = 62
+      Anchors = [akTop, akRight]
+      BorderSpacing.Top = 4
+      BorderSpacing.Right = 4
+      MaxValue = 127
+      MinValue = -128
+      OnChange = seMinZChange
+      TabOrder = 0
+      Value = -128
+    end
+    object tbMinZ: TTrackBar
+      AnchorSideLeft.Control = gbZRestriction
+      AnchorSideTop.Control = seMinZ
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = gbZRestriction
+      AnchorSideRight.Side = asrBottom
+      Left = 4
+      Height = 47
+      Top = 41
+      Width = 190
+      Frequency = 10
+      Max = 127
+      Min = -128
+      OnChange = tbMinZChange
+      PageSize = 1
+      Position = -128
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Around = 4
+      TabOrder = 1
+    end
+    object lblMaxZ: TLabel
+      AnchorSideLeft.Control = tbMaxZ
+      AnchorSideTop.Control = seMaxZ
+      AnchorSideTop.Side = asrCenter
+      Left = 4
+      Height = 23
+      Top = 97
+      Width = 97
+      Caption = 'Maximum Z:'
+      Color = clDefault
+      Layout = tlCenter
+      ParentColor = False
+      Transparent = False
+    end
+    object seMaxZ: TSpinEdit
+      AnchorSideTop.Control = tbMinZ
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = seMinZ
+      AnchorSideRight.Side = asrBottom
+      Left = 132
+      Height = 33
+      Top = 92
+      Width = 62
+      Anchors = [akTop, akRight]
+      MaxValue = 127
+      MinValue = -128
+      OnChange = seMaxZChange
+      TabOrder = 2
+      Value = 127
+    end
+    object tbMaxZ: TTrackBar
+      AnchorSideLeft.Control = gbZRestriction
+      AnchorSideTop.Control = seMaxZ
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = gbZRestriction
+      AnchorSideRight.Side = asrBottom
+      Left = 4
+      Height = 47
+      Top = 129
+      Width = 190
+      Frequency = 10
+      Max = 127
+      Min = -128
+      OnChange = tbMaxZChange
+      PageSize = 1
+      Position = 127
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Around = 4
+      TabOrder = 3
+    end
   end
-  object tbMaxZ: TTrackBar[3]
-    AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = seMaxZ
-    AnchorSideTop.Side = asrBottom
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 8
-    Height = 36
-    Top = 118
-    Width = 189
-    Frequency = 10
-    Max = 127
-    Min = -128
-    OnChange = tbMaxZChange
-    PageSize = 1
-    Position = 127
-    Anchors = [akTop, akLeft, akRight]
-    BorderSpacing.Around = 8
-    TabOrder = 1
-  end
-  object seMaxZ: TSpinEdit[4]
-    AnchorSideTop.Control = tbMinZ
-    AnchorSideTop.Side = asrBottom
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 149
-    Height = 25
-    Top = 85
-    Width = 48
-    Anchors = [akTop, akRight]
-    BorderSpacing.Right = 8
-    MaxValue = 127
-    MinValue = -128
-    OnChange = seMaxZChange
-    TabOrder = 2
-    Value = 127
-  end
-  object seMinZ: TSpinEdit[5]
+  object gbViewRestriction: TGroupBox[1]
+    AnchorSideLeft.Control = gbZRestriction
+    AnchorSideLeft.Side = asrBottom
     AnchorSideTop.Control = Owner
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
-    Left = 149
-    Height = 25
-    Top = 8
-    Width = 48
-    Anchors = [akTop, akRight]
-    BorderSpacing.Top = 8
-    BorderSpacing.Right = 8
-    MaxValue = 127
-    MinValue = -128
-    OnChange = seMinZChange
-    TabOrder = 3
-    Value = -128
+    AnchorSideBottom.Control = gbZRestriction
+    AnchorSideBottom.Side = asrBottom
+    Left = 208
+    Height = 200
+    Top = 4
+    Width = 194
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Around = 4
+    Caption = 'Restrict View Range'
+    ClientHeight = 176
+    ClientWidth = 192
+    TabOrder = 1
+    object seMinX: TSpinEdit
+      AnchorSideLeft.Control = lblX
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = seMaxX
+      Left = 22
+      Height = 33
+      Top = 4
+      Width = 74
+      BorderSpacing.Left = 4
+      OnChange = seMinXChange
+      TabOrder = 0
+    end
+    object seMaxX: TSpinEdit
+      AnchorSideTop.Control = gbViewRestriction
+      AnchorSideRight.Control = gbViewRestriction
+      AnchorSideRight.Side = asrBottom
+      Left = 114
+      Height = 33
+      Top = 4
+      Width = 74
+      Anchors = [akTop, akRight]
+      BorderSpacing.Top = 4
+      BorderSpacing.Right = 4
+      OnChange = seMaxXChange
+      TabOrder = 1
+    end
+    object seMinY: TSpinEdit
+      AnchorSideLeft.Control = seMinX
+      AnchorSideTop.Control = seMinX
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = seMinX
+      AnchorSideRight.Side = asrBottom
+      Left = 22
+      Height = 33
+      Top = 45
+      Width = 74
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Top = 8
+      OnChange = seMinYChange
+      TabOrder = 2
+    end
+    object seMaxY: TSpinEdit
+      AnchorSideLeft.Control = seMaxX
+      AnchorSideTop.Control = seMinY
+      AnchorSideRight.Control = seMaxX
+      AnchorSideRight.Side = asrBottom
+      Left = 114
+      Height = 33
+      Top = 45
+      Width = 74
+      Anchors = [akTop, akLeft, akRight]
+      OnChange = seMaxYChange
+      TabOrder = 3
+    end
+    object lblX: TLabel
+      AnchorSideLeft.Control = gbViewRestriction
+      AnchorSideTop.Control = seMinX
+      AnchorSideTop.Side = asrCenter
+      Left = 4
+      Height = 23
+      Top = 9
+      Width = 14
+      BorderSpacing.Left = 4
+      Caption = 'X:'
+      Color = clDefault
+      ParentColor = False
+      Transparent = False
+    end
+    object lblY: TLabel
+      AnchorSideLeft.Control = lblX
+      AnchorSideTop.Control = seMinY
+      AnchorSideTop.Side = asrCenter
+      Left = 4
+      Height = 23
+      Top = 50
+      Width = 13
+      Caption = 'Y:'
+      Color = clDefault
+      ParentColor = False
+      Transparent = False
+    end
+    object lblXSep: TLabel
+      AnchorSideLeft.Control = seMinX
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = seMaxX
+      AnchorSideTop.Side = asrCenter
+      Left = 100
+      Height = 23
+      Top = 9
+      Width = 17
+      BorderSpacing.Left = 4
+      Caption = '—'
+      Color = clDefault
+      ParentColor = False
+      Transparent = False
+    end
+    object lblYSep: TLabel
+      AnchorSideLeft.Control = lblXSep
+      AnchorSideTop.Control = seMinY
+      AnchorSideTop.Side = asrCenter
+      Left = 100
+      Height = 23
+      Top = 50
+      Width = 17
+      Caption = '—'
+      Color = clDefault
+      ParentColor = False
+      Transparent = False
+    end
+    object btnSelectArea: TButton
+      Left = 0
+      Height = 25
+      Top = 95
+      Width = 112
+      Caption = 'Select Area'
+      OnClick = btnSelectAreaClick
+      TabOrder = 4
+    end
+    object btnClear: TButton
+      Left = 117
+      Height = 25
+      Top = 95
+      Width = 75
+      Caption = 'Clear'
+      OnClick = btnClearClick
+      TabOrder = 5
+    end
+  end
+  inherited tmClose: TTimer[2]
+    Left = 200
+    Top = 176
   end
 end

Client/Tools/UfrmBoundaries.pas

@@ -21,7 +21,8 @@
  * CDDL HEADER END
  *
  *
- *      Portions Copyright 2009 Andreas Schneider
+ *      Portions Copyright 2015 Andreas Schneider
+ *      Portions Copyright 2015 StaticZ
  *)
 unit UfrmBoundaries;
 
@@ -31,23 +32,44 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  ComCtrls, Spin, ExtCtrls, UfrmToolWindow;
+  ComCtrls, Spin, ExtCtrls, UfrmToolWindow, USelectionHelper;
 
 type
 
   { TfrmBoundaries }
 
   TfrmBoundaries = class(TfrmToolWindow)
+    btnSelectArea: TButton;
+    btnClear: TButton;
+    gbZRestriction: TGroupBox;
+    gbViewRestriction: TGroupBox;
+    lblYSep: TLabel;
+    lblXSep: TLabel;
+    lblY: TLabel;
+    lblX: TLabel;
     lblMaxZ: TLabel;
     lblMinZ: TLabel;
     seMaxZ: TSpinEdit;
     seMinZ: TSpinEdit;
-    tbMinZ: TTrackBar;
+    seMinX: TSpinEdit;
+    seMaxX: TSpinEdit;
+    seMinY: TSpinEdit;
+    seMaxY: TSpinEdit;
     tbMaxZ: TTrackBar;
+    tbMinZ: TTrackBar;
+    procedure btnSelectAreaClick(Sender: TObject);
+    procedure btnClearClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure seMaxXChange(Sender: TObject);
+    procedure seMaxYChange(Sender: TObject);
     procedure seMaxZChange(Sender: TObject);
+    procedure seMinXChange(Sender: TObject);
+    procedure seMinYChange(Sender: TObject);
     procedure seMinZChange(Sender: TObject);
     procedure tbMaxZChange(Sender: TObject);
     procedure tbMinZChange(Sender: TObject);
+  protected
+    procedure RangeSelected(AX1, AY1, AX2, AY2: Word);
   public
     { public declarations }
   end; 
@@ -62,12 +84,57 @@ uses
 
 { TfrmBoundaries }
 
+procedure TfrmBoundaries.FormCreate(Sender: TObject);
+begin
+  seMinX.MaxValue := frmMain.Landscape.CellWidth - 1;
+  seMaxX.MaxValue := seMinX.MaxValue;
+  seMaxX.Value := seMaxX.MaxValue;
+
+  seMinY.MaxValue := frmMain.Landscape.CellHeight - 1;
+  seMaxY.MaxValue := seMinY.MaxValue;
+  seMaxY.Value := seMaxX.MaxValue;
+end;
+
+procedure TfrmBoundaries.btnSelectAreaClick(Sender: TObject);
+begin
+  SelectRange(@RangeSelected);
+end;
+
+procedure TfrmBoundaries.btnClearClick(Sender: TObject);
+begin
+  seMinX.Value := 0;
+  seMinY.Value := 0;
+  seMaxX.Value := seMaxX.MaxValue;
+  seMaxY.Value := seMaxY.MaxValue;
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmBoundaries.seMaxXChange(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmBoundaries.seMaxYChange(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
 procedure TfrmBoundaries.seMaxZChange(Sender: TObject);
 begin
   tbMaxZ.Position := seMaxZ.Value;
   frmMain.InvalidateFilter;
 end;
 
+procedure TfrmBoundaries.seMinXChange(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmBoundaries.seMinYChange(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
 procedure TfrmBoundaries.seMinZChange(Sender: TObject);
 begin
   tbMinZ.Position := seMinZ.Value;
@@ -86,6 +153,15 @@ begin
   frmMain.InvalidateFilter;
 end;
 
+procedure TfrmBoundaries.RangeSelected(AX1, AY1, AX2, AY2: Word);
+begin
+  seMinX.Value := AX1;
+  seMinY.Value := AY1;
+  seMaxX.Value := AX2;
+  seMaxY.Value := AY2;
+  frmBoundaries.Show;
+end;
+
 initialization
   {$I UfrmBoundaries.lrs}
 

Client/Tools/UfrmConfirmation.lfm

@@ -1,37 +1,34 @@
-object frmConfirmation: TfrmConfirmation
-  Left = 290
-  Height = 43
-  Top = 171
-  Width = 108
-  BorderIcons = []
-  BorderStyle = bsToolWindow
-  Caption = 'Apply?'
-  ClientHeight = 43
-  ClientWidth = 108
-  Font.Height = -11
-  LCLVersion = '0.9.25'
-  object btnYes: TButton
-    Left = 8
-    Height = 25
-    Top = 8
-    Width = 40
-    BorderSpacing.InnerBorder = 4
-    Caption = 'Yes'
-    Default = True
-    ModalResult = 6
-    ParentFont = True
-    TabOrder = 0
-  end
-  object btnNo: TButton
-    Left = 56
-    Height = 25
-    Top = 8
-    Width = 40
-    BorderSpacing.InnerBorder = 4
-    Cancel = True
-    Caption = 'No'
-    ModalResult = 7
-    ParentFont = True
-    TabOrder = 1
-  end
-end
+object frmConfirmation: TfrmConfirmation
+  Left = 290
+  Height = 54
+  Top = 171
+  Width = 135
+  BorderIcons = []
+  BorderStyle = bsToolWindow
+  Caption = 'Apply?'
+  ClientHeight = 54
+  ClientWidth = 135
+  Font.Height = -14
+  object btnYes: TButton
+    Left = 10
+    Height = 31
+    Top = 10
+    Width = 50
+    BorderSpacing.InnerBorder = 5
+    Caption = 'Yes'
+    Default = True
+    ModalResult = 6
+    TabOrder = 0
+  end
+  object btnNo: TButton
+    Left = 70
+    Height = 31
+    Top = 10
+    Width = 50
+    BorderSpacing.InnerBorder = 5
+    Cancel = True
+    Caption = 'No'
+    ModalResult = 7
+    TabOrder = 1
+  end
+end

Client/Tools/UfrmConfirmation.pas

@@ -1,57 +1,57 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2007 Andreas Schneider
- *)
-unit UfrmConfirmation;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
-
-type
-
-  { TfrmConfirmation }
-
-  TfrmConfirmation = class(TForm)
-    btnYes: TButton;
-    btnNo: TButton;
-  private
-    { private declarations }
-  public
-    { public declarations }
-  end; 
-
-var
-  frmConfirmation: TfrmConfirmation;
-
-implementation
-
-initialization
-  {$I UfrmConfirmation.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2007 Andreas Schneider
+ *)
+unit UfrmConfirmation;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+  { TfrmConfirmation }
+
+  TfrmConfirmation = class(TForm)
+    btnYes: TButton;
+    btnNo: TButton;
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  frmConfirmation: TfrmConfirmation;
+
+implementation
+
+initialization
+  {$I UfrmConfirmation.lrs}
+
+end.
+

Client/Tools/UfrmDrawSettings.lfm

@@ -1,123 +1,127 @@
-inherited frmDrawSettings: TfrmDrawSettings
-  Left = 268
-  Height = 180
-  Top = 165
-  Width = 242
-  ActiveControl = rbTileList
-  Caption = 'Draw settings'
-  ClientHeight = 180
-  ClientWidth = 242
-  OnCreate = FormCreate
-  object rbTileList: TRadioButton[0]
-    AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = Owner
-    Left = 8
-    Height = 22
-    Top = 8
-    Width = 146
-    BorderSpacing.Left = 8
-    BorderSpacing.Top = 8
-    BorderSpacing.Bottom = 4
-    Caption = 'Use tile from the list'
-    Checked = True
-    State = cbChecked
-    TabOrder = 0
-  end
-  object rbRandom: TRadioButton[1]
-    AnchorSideLeft.Control = rbTileList
-    AnchorSideTop.Control = rbTileList
-    AnchorSideTop.Side = asrBottom
-    Left = 8
-    Height = 22
-    Top = 34
-    Width = 213
-    BorderSpacing.Top = 4
-    Caption = 'Use tiles from the random pool'
-    TabOrder = 1
-    TabStop = False
-  end
-  object gbHue: TGroupBox[2]
-    AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = seRandomHeight
-    AnchorSideTop.Side = asrBottom
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 8
-    Height = 49
-    Top = 132
-    Width = 226
-    Anchors = [akTop, akLeft, akRight]
-    BorderSpacing.Around = 8
-    Caption = 'Hue (Statics only)'
-    ClientHeight = 45
-    ClientWidth = 222
-    TabOrder = 2
-    object pbHue: TPaintBox
-      Cursor = crHandPoint
-      Left = 4
-      Height = 41
-      Top = 0
-      Width = 214
-      Align = alClient
-      BorderSpacing.Left = 4
-      BorderSpacing.Right = 4
-      BorderSpacing.Bottom = 4
-      OnClick = pbHueClick
-      OnPaint = pbHuePaint
-    end
-  end
-  object cbRandomHeight: TCheckBox[3]
-    AnchorSideLeft.Control = cbForceAltitude
-    AnchorSideTop.Control = cbForceAltitude
-    AnchorSideTop.Side = asrBottom
-    Left = 8
-    Height = 22
-    Top = 102
-    Width = 149
-    BorderSpacing.Top = 12
-    Caption = 'Add Random Altitude'
-    TabOrder = 3
-  end
-  object seRandomHeight: TSpinEdit[4]
-    AnchorSideTop.Control = cbRandomHeight
-    AnchorSideTop.Side = asrCenter
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 184
-    Height = 21
-    Top = 103
-    Width = 50
-    Anchors = [akTop, akRight]
-    BorderSpacing.Right = 8
-    TabOrder = 4
-  end
-  object cbForceAltitude: TCheckBox[5]
-    AnchorSideLeft.Control = rbRandom
-    AnchorSideTop.Control = rbRandom
-    AnchorSideTop.Side = asrBottom
-    Left = 8
-    Height = 22
-    Top = 68
-    Width = 111
-    BorderSpacing.Top = 12
-    Caption = 'Force altitude:'
-    TabOrder = 5
-  end
-  object seForceAltitude: TSpinEdit[6]
-    AnchorSideTop.Control = cbForceAltitude
-    AnchorSideTop.Side = asrCenter
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 184
-    Height = 21
-    Top = 69
-    Width = 50
-    Anchors = [akTop, akRight]
-    BorderSpacing.Right = 8
-    MaxValue = 127
-    MinValue = -128
-    TabOrder = 6
-  end
-  inherited tmClose: TTimer[7]
-  end
-end
+inherited frmDrawSettings: TfrmDrawSettings
+  Left = 268
+  Height = 194
+  Top = 165
+  Width = 375
+  ActiveControl = rbTileList
+  AutoSize = True
+  Caption = 'Draw settings'
+  ClientHeight = 194
+  ClientWidth = 375
+  Constraints.MinWidth = 375
+  OnCreate = FormCreate
+  object rbTileList: TRadioButton[0]
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    Left = 8
+    Height = 25
+    Top = 8
+    Width = 178
+    BorderSpacing.Left = 8
+    BorderSpacing.Top = 8
+    BorderSpacing.Bottom = 4
+    Caption = 'Use tile from the list'
+    Checked = True
+    TabOrder = 0
+    TabStop = True
+  end
+  object rbRandom: TRadioButton[1]
+    AnchorSideLeft.Control = rbTileList
+    AnchorSideTop.Control = rbTileList
+    AnchorSideTop.Side = asrBottom
+    Left = 8
+    Height = 25
+    Top = 37
+    Width = 264
+    BorderSpacing.Top = 4
+    Caption = 'Use tiles from the random pool'
+    TabOrder = 1
+  end
+  object gbHue: TGroupBox[2]
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = seRandomHeight
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 8
+    Height = 38
+    Top = 148
+    Width = 359
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Around = 8
+    Caption = 'Hue (Statics only)'
+    ClientHeight = 14
+    ClientWidth = 357
+    TabOrder = 2
+    object pbHue: TPaintBox
+      Cursor = crHandPoint
+      Left = 4
+      Height = 10
+      Top = 0
+      Width = 349
+      Align = alClient
+      BorderSpacing.Left = 4
+      BorderSpacing.Right = 4
+      BorderSpacing.Bottom = 4
+      Font.Height = 14
+      ParentFont = False
+      OnClick = pbHueClick
+      OnPaint = pbHuePaint
+    end
+  end
+  object cbRandomHeight: TCheckBox[3]
+    AnchorSideLeft.Control = cbForceAltitude
+    AnchorSideTop.Control = cbForceAltitude
+    AnchorSideTop.Side = asrBottom
+    Left = 8
+    Height = 25
+    Top = 111
+    Width = 188
+    BorderSpacing.Top = 12
+    Caption = 'Add Random Altitude'
+    TabOrder = 3
+  end
+  object seRandomHeight: TSpinEdit[4]
+    AnchorSideTop.Control = cbRandomHeight
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 317
+    Height = 33
+    Top = 107
+    Width = 50
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 8
+    TabOrder = 4
+  end
+  object cbForceAltitude: TCheckBox[5]
+    AnchorSideLeft.Control = rbRandom
+    AnchorSideTop.Control = rbRandom
+    AnchorSideTop.Side = asrBottom
+    Left = 8
+    Height = 25
+    Top = 74
+    Width = 133
+    BorderSpacing.Top = 12
+    Caption = 'Force altitude:'
+    TabOrder = 5
+  end
+  object seForceAltitude: TSpinEdit[6]
+    AnchorSideTop.Control = cbForceAltitude
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 317
+    Height = 33
+    Top = 70
+    Width = 50
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 8
+    MaxValue = 127
+    MinValue = -128
+    TabOrder = 6
+  end
+  inherited tmClose: TTimer[7]
+    Left = 312
+  end
+end

Client/Tools/UfrmDrawSettings.pas

@@ -1,129 +1,135 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UfrmDrawSettings;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Spin, ExtCtrls, LMessages, UfrmToolWindow;
-
-type
-
-  { TfrmDrawSettings }
-
-  TfrmDrawSettings = class(TfrmToolWindow)
-    cbForceAltitude: TCheckBox;
-    cbRandomHeight: TCheckBox;
-    gbHue: TGroupBox;
-    pbHue: TPaintBox;
-    rbRandom: TRadioButton;
-    rbTileList: TRadioButton;
-    seForceAltitude: TSpinEdit;
-    seRandomHeight: TSpinEdit;
-    procedure FormCreate(Sender: TObject);
-    procedure pbHueClick(Sender: TObject);
-    procedure pbHuePaint(Sender: TObject);
-    procedure seForceAltitudeChange(Sender: TObject);
-    procedure seRandomHeightChange(Sender: TObject);
-  private
-    FCanClose: Boolean;
-    function CanClose: Boolean; override;
-    procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
-  end; 
-
-var
-  frmDrawSettings: TfrmDrawSettings;
-
-implementation
-
-uses
-  UGameResources, UHue, UfrmHueSettings;
-
-{ TfrmDrawSettings }
-
-procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
-begin
-  frmHueSettings.Left := Mouse.CursorPos.x - 8;
-  frmHueSettings.Top := Mouse.CursorPos.y - 8;
-  frmHueSettings.OnClose := @OnHueClose;
-  frmHueSettings.Show;
-  FCanClose := False;
-end;
-
-procedure TfrmDrawSettings.FormCreate(Sender: TObject);
-begin
-  FCanClose := True;
-end;
-
-procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
-var
-  hue: THue;
-begin
-  if frmHueSettings <> nil then
-  begin
-    if frmHueSettings.lbHue.ItemIndex > 0 then
-      hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
-    else
-      hue := nil;
-    TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
-      frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
-  end;
-end;
-
-procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
-begin
-  cbForceAltitude.Checked := True;
-end;
-
-procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
-begin
-  cbRandomHeight.Checked := True;
-end;
-
-function TfrmDrawSettings.CanClose: Boolean;
-begin
-  Result := FCanClose and inherited CanClose;
-end;
-
-procedure TfrmDrawSettings.OnHueClose(Sender: TObject;
-  var ACloseAction: TCloseAction);
-var
-  msg: TLMessage;
-begin
-  FCanClose := True;
-  frmHueSettings.OnClose := nil;
-  pbHue.Repaint;
-  MouseLeave(msg);
-end;
-
-initialization
-  {$I UfrmDrawSettings.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UfrmDrawSettings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  Spin, ExtCtrls, LMessages, UfrmToolWindow;
+
+type
+
+  { TfrmDrawSettings }
+
+  TfrmDrawSettings = class(TfrmToolWindow)
+    cbForceAltitude: TCheckBox;
+    cbRandomHeight: TCheckBox;
+    gbHue: TGroupBox;
+    pbHue: TPaintBox;
+    rbRandom: TRadioButton;
+    rbTileList: TRadioButton;
+    seForceAltitude: TSpinEdit;
+    seRandomHeight: TSpinEdit;
+    procedure FormCreate(Sender: TObject);
+    procedure pbHueClick(Sender: TObject);
+    procedure pbHuePaint(Sender: TObject);
+    procedure seForceAltitudeChange(Sender: TObject);
+    procedure seRandomHeightChange(Sender: TObject);
+  private
+    FCanClose: Boolean;
+    function CanClose: Boolean; override;
+    procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
+  end; 
+
+var
+  frmDrawSettings: TfrmDrawSettings;
+
+implementation
+
+uses
+  UGameResources, UHue, UfrmHueSettings;
+
+{ TfrmDrawSettings }
+
+procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
+begin
+  frmHueSettings.Left := Mouse.CursorPos.x - 8;
+  frmHueSettings.Top := Mouse.CursorPos.y - 8;
+  frmHueSettings.OnClose := @OnHueClose;
+  frmHueSettings.Show;
+  FCanClose := False;
+end;
+
+procedure TfrmDrawSettings.FormCreate(Sender: TObject);
+begin
+  FCanClose := True;
+end;
+
+procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
+var
+  hue: THue;
+begin
+  if frmHueSettings <> nil then
+  begin
+    if frmHueSettings.cbRandom.Checked then
+    begin
+      pbHue.Canvas.TextOut(36, 1, '[Random]');
+    end else
+    begin
+      if frmHueSettings.lbHue.ItemIndex > 0 then
+        hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
+      else
+        hue := nil;
+      TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
+        frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
+    end;
+  end;
+end;
+
+procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
+begin
+  cbForceAltitude.Checked := True;
+end;
+
+procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
+begin
+  cbRandomHeight.Checked := True;
+end;
+
+function TfrmDrawSettings.CanClose: Boolean;
+begin
+  Result := FCanClose and inherited CanClose;
+end;
+
+procedure TfrmDrawSettings.OnHueClose(Sender: TObject;
+  var ACloseAction: TCloseAction);
+var
+  msg: TLMessage;
+begin
+  FCanClose := True;
+  frmHueSettings.OnClose := nil;
+  pbHue.Repaint;
+  MouseLeave(msg);
+end;
+
+initialization
+  {$I UfrmDrawSettings.lrs}
+
+end.
+

Client/Tools/UfrmElevateSettings.lfm

@@ -1,57 +1,55 @@
 inherited frmElevateSettings: TfrmElevateSettings
   Left = 290
-  Height = 114
+  Height = 141
   Top = 171
-  Width = 250
+  Width = 297
   Caption = 'Elevate'
-  ClientHeight = 114
-  ClientWidth = 250
+  ClientHeight = 141
+  ClientWidth = 297
   object rbRaise: TRadioButton[0]
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = Owner
     Left = 8
-    Height = 19
+    Height = 25
     Top = 8
-    Width = 47
+    Width = 64
     BorderSpacing.Left = 8
     BorderSpacing.Top = 8
     Caption = 'Raise'
     Checked = True
-    State = cbChecked
     TabOrder = 2
+    TabStop = True
   end
   object rbLower: TRadioButton[1]
     AnchorSideLeft.Control = rbRaise
     AnchorSideTop.Control = rbRaise
     AnchorSideTop.Side = asrBottom
     Left = 8
-    Height = 19
-    Top = 27
-    Width = 52
+    Height = 25
+    Top = 33
+    Width = 72
     Caption = 'Lower'
     TabOrder = 0
-    TabStop = False
   end
   object rbSet: TRadioButton[2]
     AnchorSideLeft.Control = rbLower
     AnchorSideTop.Control = rbLower
     AnchorSideTop.Side = asrBottom
     Left = 8
-    Height = 19
-    Top = 46
-    Width = 36
+    Height = 25
+    Top = 58
+    Width = 48
     Caption = 'Set'
     TabOrder = 1
-    TabStop = False
   end
   object cbRandomHeight: TCheckBox[3]
     AnchorSideLeft.Control = rbSet
     AnchorSideTop.Control = rbSet
     AnchorSideTop.Side = asrBottom
     Left = 8
-    Height = 19
-    Top = 81
-    Width = 135
+    Height = 25
+    Top = 99
+    Width = 188
     BorderSpacing.Top = 16
     Caption = 'Add Random Altitude'
     TabOrder = 3
@@ -62,9 +60,9 @@ inherited frmElevateSettings: TfrmElevateSettings
     AnchorSideTop.Side = asrCenter
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
-    Left = 197
-    Height = 25
-    Top = 78
+    Left = 244
+    Height = 33
+    Top = 95
     Width = 45
     Anchors = [akTop, akLeft, akRight]
     BorderSpacing.Right = 8
@@ -78,9 +76,9 @@ inherited frmElevateSettings: TfrmElevateSettings
     AnchorSideTop.Side = asrCenter
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
-    Left = 197
-    Height = 25
-    Top = 24
+    Left = 244
+    Height = 33
+    Top = 29
     Width = 45
     Anchors = [akTop, akRight]
     BorderSpacing.Right = 8
@@ -89,4 +87,8 @@ inherited frmElevateSettings: TfrmElevateSettings
     TabOrder = 5
     Value = 1
   end
+  inherited tmClose: TTimer[6]
+    Left = 144
+    Top = 16
+  end
 end

Client/Tools/UfrmFilter.lfm

@@ -1,317 +1,315 @@
-object frmFilter: TfrmFilter
-  Left = 290
-  Height = 492
-  Top = 171
-  Width = 232
-  ActiveControl = rgFilterType.RadioButton0
-  BorderIcons = [biSystemMenu, biMinimize]
-  BorderStyle = bsToolWindow
-  Caption = 'Filter'
-  ClientHeight = 492
-  ClientWidth = 232
-  Font.Height = -11
-  OnCreate = FormCreate
-  OnDestroy = FormDestroy
-  OnShow = FormShow
-  LCLVersion = '0.9.29'
-  object rgFilterType: TRadioGroup
-    Left = 4
-    Height = 40
-    Top = 4
-    Width = 224
-    Align = alTop
-    AutoFill = True
-    BorderSpacing.Around = 4
-    Caption = 'Filter rule'
-    ChildSizing.LeftRightSpacing = 6
-    ChildSizing.TopBottomSpacing = 6
-    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
-    ChildSizing.EnlargeVertical = crsHomogenousChildResize
-    ChildSizing.ShrinkHorizontal = crsScaleChilds
-    ChildSizing.ShrinkVertical = crsScaleChilds
-    ChildSizing.Layout = cclLeftToRightThenTopToBottom
-    ChildSizing.ControlsPerLine = 2
-    ClientHeight = 26
-    ClientWidth = 222
-    Columns = 2
-    ItemIndex = 0
-    Items.Strings = (
-      'Exclusive'
-      'Inclusive'
-    )
-    OnClick = rgFilterTypeClick
-    TabOrder = 0
-  end
-  object GroupBox1: TGroupBox
-    Left = 4
-    Height = 259
-    Top = 48
-    Width = 224
-    Align = alClient
-    BorderSpacing.Around = 4
-    Caption = 'Tile filter'
-    ClientHeight = 245
-    ClientWidth = 222
-    TabOrder = 1
-    object Label1: TLabel
-      AnchorSideLeft.Control = GroupBox1
-      AnchorSideTop.Control = cbTileFilter
-      AnchorSideTop.Side = asrBottom
-      AnchorSideRight.Control = GroupBox1
-      AnchorSideRight.Side = asrBottom
-      Left = 4
-      Height = 30
-      Top = 30
-      Width = 214
-      Anchors = [akTop, akLeft, akRight]
-      BorderSpacing.Around = 4
-      Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
-      ParentColor = False
-      WordWrap = True
-    end
-    object btnClear: TSpeedButton
-      AnchorSideLeft.Control = btnDelete
-      AnchorSideLeft.Side = asrBottom
-      AnchorSideRight.Control = GroupBox1
-      AnchorSideRight.Side = asrCenter
-      AnchorSideBottom.Control = btnDelete
-      AnchorSideBottom.Side = asrBottom
-      Left = 30
-      Height = 22
-      Hint = 'Clear'
-      Top = 219
-      Width = 22
-      Anchors = [akLeft, akBottom]
-      Color = clBtnFace
-      Glyph.Data = {
-        36040000424D3604000000000000360000002800000010000000100000000100
-        20000000000000040000640000006400000000000000000000003ADCFE004800
-        3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
-        9B000000000000000000000000000000000000000000000000000EECFF00B2FC
-        FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
-        EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
-        FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
-        F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
-        00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
-        F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
-        F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
-        F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
-        FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
-        FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
-        FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
-        FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
-        FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
-        FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
-        FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
-        FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
-        FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
-        FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
-        FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
-        FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
-        FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
-        FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
-        00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
-        FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
-        0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
-        FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
-        EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
-        FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
-        DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
-        DF000000000000000000000000002070DF000000000000000000
-      }
-      NumGlyphs = 0
-      OnClick = btnClearClick
-      ShowHint = True
-      ParentShowHint = False
-    end
-    object btnDelete: TSpeedButton
-      AnchorSideLeft.Control = GroupBox1
-      AnchorSideBottom.Control = GroupBox1
-      AnchorSideBottom.Side = asrBottom
-      Left = 4
-      Height = 22
-      Hint = 'Delete'
-      Top = 219
-      Width = 22
-      Anchors = [akLeft, akBottom]
-      BorderSpacing.Around = 4
-      Color = clBtnFace
-      Glyph.Data = {
-        36040000424D3604000000000000360000002800000010000000100000000100
-        20000000000000040000640000006400000000000000000000004F91AB005588
-        9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
-        A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
-        B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
-        B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
-        9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
-        E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
-        83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
-        EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
-        5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
-        E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
-        6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
-        E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
-        D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
-        E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
-        DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
-        FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
-        DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
-        FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
-        DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
-        ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
-        1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
-        F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
-        C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
-        F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
-        AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
-        FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
-        000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
-        F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
-        0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
-        D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
-        DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
-        0200F2000200080104000E040200F8040400F200040009010500
-      }
-      NumGlyphs = 0
-      OnClick = btnDeleteClick
-      ShowHint = True
-      ParentShowHint = False
-    end
-    object vdtFilter: TVirtualDrawTree
-      Tag = 1
-      AnchorSideLeft.Control = GroupBox1
-      AnchorSideTop.Control = Label1
-      AnchorSideTop.Side = asrBottom
-      AnchorSideRight.Control = GroupBox1
-      AnchorSideRight.Side = asrBottom
-      AnchorSideBottom.Control = btnDelete
-      Cursor = 63
-      Left = 4
-      Height = 151
-      Top = 64
-      Width = 214
-      Anchors = [akTop, akLeft, akRight, akBottom]
-      BorderSpacing.Around = 4
-      DefaultNodeHeight = 44
-      DragType = dtVCL
-      Header.AutoSizeIndex = 0
-      Header.Columns = <      
-        item
-          Position = 0
-          Text = 'ID'
-        end      
-        item
-          Position = 1
-          Text = 'Tile'
-          Width = 44
-        end      
-        item
-          Position = 2
-          Text = 'Name'
-          Width = 100
-        end>
-      Header.DefaultHeight = 17
-      Header.Options = [hoColumnResize, hoDrag, hoVisible]
-      Header.ParentFont = True
-      Header.Style = hsFlatButtons
-      TabOrder = 0
-      TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
-      TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
-      OnDragOver = vdtFilterDragOver
-      OnDragDrop = vdtFilterDragDrop
-      OnDrawNode = vdtFilterDrawNode
-    end
-    object cbTileFilter: TCheckBox
-      AnchorSideLeft.Control = GroupBox1
-      AnchorSideTop.Control = GroupBox1
-      Left = 4
-      Height = 22
-      Top = 4
-      Width = 85
-      BorderSpacing.Around = 4
-      Caption = 'Filter active'
-      OnChange = cbTileFilterChange
-      TabOrder = 1
-    end
-  end
-  object GroupBox2: TGroupBox
-    Left = 4
-    Height = 168
-    Top = 320
-    Width = 224
-    Align = alBottom
-    BorderSpacing.Around = 4
-    Caption = 'Hue filter'
-    ClientHeight = 154
-    ClientWidth = 222
-    TabOrder = 2
-    object cbHueFilter: TCheckBox
-      Left = 4
-      Height = 22
-      Top = 4
-      Width = 214
-      Align = alTop
-      BorderSpacing.Around = 4
-      Caption = 'Filter active'
-      OnChange = cbHueFilterChange
-      TabOrder = 0
-    end
-    object vdtHues: TVirtualDrawTree
-      Cursor = 63
-      Left = 4
-      Height = 120
-      Top = 30
-      Width = 214
-      Align = alClient
-      BorderSpacing.Around = 4
-      Header.AutoSizeIndex = 2
-      Header.Columns = <      
-        item
-          Position = 0
-          Width = 20
-        end      
-        item
-          Position = 1
-          Text = 'Hue'
-          Width = 38
-        end      
-        item
-          Position = 2
-          Text = 'Name'
-          Width = 154
-        end>
-      Header.DefaultHeight = 17
-      Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
-      Header.ParentFont = True
-      Header.Style = hsFlatButtons
-      PopupMenu = pmHues
-      TabOrder = 1
-      TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
-      TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
-      TreeOptions.SelectionOptions = [toFullRowSelect]
-      OnChecked = vdtHuesChecked
-      OnDrawNode = vdtHuesDrawNode
-    end
-  end
-  object Splitter1: TSplitter
-    Cursor = crVSplit
-    Left = 0
-    Height = 5
-    Top = 311
-    Width = 232
-    Align = alBottom
-    ResizeAnchor = akBottom
-  end
-  object pmHues: TPopupMenu
-    left = 148
-    top = 404
-    object mnuCheckHues: TMenuItem
-      Caption = 'Check all hues'
-      OnClick = mnuCheckHuesClick
-    end
-    object mnuUncheckHues: TMenuItem
-      Caption = 'Uncheck all hues'
-      OnClick = mnuUncheckHuesClick
-    end
-  end
-end
+object frmFilter: TfrmFilter
+  Left = 290
+  Height = 615
+  Top = 171
+  Width = 290
+  ActiveControl = rgFilterType.RadioButton0
+  BorderIcons = [biSystemMenu, biMinimize]
+  BorderStyle = bsToolWindow
+  Caption = 'Filter'
+  ClientHeight = 615
+  ClientWidth = 290
+  Font.Height = -14
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  object rgFilterType: TRadioGroup
+    Left = 5
+    Height = 50
+    Top = 5
+    Width = 280
+    Align = alTop
+    AutoFill = True
+    BorderSpacing.Around = 5
+    Caption = 'Filter rule'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.TopBottomSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 2
+    ClientHeight = 29
+    ClientWidth = 278
+    Columns = 2
+    ItemIndex = 0
+    Items.Strings = (
+      'Exclusive'
+      'Inclusive'
+    )
+    OnClick = rgFilterTypeClick
+    TabOrder = 0
+  end
+  object GroupBox1: TGroupBox
+    Left = 5
+    Height = 324
+    Top = 60
+    Width = 280
+    Align = alClient
+    BorderSpacing.Around = 5
+    Caption = 'Tile filter'
+    ClientHeight = 303
+    ClientWidth = 278
+    TabOrder = 1
+    object Label1: TLabel
+      AnchorSideLeft.Control = GroupBox1
+      AnchorSideTop.Control = cbTileFilter
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = GroupBox1
+      AnchorSideRight.Side = asrBottom
+      Left = 5
+      Height = 40
+      Top = 32
+      Width = 268
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Around = 5
+      Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
+      Color = clDefault
+      ParentColor = False
+      WordWrap = True
+    end
+    object btnClear: TSpeedButton
+      AnchorSideLeft.Control = btnDelete
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideRight.Control = GroupBox1
+      AnchorSideRight.Side = asrCenter
+      AnchorSideBottom.Control = btnDelete
+      AnchorSideBottom.Side = asrBottom
+      Left = 38
+      Height = 28
+      Hint = 'Clear'
+      Top = 270
+      Width = 28
+      Anchors = [akLeft, akBottom]
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        20000000000000040000640000006400000000000000000000003ADCFE004800
+        3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
+        9B000000000000000000000000000000000000000000000000000EECFF00B2FC
+        FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
+        EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
+        FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
+        F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
+        00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
+        F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
+        F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
+        F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
+        FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
+        FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
+        FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
+        FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
+        FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
+        FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
+        FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
+        FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
+        FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
+        FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
+        FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
+        FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
+        FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
+        FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
+        00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
+        FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
+        0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
+        FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
+        EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
+        FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
+        DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
+        DF000000000000000000000000002070DF000000000000000000
+      }
+      OnClick = btnClearClick
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object btnDelete: TSpeedButton
+      AnchorSideLeft.Control = GroupBox1
+      AnchorSideBottom.Control = GroupBox1
+      AnchorSideBottom.Side = asrBottom
+      Left = 5
+      Height = 28
+      Hint = 'Delete'
+      Top = 270
+      Width = 28
+      Anchors = [akLeft, akBottom]
+      BorderSpacing.Around = 5
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        20000000000000040000640000006400000000000000000000004F91AB005588
+        9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
+        A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
+        B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
+        B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
+        9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
+        E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
+        83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
+        EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
+        5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
+        E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
+        6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
+        E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
+        D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
+        E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
+        DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
+        DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
+        DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
+        ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
+        1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
+        F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
+        C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
+        F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
+        AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
+        FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
+        000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
+        F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
+        0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
+        D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
+        DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
+        0200F2000200080104000E040200F8040400F200040009010500
+      }
+      OnClick = btnDeleteClick
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object vdtFilter: TLazVirtualDrawTree
+      Tag = 1
+      AnchorSideLeft.Control = GroupBox1
+      AnchorSideTop.Control = Label1
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = GroupBox1
+      AnchorSideRight.Side = asrBottom
+      AnchorSideBottom.Control = btnDelete
+      Cursor = 63
+      Left = 5
+      Height = 188
+      Top = 77
+      Width = 268
+      Anchors = [akTop, akLeft, akRight, akBottom]
+      BorderSpacing.Around = 5
+      DefaultNodeHeight = 55
+      DragType = dtVCL
+      Header.AutoSizeIndex = 0
+      Header.Columns = <      
+        item
+          Position = 0
+          Text = 'ID'
+        end      
+        item
+          Position = 1
+          Text = 'Tile'
+          Width = 55
+        end      
+        item
+          Position = 2
+          Text = 'Name'
+          Width = 125
+        end>
+      Header.DefaultHeight = 21
+      Header.Height = 36
+      Header.Options = [hoColumnResize, hoDrag, hoVisible]
+      Header.ParentFont = True
+      Header.Style = hsFlatButtons
+      TabOrder = 0
+      TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
+      TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
+      OnDragOver = vdtFilterDragOver
+      OnDragDrop = vdtFilterDragDrop
+      OnDrawNode = vdtFilterDrawNode
+    end
+    object cbTileFilter: TCheckBox
+      AnchorSideLeft.Control = GroupBox1
+      AnchorSideTop.Control = GroupBox1
+      Left = 5
+      Height = 22
+      Top = 5
+      Width = 101
+      BorderSpacing.Around = 5
+      Caption = 'Filter active'
+      OnChange = cbTileFilterChange
+      TabOrder = 1
+    end
+  end
+  object GroupBox2: TGroupBox
+    Left = 5
+    Height = 210
+    Top = 400
+    Width = 280
+    Align = alBottom
+    BorderSpacing.Around = 5
+    Caption = 'Hue filter'
+    ClientHeight = 189
+    ClientWidth = 278
+    TabOrder = 2
+    object cbHueFilter: TCheckBox
+      Left = 5
+      Height = 22
+      Top = 5
+      Width = 268
+      Align = alTop
+      BorderSpacing.Around = 5
+      Caption = 'Filter active'
+      OnChange = cbHueFilterChange
+      TabOrder = 0
+    end
+    object vdtHues: TLazVirtualDrawTree
+      Cursor = 63
+      Left = 5
+      Height = 152
+      Top = 32
+      Width = 268
+      Align = alClient
+      BorderSpacing.Around = 5
+      Header.AutoSizeIndex = 2
+      Header.Columns = <      
+        item
+          Position = 0
+          Width = 25
+        end      
+        item
+          Position = 1
+          Text = 'Hue'
+          Width = 48
+        end      
+        item
+          Position = 2
+          Text = 'Name'
+          Width = 193
+        end>
+      Header.DefaultHeight = 21
+      Header.Height = 36
+      Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
+      Header.ParentFont = True
+      Header.Style = hsFlatButtons
+      PopupMenu = pmHues
+      TabOrder = 1
+      TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
+      TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
+      TreeOptions.SelectionOptions = [toFullRowSelect]
+      OnChecked = vdtHuesChecked
+      OnDrawNode = vdtHuesDrawNode
+    end
+  end
+  object Splitter1: TSplitter
+    Cursor = crVSplit
+    Left = 0
+    Height = 6
+    Top = 389
+    Width = 290
+    Align = alBottom
+    ResizeAnchor = akBottom
+  end
+  object pmHues: TPopupMenu
+    Left = 185
+    Top = 505
+    object mnuCheckHues: TMenuItem
+      Caption = 'Check all hues'
+      OnClick = mnuCheckHuesClick
+    end
+    object mnuUncheckHues: TMenuItem
+      Caption = 'Uncheck all hues'
+      OnClick = mnuUncheckHuesClick
+    end
+  end
+end

Client/Tools/UfrmFilter.pas

@@ -1,353 +1,355 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UfrmFilter;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
-  Menus;
-
-type
-
-  { TfrmFilter }
-
-  TfrmFilter = class(TForm)
-    btnClear: TSpeedButton;
-    btnDelete: TSpeedButton;
-    btnRandomPresetDelete: TSpeedButton;
-    btnRandomPresetSave: TSpeedButton;
-    cbRandomPreset: TComboBox;
-    cbTileFilter: TCheckBox;
-    cbHueFilter: TCheckBox;
-    GroupBox1: TGroupBox;
-    GroupBox2: TGroupBox;
-    Label1: TLabel;
-    mnuUncheckHues: TMenuItem;
-    mnuCheckHues: TMenuItem;
-    pnlRandomPreset: TPanel;
-    pmHues: TPopupMenu;
-    rgFilterType: TRadioGroup;
-    Splitter1: TSplitter;
-    vdtFilter: TVirtualDrawTree;
-    vdtHues: TVirtualDrawTree;
-    procedure btnClearClick(Sender: TObject);
-    procedure btnDeleteClick(Sender: TObject);
-    procedure cbHueFilterChange(Sender: TObject);
-    procedure cbTileFilterChange(Sender: TObject);
-    procedure FormCreate(Sender: TObject);
-    procedure FormDestroy(Sender: TObject);
-    procedure FormShow(Sender: TObject);
-    procedure mnuUncheckHuesClick(Sender: TObject);
-    procedure mnuCheckHuesClick(Sender: TObject);
-    procedure rgFilterTypeClick(Sender: TObject);
-    procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
-      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
-      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
-    procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
-      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
-      var Effect: Integer; var Accept: Boolean);
-    procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
-      const PaintInfo: TVTPaintInfo);
-    procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
-    procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
-      const PaintInfo: TVTPaintInfo);
-  protected
-    FLocked: Boolean;
-    FCheckedHues: TBits;
-    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
-  public
-    property Locked: Boolean read FLocked write FLocked;
-    function Filter(AStatic: TStaticItem): Boolean;
-    procedure JumpToHue(AHueID: Word);
-  end; 
-
-var
-  frmFilter: TfrmFilter;
-
-implementation
-
-uses
-  UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
-  
-type
-  PTileInfo = ^TTileInfo;
-  TTileInfo = record
-    ID: Word;
-  end;
-  PHueInfo = ^THueInfo;
-  THueInfo = record
-    ID: Word;
-    Hue: THue;
-  end;
-
-{ TfrmFilter }
-
-procedure TfrmFilter.FormShow(Sender: TObject);
-var
-  upperLeft, lowerLeft: TPoint;
-begin
-  upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
-  lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
-    frmMain.pcLeft.Height));
-  Left := upperLeft.x - 8;
-  Top := upperLeft.y - 8;
-  Height := lowerLeft.y - upperLeft.y;
-
-  SetWindowParent(Handle, frmMain.Handle);
-end;
-
-procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
-begin
-  vdtHues.ClearChecked;
-end;
-
-procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
-var
-  node: PVirtualNode;
-begin
-  node := vdtHues.GetFirst;
-  while node <> nil do
-  begin
-    vdtHues.CheckState[node] := csCheckedNormal;
-    node := vdtHues.GetNext(node);
-  end;
-end;
-
-procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
-begin
-  frmMain.InvalidateFilter;
-end;
-
-procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
-  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
-  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
-var
-  sourceTree: TVirtualDrawTree;
-  selected, node: PVirtualNode;
-  sourceTileInfo, targetTileInfo: PTileInfo;
-begin
-  sourceTree := Source as TVirtualDrawTree;
-  if (sourceTree <> Sender) and (sourceTree <> nil) and
-     (sourceTree.Tag = 1) then
-  begin
-    Sender.BeginUpdate;
-    selected := sourceTree.GetFirstSelected;
-    while selected <> nil do
-    begin
-      sourceTileInfo := sourceTree.GetNodeData(selected);
-      if sourceTileInfo^.ID > $3FFF then
-      begin
-        node := Sender.AddChild(nil);
-        targetTileInfo := Sender.GetNodeData(node);
-        targetTileInfo^.ID := sourceTileInfo^.ID;
-        cbTileFilter.Checked := True;
-        frmMain.InvalidateFilter;
-      end;
-      selected := sourceTree.GetNextSelected(selected);
-    end;
-    Sender.EndUpdate;
-  end;
-end;
-
-procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
-  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
-  Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
-begin
-  if (Source <> Sender) and (Source is TVirtualDrawTree) and
-    (TVirtualDrawTree(Source).Tag = 1) then
-  begin
-    Accept := True;
-  end;
-end;
-
-procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
-  const PaintInfo: TVTPaintInfo);
-begin
-  frmMain.vdtTilesDrawNode(Sender, PaintInfo);
-end;
-
-procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
-var
-  hueInfo: PHueInfo;
-begin
-  hueInfo := Sender.GetNodeData(Node);
-  FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
-  cbHueFilter.Checked := True;
-  frmMain.InvalidateFilter;
-end;
-
-procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
-  const PaintInfo: TVTPaintInfo);
-var
-  hueInfo: PHueInfo;
-  hueColor: TColor;
-  i: Integer;
-  textStyle: TTextStyle;
-begin
-  hueInfo := Sender.GetNodeData(PaintInfo.Node);
-  textStyle := PaintInfo.Canvas.TextStyle;
-  textStyle.Alignment := taLeftJustify;
-  textStyle.Layout := tlCenter;
-  textStyle.Wordbreak := True;
-  case PaintInfo.Column of
-    1:
-      begin
-        for i := 0 to 31 do
-        begin
-          hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
-          PaintInfo.Canvas.Pen.Color := hueColor;
-          PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
-          PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
-        end;
-      end;
-    2:
-      begin
-        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
-      end;
-  end;
-end;
-
-procedure TfrmFilter.MouseLeave(var msg: TLMessage);
-begin
-  {if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
-    Close;}
-end;
-
-function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
-var
-  found: Boolean;
-  tileInfo: PTileInfo;
-  node: PVirtualNode;
-  id: Word;
-begin
-  if cbTileFilter.Checked then
-  begin
-    id := AStatic.TileID + $4000;
-
-    found := False;
-    node := vdtFilter.GetFirst;
-    while (node <> nil) and (not found) do
-    begin
-      tileInfo := vdtFilter.GetNodeData(node);
-      if tileInfo^.ID = id then
-        found := True
-      else
-        node := vdtFilter.GetNext(node);
-    end;
-
-    Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
-              ((rgFilterType.ItemIndex = 1) and found);
-  end else
-    Result := True;
-    
-  if cbHueFilter.Checked then
-  begin
-    Result := Result and (
-                ((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
-                ((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
-              );
-  end;
-end;
-
-procedure TfrmFilter.JumpToHue(AHueID: Word);
-var
-  hueInfo: PHueInfo;
-  node: PVirtualNode;
-begin
-  node := vdtHues.GetFirst;
-  while node <> nil do
-  begin
-    hueInfo := vdtHues.GetNodeData(node);
-    if hueInfo^.ID = AHueID then
-    begin
-      vdtHues.ClearSelection;
-      vdtHues.Selected[node] := True;
-      vdtHues.FocusedNode := node;
-      node := nil;
-    end else
-      node := vdtHues.GetNext(node);
-  end;
-end;
-
-procedure TfrmFilter.FormCreate(Sender: TObject);
-var
-  i: Integer;
-  hueInfo: PHueInfo;
-  node: PVirtualNode;
-begin
-  FLocked := False;
-  vdtFilter.NodeDataSize := SizeOf(TTileInfo);
-  vdtHues.NodeDataSize := SizeOf(THueInfo);
-  
-  vdtHues.BeginUpdate;
-  vdtHues.Clear;
-  for i := 0 to ResMan.Hue.Count - 1 do
-  begin
-    node := vdtHues.AddChild(nil);
-    hueInfo := vdtHues.GetNodeData(node);
-    hueInfo^.ID := i + 1;
-    hueInfo^.Hue := ResMan.Hue.Hues[i];
-    vdtHues.CheckType[node] := ctCheckBox;
-  end;
-  vdtHues.EndUpdate;
-  FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
-  //FCheckedHues.Bits[0] := True;
-end;
-
-procedure TfrmFilter.FormDestroy(Sender: TObject);
-begin
-  if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
-end;
-
-procedure TfrmFilter.btnDeleteClick(Sender: TObject);
-begin
-  vdtFilter.DeleteSelectedNodes;
-end;
-
-procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
-begin
-  frmMain.InvalidateFilter;
-end;
-
-procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
-begin
-  frmMain.InvalidateFilter;
-end;
-
-procedure TfrmFilter.btnClearClick(Sender: TObject);
-begin
-  vdtFilter.Clear;
-end;
-
-initialization
-  {$I UfrmFilter.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UfrmFilter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ExtCtrls, laz.VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes,
+  UStatics, Menus;
+
+type
+
+  { TfrmFilter }
+
+  TfrmFilter = class(TForm)
+    btnClear: TSpeedButton;
+    btnDelete: TSpeedButton;
+    btnRandomPresetDelete: TSpeedButton;
+    btnRandomPresetSave: TSpeedButton;
+    cbRandomPreset: TComboBox;
+    cbTileFilter: TCheckBox;
+    cbHueFilter: TCheckBox;
+    GroupBox1: TGroupBox;
+    GroupBox2: TGroupBox;
+    Label1: TLabel;
+    mnuUncheckHues: TMenuItem;
+    mnuCheckHues: TMenuItem;
+    pnlRandomPreset: TPanel;
+    pmHues: TPopupMenu;
+    rgFilterType: TRadioGroup;
+    Splitter1: TSplitter;
+    vdtFilter: TLazVirtualDrawTree;
+    vdtHues: TLazVirtualDrawTree;
+    procedure btnClearClick(Sender: TObject);
+    procedure btnDeleteClick(Sender: TObject);
+    procedure cbHueFilterChange(Sender: TObject);
+    procedure cbTileFilterChange(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure mnuUncheckHuesClick(Sender: TObject);
+    procedure mnuCheckHuesClick(Sender: TObject);
+    procedure rgFilterTypeClick(Sender: TObject);
+    procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
+      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
+      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
+    procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
+      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
+      var Effect: Integer; var Accept: Boolean);
+    procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
+      const PaintInfo: TVTPaintInfo);
+    procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
+    procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
+      const PaintInfo: TVTPaintInfo);
+  protected
+    FLocked: Boolean;
+    FCheckedHues: TBits;
+    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
+  public
+    property Locked: Boolean read FLocked write FLocked;
+    function Filter(AStatic: TStaticItem): Boolean;
+    procedure JumpToHue(AHueID: Word);
+  end; 
+
+var
+  frmFilter: TfrmFilter;
+
+implementation
+
+uses
+  UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
+  
+type
+  PTileInfo = ^TTileInfo;
+  TTileInfo = record
+    ID: Word;
+  end;
+  PHueInfo = ^THueInfo;
+  THueInfo = record
+    ID: Word;
+    Hue: THue;
+  end;
+
+{ TfrmFilter }
+
+procedure TfrmFilter.FormShow(Sender: TObject);
+var
+  upperLeft, lowerLeft: TPoint;
+begin
+  upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
+  lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
+    frmMain.pcLeft.Height));
+  Left := upperLeft.x - 8;
+  Top := upperLeft.y - 8;
+  Height := lowerLeft.y - upperLeft.y;
+
+  SetWindowParent(Handle, frmMain.Handle);
+end;
+
+procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
+begin
+  vdtHues.ClearChecked;
+end;
+
+procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
+var
+  node: PVirtualNode;
+begin
+  node := vdtHues.GetFirst;
+  while node <> nil do
+  begin
+    vdtHues.CheckState[node] := csCheckedNormal;
+    node := vdtHues.GetNext(node);
+  end;
+end;
+
+procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
+  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
+  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
+var
+  sourceTree: TVirtualDrawTree;
+  selected, node: PVirtualNode;
+  sourceTileInfo, targetTileInfo: PTileInfo;
+begin
+  sourceTree := Source as TVirtualDrawTree;
+  if (sourceTree <> Sender) and (sourceTree <> nil) and
+     (sourceTree.Tag = 1) then
+  begin
+    Sender.BeginUpdate;
+    selected := sourceTree.GetFirstSelected;
+    while selected <> nil do
+    begin
+      sourceTileInfo := sourceTree.GetNodeData(selected);
+      if sourceTileInfo^.ID > $3FFF then
+      begin
+        node := Sender.AddChild(nil);
+        targetTileInfo := Sender.GetNodeData(node);
+        targetTileInfo^.ID := sourceTileInfo^.ID;
+        cbTileFilter.Checked := True;
+        frmMain.InvalidateFilter;
+      end;
+      selected := sourceTree.GetNextSelected(selected);
+    end;
+    Sender.EndUpdate;
+  end;
+end;
+
+procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
+  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
+  Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
+begin
+  if (Source <> Sender) and (Source is TVirtualDrawTree) and
+    (TVirtualDrawTree(Source).Tag = 1) then
+  begin
+    Accept := True;
+  end;
+end;
+
+procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
+  const PaintInfo: TVTPaintInfo);
+begin
+  frmMain.vdtTilesDrawNode(Sender, PaintInfo);
+end;
+
+procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
+var
+  hueInfo: PHueInfo;
+begin
+  hueInfo := Sender.GetNodeData(Node);
+  FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
+  cbHueFilter.Checked := True;
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
+  const PaintInfo: TVTPaintInfo);
+var
+  hueInfo: PHueInfo;
+  hueColor: TColor;
+  i: Integer;
+  textStyle: TTextStyle;
+begin
+  hueInfo := Sender.GetNodeData(PaintInfo.Node);
+  textStyle := PaintInfo.Canvas.TextStyle;
+  textStyle.Alignment := taLeftJustify;
+  textStyle.Layout := tlCenter;
+  textStyle.Wordbreak := True;
+  case PaintInfo.Column of
+    1:
+      begin
+        for i := 0 to 31 do
+        begin
+          hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
+          PaintInfo.Canvas.Pen.Color := hueColor;
+          PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
+          PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
+        end;
+      end;
+    2:
+      begin
+        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
+      end;
+  end;
+end;
+
+procedure TfrmFilter.MouseLeave(var msg: TLMessage);
+begin
+  {if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
+    Close;}
+end;
+
+function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
+var
+  found: Boolean;
+  tileInfo: PTileInfo;
+  node: PVirtualNode;
+  id: Word;
+begin
+  if cbTileFilter.Checked then
+  begin
+    id := AStatic.TileID + $4000;
+
+    found := False;
+    node := vdtFilter.GetFirst;
+    while (node <> nil) and (not found) do
+    begin
+      tileInfo := vdtFilter.GetNodeData(node);
+      if tileInfo^.ID = id then
+        found := True
+      else
+        node := vdtFilter.GetNext(node);
+    end;
+
+    Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
+              ((rgFilterType.ItemIndex = 1) and found);
+  end else
+    Result := True;
+    
+  if cbHueFilter.Checked then
+  begin
+    Result := Result and (
+                ((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
+                ((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
+              );
+  end;
+end;
+
+procedure TfrmFilter.JumpToHue(AHueID: Word);
+var
+  hueInfo: PHueInfo;
+  node: PVirtualNode;
+begin
+  node := vdtHues.GetFirst;
+  while node <> nil do
+  begin
+    hueInfo := vdtHues.GetNodeData(node);
+    if hueInfo^.ID = AHueID then
+    begin
+      vdtHues.ClearSelection;
+      vdtHues.Selected[node] := True;
+      vdtHues.FocusedNode := node;
+      node := nil;
+    end else
+      node := vdtHues.GetNext(node);
+  end;
+end;
+
+procedure TfrmFilter.FormCreate(Sender: TObject);
+var
+  i: Integer;
+  hueInfo: PHueInfo;
+  node: PVirtualNode;
+begin
+  FLocked := False;
+  vdtFilter.NodeDataSize := SizeOf(TTileInfo);
+  vdtHues.NodeDataSize := SizeOf(THueInfo);
+  
+  vdtHues.BeginUpdate;
+  vdtHues.Clear;
+  for i := 0 to ResMan.Hue.Count - 1 do
+  begin
+    node := vdtHues.AddChild(nil);
+    hueInfo := vdtHues.GetNodeData(node);
+    hueInfo^.ID := i + 1;
+    hueInfo^.Hue := ResMan.Hue.Hues[i];
+    vdtHues.CheckType[node] := ctCheckBox;
+  end;
+  vdtHues.EndUpdate;
+  FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
+  //FCheckedHues.Bits[0] := True;
+end;
+
+procedure TfrmFilter.FormDestroy(Sender: TObject);
+begin
+  if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
+end;
+
+procedure TfrmFilter.btnDeleteClick(Sender: TObject);
+begin
+  vdtFilter.DeleteSelectedNodes;
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
+begin
+  frmMain.InvalidateFilter;
+end;
+
+procedure TfrmFilter.btnClearClick(Sender: TObject);
+begin
+  vdtFilter.Clear;
+  frmMain.InvalidateFilter;
+end;
+
+initialization
+  {$I UfrmFilter.lrs}
+
+end.
+

Client/Tools/UfrmHueSettings.lfm

@@ -1,30 +1,34 @@
 inherited frmHueSettings: TfrmHueSettings
   Left = 290
-  Height = 209
+  Height = 389
   Top = 171
-  Width = 217
+  Width = 255
+  AutoSize = True
   Caption = 'Hue Settings'
-  ClientHeight = 209
-  ClientWidth = 217
+  ClientHeight = 389
+  ClientWidth = 255
+  Constraints.MinWidth = 255
   OnCreate = FormCreate
+  OnDestroy = FormDestroy
   object lblHue: TLabel[0]
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = edHue
     AnchorSideTop.Side = asrCenter
     Left = 8
-    Height = 16
-    Top = 12
-    Width = 26
+    Height = 23
+    Top = 14
+    Width = 35
     BorderSpacing.Left = 8
     Caption = 'Hue:'
+    Color = clDefault
     ParentColor = False
   end
   object edHue: TEdit[1]
     AnchorSideLeft.Control = lblHue
     AnchorSideLeft.Side = asrBottom
     AnchorSideTop.Control = Owner
-    Left = 42
-    Height = 25
+    Left = 51
+    Height = 35
     Top = 8
     Width = 80
     BorderSpacing.Left = 8
@@ -41,19 +45,351 @@ inherited frmHueSettings: TfrmHueSettings
     AnchorSideBottom.Control = Owner
     AnchorSideBottom.Side = asrBottom
     Left = 8
-    Height = 160
-    Top = 41
-    Width = 201
-    Anchors = [akTop, akLeft, akRight, akBottom]
+    Height = 139
+    Top = 51
+    Width = 239
+    Anchors = [akTop, akLeft, akRight]
     BorderSpacing.Around = 8
+    DragMode = dmAutomatic
+    Font.Height = 14
     ItemHeight = 16
     OnDrawItem = lbHueDrawItem
     OnSelectionChange = lbHueSelectionChange
+    ParentFont = False
     Style = lbOwnerDrawFixed
     TabOrder = 1
+    TopIndex = -1
   end
-  inherited tmClose: TTimer[3]
-    left = 152
-    top = 112
+  object gbRandom: TGroupBox[3]
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = lbHue
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Side = asrBottom
+    Left = 8
+    Height = 183
+    Top = 198
+    Width = 239
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Left = 8
+    BorderSpacing.Top = 4
+    BorderSpacing.Right = 8
+    BorderSpacing.Bottom = 8
+    Caption = 'Random pool'
+    ClientHeight = 159
+    ClientWidth = 237
+    TabOrder = 2
+    Visible = False
+    object btnAddRandom: TSpeedButton
+      AnchorSideLeft.Control = gbRandom
+      AnchorSideTop.Control = gbRandom
+      Left = 4
+      Height = 22
+      Hint = 'Add'
+      Top = 0
+      Width = 23
+      BorderSpacing.Left = 4
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84
+        37FF000000000000000000000000000000000000000000000000000000000000
+        00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE
+        89FF368D42FF2C8134FF00000000000000000000000000000000000000000000
+        0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB
+        98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000
+        000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5
+        6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000
+        000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8
+        70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC
+        75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8
+        70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF
+        7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2
+        7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5
+        83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC
+        6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000
+        000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD
+        85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000
+        000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4
+        95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000
+        00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF
+        AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000
+        0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD
+        B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000
+        0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE
+        77FF000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000
+      }
+      OnClick = btnAddRandomClick
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object btnDeleteRandom: TSpeedButton
+      AnchorSideLeft.Control = btnAddRandom
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = btnAddRandom
+      Left = 31
+      Height = 22
+      Hint = 'Delete'
+      Top = 0
+      Width = 23
+      BorderSpacing.Left = 4
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E
+        B8FF000000000000000000000000000000000000000000000000000000000000
+        000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
+        E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000
+        0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
+        EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000
+        00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
+        E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000
+        00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
+        E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62
+        D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
+        E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63
+        DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469
+        DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A
+        DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
+        ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000
+        00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
+        F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000
+        00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
+        F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000
+        0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
+        FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000
+        000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
+        F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000
+        000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63
+        D9FF000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000
+      }
+      OnClick = btnDeleteRandomClick
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object btnClearRandom: TSpeedButton
+      AnchorSideLeft.Control = btnDeleteRandom
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = btnDeleteRandom
+      Left = 58
+      Height = 22
+      Hint = 'Clear'
+      Top = 0
+      Width = 23
+      BorderSpacing.Left = 4
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
+        EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000
+        0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
+        F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000
+        00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
+        F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000
+        F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
+        F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000
+        FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
+        FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000
+        FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
+        FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000
+        FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
+        FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000
+        FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
+        FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000
+        FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
+        FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000
+        FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
+        FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000
+        FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
+        FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
+        00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
+        FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
+        0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
+        FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000
+        000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
+        FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000
+      }
+      OnClick = btnClearRandomClick
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object btnRandomPresetSave: TSpeedButton
+      AnchorSideTop.Control = cbRandomPreset
+      AnchorSideRight.Control = btnRandomPresetDelete
+      Left = 185
+      Height = 22
+      Hint = 'Save Preset'
+      Top = 116
+      Width = 22
+      Anchors = [akTop, akRight]
+      BorderSpacing.Right = 4
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        000000000000000000000000000000000000BA6833FFC38458FFD38B68FFE18F
+        70FFDC8D6CFFDA8B6DFFD78A6EFFCD8B6CFFAB6D44FFA65F2EFF00000000BA65
+        30FFBB6631FFBA6630FFBA6630FFBA6530FFC68355FFEFCEBAFFDDFFFFFF87EE
+        C7FFA2F4D7FFA2F6D7FF8CEEC7FFE0FFFFFFDDA285FFAB6A3EFFBC6933FFF8F1
+        EAFFF7ECDFFFF6EADEFFF6EADCFFF6EADCFFC37F51FFEFB69AFFEAF3E8FF51BF
+        84FF6FC998FF71C999FF54BF84FFE4F4E9FFDD9C7BFFAA693AFFBF7138FFF5EB
+        DFFFFDBF68FFFBBE65FFFCBE64FFFCBE64FFC48154FFEAB697FFF3F3EAFFEDF1
+        E6FFEFF1E6FFEFF0E6FFEDF1E5FFF3F5EDFFD59C79FFB07044FFC1783CFFF7ED
+        E3FFFDC26EFFFFD79EFFFFD69BFFFFD798FFC98B61FFE6B592FFE2A781FFE1A7
+        81FFDEA37DFFDCA17BFFDB9F79FFD99E77FFD49A73FFBB7E57FFC47C40FFF7F0
+        E6FFF8B455FFF7B554FFF8B453FFF8B253FFCA8D65FFEAB899FFDDA57EFFDDA6
+        80FFDBA37CFFD9A07AFFD9A079FFD89F78FFD89E78FFBF845DFFC58245FFF8F2
+        EBFFFEE7D6FFFDE7D6FFFDE7D6FFFDE6D5FFC8885DFFEFBFA1FFFDFCFAFFFEFC
+        FBFFFEFDFDFFFEFDFCFFFDFBFAFFFDFCFBFFDDA885FFC17F53FFC68447FFF9F3
+        ECFFFEE8D6FFFDE7D6FFFDE7D6FFFDE7D5FFC7865BFFEFC09EFFFFFFFFFFCC93
+        6EFFFFFFFFFFFFFFFFFFFFFBF7FFFFF8F1FFE4AF8CFFC78A61FFC68849FFF9F4
+        EDFFFEE8D8FFFEE8D7FFFEE7D6FFFDE5D3FFCC8D65FFF3CDB0FFFFFFFFFFE3C7
+        B3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEABFA1FFC98960FFC6884AFFF9F4
+        EFFFFEE7D7FFFDE7D5FFFDE6D4FFFCE6D2FFD4976EFFD49E7BFFD09871FFD6A4
+        82FFCD8E68FFCD9069FFD09A75FFD19973FFC88B62FF00000000C6894BFFF9F4
+        F0FFFCE6D3FFFDE7D3FFFCE4D1FFFBE3CDFFFAE0C8FFF8DCC2FFF5D6BBFFF3D4
+        B5FFF1D2B3FFF8F4F0FFC48246FF000000000000000000000000C6894BFFF9F5
+        F1FFFCE3CFFFFCE4CFFFFCE3CDFFFAE1CAFFF9DDC4FFF6D9BCFFF4E9DFFFF7F2
+        ECFFFBF7F3FFF5EFE9FFC27E45FF000000000000000000000000C6894CFFF9F5
+        F1FFFCE3CDFFFBE3CDFFFBE2CBFFF9E0C8FFF8DCC2FFF5D6BAFFFDFBF8FFFCE6
+        CDFFFAE5C9FFE2B684FFBF7942FF000000000000000000000000C5884BFFFAF6
+        F2FFFAE0C7FFFBE2C9FFFBE0C8FFF9DFC5FFF8DBC1FFF4D6B8FFFFFBF8FFF6D8
+        B4FFE1B07DFFDB9264FF00000000000000000000000000000000C48549FFF7F2
+        ECFFF8F4EEFFF8F3EDFFF8F3EDFFF8F3EDFFF8F2ECFFF7F2ECFFF2E6D7FFE2B2
+        7DFFDB9465FF000000000000000000000000000000000000000000000000C88B
+        4DFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B4FFFC5894BFFC476
+        3BFF000000000000000000000000000000000000000000000000
+      }
+      OnClick = btnRandomPresetSaveClick
+      ShowCaption = False
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object btnRandomPresetDelete: TSpeedButton
+      AnchorSideTop.Control = btnRandomPresetSave
+      AnchorSideRight.Control = gbRandom
+      AnchorSideRight.Side = asrBottom
+      Left = 211
+      Height = 22
+      Hint = 'Delete Preset'
+      Top = 116
+      Width = 22
+      Anchors = [akTop, akRight]
+      BorderSpacing.Right = 4
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000BA6530FFBB6631FFBA6630FFBA6630FFBA6630FFBA6530FFBA652FFFB965
+        2EFF6E5E76FF1949A8FF0542BBFF1348ADFF394E8FFF0000000000000000BC69
+        33FFF8F1EAFFF7ECDFFFF6EBDEFFF6EADEFFF6EADCFFF6EADCFFFAF3EBFF8AA5
+        D7FF2866CAFF2177E6FF0579EAFF0164DDFF064DBBFF0000000000000000BF71
+        38FFF5EBDFFFFDBF68FFFCBD67FFFBBE65FFFCBE64FFFCBE64FFFCBD62FF1E52
+        B0FF639DF4FF187FFFFF0076F8FF0076EEFF0368E1FF0345B9FF00000000C178
+        3CFFF7EDE3FFFDC26EFFFFD8A0FFFFD79EFFFFD69BFFFFD798FFFFD696FF0543
+        BCFFAECDFEFFFFFFFFFFFFFFFFFFFFFFFFFF187FEFFF0442BCFF00000000C47C
+        40FFF7F0E6FFF8B455FFF7B456FFF7B554FFF8B453FFF8B253FFF7B352FF2453
+        ABFF8DB5F6FF4D92FFFF1177FFFF2186FFFF408AEBFF0344B9FF00000000C580
+        42FFF8F1E8FFFEE5D5FFFDE5D3FFFDE5D3FFFCE5D3FFFCE5D3FFFCE4D1FF94A1
+        C9FF3D76D1FF8DB5F7FFB8D6FEFF72A8F5FF2F6BC9FF0000000000000000C582
+        45FFF8F2EBFFFEE7D6FFFDE7D6FFFDE7D6FFFDE7D6FFFDE6D5FFFDE5D3FFFCE4
+        D1FF94A1C9FF2A5EC1FF0543BCFF1F59BFFF686279FF0000000000000000C684
+        47FFF9F3ECFFFEE8D6FFFEE8D7FFFDE7D6FFFDE7D6FFFDE7D5FFFDE5D3FFFBE4
+        D0FFFBE3CCFFFADFC7FFFADFC6FFFAF2EAFFC68042FF0000000000000000C688
+        49FFF9F4EDFFFEE8D8FFFEE8D8FFFEE8D7FFFEE7D6FFFDE5D3FFFCE4D1FFFBE1
+        CCFFFAE0C7FFF9DDC3FFF8DCC2FFFAF4EDFFC68245FF0000000000000000C688
+        4AFFF9F4EFFFFEE7D7FFFDE7D6FFFDE7D5FFFDE6D4FFFCE6D2FFFBE1CCFFFADF
+        C7FFF8DCC2FFF6DABDFFF6D8BBFFFAF4EFFFC68346FF0000000000000000C689
+        4BFFF9F4F0FFFCE6D3FFFCE6D4FFFDE7D3FFFCE4D1FFFBE3CDFFFAE0C8FFF8DC
+        C2FFF5D6BBFFF3D4B5FFF1D2B3FFF8F4F0FFC48246FF0000000000000000C689
+        4BFFF9F5F1FFFCE3CFFFFBE4D0FFFCE4CFFFFCE3CDFFFAE1CAFFF9DDC4FFF6D9
+        BCFFF4E9DFFFF7F2ECFFFBF7F3FFF5EFE9FFC27E45FF0000000000000000C689
+        4CFFF9F5F1FFFCE3CDFFFBE3CEFFFBE3CDFFFBE2CBFFF9E0C8FFF8DCC2FFF5D6
+        BAFFFDFBF8FFFCE6CDFFFAE5C9FFE2B684FFBF7942FF0000000000000000C588
+        4BFFFAF6F2FFFAE0C7FFFBE1C9FFFBE2C9FFFBE0C8FFF9DFC5FFF8DBC1FFF4D6
+        B8FFFFFBF8FFF6D8B4FFE1B07DFFDB9264FF000000000000000000000000C485
+        49FFF7F2ECFFF8F4EEFFF8F4EDFFF8F3EDFFF8F3EDFFF8F3EDFFF8F2ECFFF7F2
+        ECFFF2E6D7FFE2B27DFFDB9465FF000000000000000000000000000000000000
+        0000C88B4DFFC88C4FFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B
+        4FFFC5894BFFC4763BFF00000000000000000000000000000000
+      }
+      OnClick = btnRandomPresetDeleteClick
+      ShowCaption = False
+      ShowHint = True
+      ParentShowHint = False
+    end
+    object cbRandomPreset: TComboBox
+      AnchorSideLeft.Control = gbRandom
+      AnchorSideRight.Control = btnRandomPresetSave
+      AnchorSideBottom.Control = gbRandom
+      AnchorSideBottom.Side = asrBottom
+      Left = 4
+      Height = 39
+      Top = 116
+      Width = 177
+      Anchors = [akLeft, akRight, akBottom]
+      BorderSpacing.Left = 4
+      BorderSpacing.Right = 4
+      BorderSpacing.Bottom = 4
+      ItemHeight = 0
+      OnChange = cbRandomPresetChange
+      Sorted = True
+      Style = csDropDownList
+      TabOrder = 0
+    end
+    object lbRandom: TListBox
+      AnchorSideLeft.Control = gbRandom
+      AnchorSideTop.Control = btnAddRandom
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = gbRandom
+      AnchorSideRight.Side = asrBottom
+      AnchorSideBottom.Control = cbRandomPreset
+      Left = 4
+      Height = 86
+      Top = 26
+      Width = 229
+      Anchors = [akTop, akLeft, akRight, akBottom]
+      BorderSpacing.Around = 4
+      ItemHeight = 0
+      MultiSelect = True
+      OnDragDrop = lbRandomDragDrop
+      OnDragOver = lbRandomDragOver
+      OnDrawItem = lbHueDrawItem
+      TabOrder = 1
+      TopIndex = -1
+    end
+  end
+  object cbRandom: TCheckBox[4]
+    AnchorSideTop.Control = edHue
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = lbHue
+    AnchorSideRight.Side = asrBottom
+    Left = 158
+    Height = 25
+    Top = 13
+    Width = 89
+    Anchors = [akTop, akRight]
+    Caption = 'Random'
+    OnChange = cbRandomChange
+    TabOrder = 3
+  end
+  inherited tmClose: TTimer[5]
+    Left = 152
+    Top = 112
   end
 end

Client/Tools/UfrmHueSettings.pas

@@ -21,7 +21,7 @@
  * CDDL HEADER END
  *
  *
- *      Portions Copyright 2009 Andreas Schneider
+ *      Portions Copyright 2011 Andreas Schneider
  *)
 unit UfrmHueSettings;
 
@@ -31,21 +31,51 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  UfrmToolWindow, UHue;
+  ExtCtrls, Buttons, UfrmToolWindow, UHue,
+  XMLRead, XMLWrite, DOM;
 
 type
 
   { TfrmHueSettings }
 
   TfrmHueSettings = class(TfrmToolWindow)
+    btnAddRandom: TSpeedButton;
+    btnClearRandom: TSpeedButton;
+    btnDeleteRandom: TSpeedButton;
+    btnRandomPresetDelete: TSpeedButton;
+    btnRandomPresetSave: TSpeedButton;
+    cbRandomPreset: TComboBox;
+    cbRandom: TCheckBox;
     edHue: TEdit;
+    gbRandom: TGroupBox;
     lblHue: TLabel;
     lbHue: TListBox;
+    lbRandom: TListBox;
+    procedure btnAddRandomClick(Sender: TObject);
+    procedure btnClearRandomClick(Sender: TObject);
+    procedure btnDeleteRandomClick(Sender: TObject);
+    procedure btnRandomPresetDeleteClick(Sender: TObject);
+    procedure btnRandomPresetSaveClick(Sender: TObject);
+    procedure cbRandomChange(Sender: TObject);
+    procedure cbRandomPresetChange(Sender: TObject);
     procedure edHueEditingDone(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
     procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
       State: TOwnerDrawState);
     procedure lbHueSelectionChange(Sender: TObject; User: boolean);
+    procedure lbRandomDragDrop(Sender, Source: TObject; X, Y: Integer);
+    procedure lbRandomDragOver(Sender, Source: TObject; X, Y: Integer;
+      State: TDragState; var Accept: Boolean);
+  private
+    FConfigDir: String;
+    FRandomHuePresetsFile: String;
+    FRandomHuePresetsDoc: TXMLDocument;
+    function FindRandomPreset(AName: String): TDOMElement;
+    procedure LoadRandomPresets;
+    procedure SaveRandomPresets;
+  public
+    function GetHue: Word;
   public
     class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
       ACaption: string);
@@ -73,6 +103,112 @@ begin
     lbHue.ItemIndex := hueID;
 end;
 
+procedure TfrmHueSettings.btnDeleteRandomClick(Sender: TObject);
+var
+  i: Integer;
+begin
+  lbRandom.Items.BeginUpdate;
+  for i := lbRandom.Items.Count - 1 downto 0 do
+    if lbRandom.Selected[i] then
+      lbRandom.Items.Delete(i);
+  lbRandom.Items.EndUpdate;
+end;
+
+procedure TfrmHueSettings.btnRandomPresetDeleteClick(Sender: TObject);
+var
+  preset: TDOMElement;
+begin
+  if cbRandomPreset.ItemIndex > -1 then
+  begin
+    preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
+    FRandomHuePresetsDoc.DocumentElement.RemoveChild(preset);
+    cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
+    cbRandomPreset.ItemIndex := -1;
+  end;
+end;
+
+procedure TfrmHueSettings.btnRandomPresetSaveClick(Sender: TObject);
+var
+  presetName: string;
+  i: Integer;
+  preset, hue: TDOMElement;
+  children: TDOMNodeList;
+begin
+  presetName := cbRandomPreset.Text;
+  if InputQuery('Save Preset', 'Enter the name of the preset:', presetName) then
+  begin
+    preset := FindRandomPreset(presetName);
+    if preset = nil then
+    begin
+      preset := FRandomHuePresetsDoc.CreateElement('Preset');
+      preset.AttribStrings['Name'] := presetName;
+      FRandomHuePresetsDoc.DocumentElement.AppendChild(preset);
+      cbRandomPreset.Items.AddObject(presetName, preset);
+    end else
+    begin
+      children := preset.GetChildNodes;
+      for i := children.Count - 1 downto 0 do
+        preset.RemoveChild(children[i]);
+    end;
+
+    for i := 0 to lbRandom.Items.Count - 1 do
+    begin
+      hue := FRandomHuePresetsDoc.CreateElement('Hue');
+      hue.AttribStrings['ID'] := IntToStr(PtrInt(lbRandom.Items.Objects[i]));
+      preset.AppendChild(hue);
+    end;
+
+    cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(preset);
+
+    SaveRandomPresets;
+  end;
+end;
+
+procedure TfrmHueSettings.cbRandomChange(Sender: TObject);
+begin
+  lbHue.MultiSelect := cbRandom.Checked;
+  gbRandom.Visible := cbRandom.Checked;
+end;
+
+procedure TfrmHueSettings.cbRandomPresetChange(Sender: TObject);
+var
+  preset, hue: TDOMElement;
+  id: PtrInt;
+begin
+  lbRandom.Clear;
+  if cbRandomPreset.ItemIndex > -1 then
+  begin
+    preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
+    hue := TDOMElement(preset.FirstChild);
+
+    while hue <> nil do
+    begin
+      if hue.NodeName = 'Hue' then
+      begin
+        id := StrToInt(hue.AttribStrings['ID']);
+        lbRandom.Items.AddObject(lbHue.Items.Strings[id], TObject(id));
+      end;
+      hue := TDOMElement(hue.NextSibling);
+    end;
+  end;
+end;
+
+procedure TfrmHueSettings.btnClearRandomClick(Sender: TObject);
+begin
+  lbRandom.Items.Clear;
+end;
+
+procedure TfrmHueSettings.btnAddRandomClick(Sender: TObject);
+var
+  i: PtrInt;
+begin
+  lbRandom.Items.BeginUpdate;
+  for i := 0 to lbHue.Count - 1 do
+    if lbHue.Selected[i] then
+      lbRandom.Items.AddObject(lbHue.Items.Strings[i], TObject(i));
+  lbRandom.Items.EndUpdate;
+end;
+
 procedure TfrmHueSettings.FormCreate(Sender: TObject);
 var
   i: Integer;
@@ -86,6 +222,17 @@ begin
     lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue);
   end;
   lbHue.ItemIndex := 0;
+
+  FConfigDir := GetAppConfigDir(False);
+  ForceDirectories(FConfigDir);
+  FRandomHuePresetsFile := FConfigDir + 'RandomHuePresets.xml';
+
+  LoadRandomPresets;
+end;
+
+procedure TfrmHueSettings.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(FRandomHuePresetsDoc);
 end;
 
 procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer;
@@ -97,7 +244,7 @@ begin
     hue := ResMan.Hue.Hues[Index-1]
   else
     hue := nil;
-  DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]);
+  DrawHue(hue, TListBox(Control).Canvas, ARect, TListBox(Control).Items.Strings[Index]);
 end;
 
 procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean);
@@ -105,6 +252,67 @@ begin
   edHue.Text := Format('$%x', [lbHue.ItemIndex]);
 end;
 
+procedure TfrmHueSettings.lbRandomDragDrop(Sender, Source: TObject; X,
+  Y: Integer);
+begin
+  if Source = lbHue then
+    btnAddRandomClick(Sender);
+end;
+
+procedure TfrmHueSettings.lbRandomDragOver(Sender, Source: TObject; X,
+  Y: Integer; State: TDragState; var Accept: Boolean);
+begin
+  if Source = lbHue then Accept := True;
+end;
+
+function TfrmHueSettings.FindRandomPreset(AName: String): TDOMElement;
+begin
+  Result := TDOMElement(FRandomHuePresetsDoc.DocumentElement.FirstChild);
+  while Result <> nil do
+  begin
+    if SameText(Result.AttribStrings['Name'], AName) then
+      Break;
+
+    Result := TDOMElement(Result.NextSibling);
+  end;
+end;
+
+procedure TfrmHueSettings.LoadRandomPresets;
+var
+  presetElement, hueElement: TDOMElement;
+begin
+  FreeAndNil(FRandomHuePresetsDoc);
+  cbRandomPreset.Items.Clear;
+  if FileExists(FRandomHuePresetsFile) then
+  begin
+    ReadXMLFile(FRandomHuePresetsDoc, FRandomHuePresetsFile);
+    presetElement := TDOMElement(FRandomHuePresetsDoc.DocumentElement.FirstChild);
+    while presetElement <> nil do
+    begin
+      if presetElement.NodeName = 'Preset' then
+        cbRandomPreset.Items.AddObject(presetElement.AttribStrings['Name'], presetElement);
+      presetElement := TDOMElement(presetElement.NextSibling);
+    end;
+  end else
+  begin
+    FRandomHuePresetsDoc := TXMLDocument.Create;
+    FRandomHuePresetsDoc.AppendChild(FRandomHuePresetsDoc.CreateElement('RandomHuePresets'));
+  end;
+end;
+
+procedure TfrmHueSettings.SaveRandomPresets;
+begin
+  WriteXMLFile(FRandomHuePresetsDoc, FRandomHuePresetsFile);
+end;
+
+function TfrmHueSettings.GetHue: Word;
+begin
+  if cbRandom.Checked and (lbRandom.Items.Count > 0) then
+    Result := PtrInt(lbRandom.Items.Objects[Random(lbRandom.Items.Count)])
+  else
+    Result := lbHue.ItemIndex;
+end;
+
 class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
   ACaption: string);
 var
@@ -121,7 +329,7 @@ begin
       ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1);
       ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1);
     end;
-  ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption);
+  ACanvas.TextOut(ARect.Left + 36, ARect.Top + 1, ACaption);
 end;
 
 initialization

Client/Tools/UfrmLightlevel.lfm

@@ -1,22 +1,22 @@
-inherited frmLightlevel: TfrmLightlevel
-  Height = 171
-  Width = 40
-  ActiveControl = tbLightlevel
-  Caption = 'Lightlevel'
-  ClientHeight = 171
-  ClientWidth = 40
-  object tbLightlevel: TTrackBar[0]
-    Left = 0
-    Height = 171
-    Top = 0
-    Width = 40
-    Max = 32
-    OnChange = tbLightlevelChange
-    Orientation = trVertical
-    Position = 0
-    Align = alClient
-    TabOrder = 0
-  end
-  inherited tmClose: TTimer[1]
-  end
-end
+inherited frmLightlevel: TfrmLightlevel
+  Height = 171
+  Width = 40
+  ActiveControl = tbLightlevel
+  Caption = 'Lightlevel'
+  ClientHeight = 171
+  ClientWidth = 40
+  object tbLightlevel: TTrackBar[0]
+    Left = 0
+    Height = 171
+    Top = 0
+    Width = 40
+    Max = 32
+    OnChange = tbLightlevelChange
+    Orientation = trVertical
+    Position = 0
+    Align = alClient
+    TabOrder = 0
+  end
+  inherited tmClose: TTimer[1]
+  end
+end

Client/Tools/UfrmMoveSettings.lfm

@@ -1,21 +1,21 @@
 inherited frmMoveSettings: TfrmMoveSettings
   Left = 290
-  Height = 120
+  Height = 104
   Top = 171
-  Width = 232
+  Width = 258
   ActiveControl = cbAsk
   AutoSize = True
   Caption = 'Move settings'
-  ClientHeight = 120
-  ClientWidth = 232
+  ClientHeight = 104
+  ClientWidth = 258
   object cbAsk: TCheckBox[0]
     AnchorSideLeft.Control = gbDirection
     AnchorSideLeft.Side = asrBottom
     AnchorSideTop.Control = gbDirection
-    Left = 121
-    Height = 19
+    Left = 119
+    Height = 25
     Top = 20
-    Width = 94
+    Width = 131
     BorderSpacing.Left = 8
     BorderSpacing.Top = 16
     BorderSpacing.Right = 8
@@ -28,9 +28,9 @@ inherited frmMoveSettings: TfrmMoveSettings
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = Owner
     Left = 8
-    Height = 108
+    Height = 92
     Top = 4
-    Width = 105
+    Width = 103
     AutoSize = True
     BorderSpacing.Left = 4
     BorderSpacing.Bottom = 4
@@ -46,7 +46,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Top = 0
       Width = 23
       BorderSpacing.Left = 8
-      Color = clBtnFace
       Down = True
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
@@ -85,7 +84,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnTop: TSpeedButton
@@ -97,7 +95,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Top = 0
       Width = 23
       BorderSpacing.Left = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -135,7 +132,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnTopRight: TSpeedButton
@@ -147,7 +143,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Top = 0
       Width = 23
       BorderSpacing.Left = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -185,7 +180,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnRight: TSpeedButton
@@ -198,7 +192,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Width = 23
       BorderSpacing.Top = 8
       BorderSpacing.Right = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -236,7 +229,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnBottomRight: TSpeedButton
@@ -248,7 +240,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Top = 60
       Width = 23
       BorderSpacing.Top = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -286,7 +277,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnBottom: TSpeedButton
@@ -299,7 +289,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Width = 23
       BorderSpacing.Left = 8
       BorderSpacing.Bottom = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -337,7 +326,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnBottomLeft: TSpeedButton
@@ -349,7 +337,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Top = 60
       Width = 23
       BorderSpacing.Top = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -387,7 +374,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object btnLeft: TSpeedButton
@@ -399,7 +385,6 @@ inherited frmMoveSettings: TfrmMoveSettings
       Top = 30
       Width = 23
       BorderSpacing.Top = 8
-      Color = clBtnFace
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
         2000000000000004000064000000640000000000000000000000000000000000
@@ -437,7 +422,6 @@ inherited frmMoveSettings: TfrmMoveSettings
         0000000000000000000000000000000000000000000000000000
       }
       GroupIndex = 1
-      NumGlyphs = 0
       OnClick = btnTopLeftClick
     end
     object seOffset: TSpinEdit
@@ -446,7 +430,7 @@ inherited frmMoveSettings: TfrmMoveSettings
       AnchorSideTop.Control = btnTop
       AnchorSideTop.Side = asrBottom
       Left = 33
-      Height = 25
+      Height = 33
       Hint = 'Offset'
       Top = 30
       Width = 34
@@ -464,9 +448,9 @@ inherited frmMoveSettings: TfrmMoveSettings
     AnchorSideLeft.Side = asrBottom
     AnchorSideBottom.Control = gbDirection
     AnchorSideBottom.Side = asrBottom
-    Left = 121
+    Left = 119
     Height = 25
-    Top = 83
+    Top = 67
     Width = 103
     Anchors = [akLeft, akBottom]
     BorderSpacing.Left = 8
@@ -478,4 +462,6 @@ inherited frmMoveSettings: TfrmMoveSettings
     ModalResult = 2
     TabOrder = 2
   end
+  inherited tmClose: TTimer[3]
+  end
 end

Client/Tools/UfrmToolWindow.lfm

@@ -1,8 +1,8 @@
 object frmToolWindow: TfrmToolWindow
   Left = 282
-  Height = 300
+  Height = 375
   Top = 157
-  Width = 400
+  Width = 500
   BorderIcons = []
   BorderStyle = bsToolWindow
   Caption = 'ToolWindow'
@@ -11,11 +11,10 @@ object frmToolWindow: TfrmToolWindow
   OnDeactivate = FormDeactivate
   OnShow = FormShow
   ShowInTaskBar = stNever
-  LCLVersion = '0.9.29'
   object tmClose: TTimer
     Enabled = False
     OnTimer = tmCloseTimer
-    left = 8
-    top = 8
+    Left = 10
+    Top = 10
   end
 end

Client/Tools/UfrmToolWindow.pas

@@ -1,104 +1,104 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UfrmToolWindow;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
-  LCLIntf, LMessages, ExtCtrls;
-
-type
-
-  { TfrmToolWindow }
-
-  TfrmToolWindow = class(TForm)
-    tmClose: TTimer;
-    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
-    procedure FormDeactivate(Sender: TObject); virtual;
-    procedure FormShow(Sender: TObject); virtual;
-    procedure tmCloseTimer(Sender: TObject);
-  protected
-    function CanClose: Boolean; virtual;
-    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
-  public
-    { public declarations }
-  end; 
-
-var
-  frmToolWindow: TfrmToolWindow;
-
-implementation
-
-{ TfrmToolWindow }
-
-procedure TfrmToolWindow.FormDeactivate(Sender: TObject);
-begin
-  if CanClose then
-    Close;
-end;
-
-procedure TfrmToolWindow.FormClose(Sender: TObject;
-  var CloseAction: TCloseAction);
-begin
-  CloseAction := caHide;
-end;
-
-procedure TfrmToolWindow.FormShow(Sender: TObject);
-begin
-  Top := Mouse.CursorPos.y - 8;
-  Left := Mouse.CursorPos.x - 8;
-
-  OnDeactivate := nil;
-  tmClose.Enabled := True;
-end;
-
-procedure TfrmToolWindow.tmCloseTimer(Sender: TObject);
-begin
-  tmClose.Enabled := False;
-  OnDeactivate := @FormDeactivate;
-  if CanClose then
-    Close;
-end;
-
-function TfrmToolWindow.CanClose: Boolean;
-begin
-  Result := not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos));
-end;
-
-procedure TfrmToolWindow.MouseLeave(var msg: TLMessage);
-begin
-  if CanClose then
-    Close;
-end;
-
-initialization
-  {$I UfrmToolWindow.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UfrmToolWindow;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  LCLIntf, LMessages, ExtCtrls;
+
+type
+
+  { TfrmToolWindow }
+
+  TfrmToolWindow = class(TForm)
+    tmClose: TTimer;
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormDeactivate(Sender: TObject); virtual;
+    procedure FormShow(Sender: TObject); virtual;
+    procedure tmCloseTimer(Sender: TObject);
+  protected
+    function CanClose: Boolean; virtual;
+    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
+  public
+    { public declarations }
+  end; 
+
+var
+  frmToolWindow: TfrmToolWindow;
+
+implementation
+
+{ TfrmToolWindow }
+
+procedure TfrmToolWindow.FormDeactivate(Sender: TObject);
+begin
+  if CanClose then
+    Close;
+end;
+
+procedure TfrmToolWindow.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction := caHide;
+end;
+
+procedure TfrmToolWindow.FormShow(Sender: TObject);
+begin
+  Top := Mouse.CursorPos.y - 8;
+  Left := Mouse.CursorPos.x - 8;
+
+  OnDeactivate := nil;
+  tmClose.Enabled := True;
+end;
+
+procedure TfrmToolWindow.tmCloseTimer(Sender: TObject);
+begin
+  tmClose.Enabled := False;
+  OnDeactivate := @FormDeactivate;
+  if CanClose then
+    Close;
+end;
+
+function TfrmToolWindow.CanClose: Boolean;
+begin
+  Result := not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos));
+end;
+
+procedure TfrmToolWindow.MouseLeave(var msg: TLMessage);
+begin
+  if CanClose then
+    Close;
+end;
+
+initialization
+  {$I UfrmToolWindow.lrs}
+
+end.
+

Client/Tools/UfrmVirtualLayer.lfm

@@ -2,11 +2,11 @@ inherited frmVirtualLayer: TfrmVirtualLayer
   Left = 290
   Height = 82
   Top = 171
-  Width = 210
+  Width = 231
   ActiveControl = cbShowLayer
   Caption = 'Virtual Layer'
   ClientHeight = 82
-  ClientWidth = 210
+  ClientWidth = 231
   object tbZ: TTrackBar[0]
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = seZ
@@ -14,9 +14,9 @@ inherited frmVirtualLayer: TfrmVirtualLayer
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
     Left = 8
-    Height = 36
-    Top = 37
-    Width = 194
+    Height = 47
+    Top = 49
+    Width = 215
     Frequency = 10
     Max = 127
     Min = -128
@@ -32,9 +32,9 @@ inherited frmVirtualLayer: TfrmVirtualLayer
     AnchorSideTop.Control = seZ
     AnchorSideTop.Side = asrCenter
     Left = 8
-    Height = 22
-    Top = 7
-    Width = 126
+    Height = 25
+    Top = 12
+    Width = 150
     BorderSpacing.Left = 8
     Caption = 'Show Layer at Z:'
     OnChange = cbShowLayerChange
@@ -44,8 +44,8 @@ inherited frmVirtualLayer: TfrmVirtualLayer
     AnchorSideTop.Control = Owner
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
-    Left = 152
-    Height = 21
+    Left = 173
+    Height = 33
     Top = 8
     Width = 50
     Anchors = [akTop, akRight]
@@ -56,4 +56,6 @@ inherited frmVirtualLayer: TfrmVirtualLayer
     OnChange = seZChange
     TabOrder = 2
   end
+  inherited tmClose: TTimer[3]
+  end
 end

Client/UActions.pas

@@ -0,0 +1,465 @@
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2022 Andreas Schneider
+ *)
+
+unit UActions;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fgl, UWorldItem, UStatics, UMap, UPacket, ULandscape;
+
+type
+
+  TPacketList = specialize TFPGObjectList<TPacket>;
+  TIdList = specialize TFPGList<Word>;
+
+  { TBaseEditAction }
+
+  TBaseEditAction = class(TObject)
+  private
+    FLandscape: TLandscape;
+    FMapTiles: TMapCellList;
+    FStaticTiles: TStaticItemList;
+  public
+    constructor Create(ALandscape: TLandscape);
+    destructor Destroy; override;
+  public
+    property MapTiles: TMapCellList read FMapTiles;
+    property StaticTiles: TStaticItemList read FStaticTiles;
+
+    procedure StartSelection(ATile: TWorldItem); virtual; abstract;
+    procedure AddSelection(ATile: TWorldItem); virtual; abstract;
+    function IsHighlighted(ATile: TWorldItem): Boolean; virtual; abstract;
+    procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); virtual;
+  end;
+
+  { TRectangleEditAction }
+
+  TRectangleEditAction = class(TBaseEditAction)
+  private
+    FFirstTile: TWorldItem;
+    FLastTile: TWorldItem;
+    FRect: TRect;
+  public
+    constructor Create(ALandscape: TLandscape);
+    procedure StartSelection(ATile: TWorldItem); override;
+    procedure AddSelection(ATile: TWorldItem); override;
+    function IsHighlighted(ATile: TWorldItem): Boolean; override;
+  private
+    procedure UpdateArea; virtual;
+    function IsEditableTile(AWorldItem: TWorldItem): Boolean; inline;
+    function IsEditableStaticTile(AWorldItem: TWorldItem): Boolean; inline;
+  end;
+
+  { TDrawAction }
+
+  TDrawAction = class(TRectangleEditAction)
+  private
+    FTileIds: TIdList;
+    FForceZ: Boolean;
+    FForceZValue: ShortInt;
+    FRandomZ: Boolean;
+    FRandomZValue: Byte;
+    FHue: Word;
+  public
+    property TileIds: TIdList read FTileIds;
+    property ForceZ: Boolean read FForceZ write FForceZ;
+    property ForceZValue: ShortInt read FForceZValue write FForceZValue;
+    property RandomZ: Boolean read FRandomZ write FRandomZ;
+    property RandomZValue: Byte read FRandomZValue write FRandomZValue;
+
+    constructor Create(ALandscape: TLandscape);
+
+    function IsHighlighted(ATile: TWorldItem): Boolean; override;
+    procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions,
+      AReverseActions: TPacketList); override;
+  private
+    procedure UpdateArea; override;
+  end;
+
+  { TMoveAction }
+
+  TMoveAction = class(TRectangleEditAction)
+  private
+    FOffsetX: Integer;
+    FOffsetY: Integer;
+  public
+    property OffsetX: Integer read FOffsetX write FOffsetX;
+    property OffsetY: Integer read FOffsetY write FOffsetY;
+
+    procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions,
+      AReverseActions: TPacketList); override;
+  end;
+
+  { TElevateAction }
+
+  TElevateAction = class(TRectangleEditAction)
+  public type
+    TMode = (emSet, emRaise, emLower);
+  private
+    FMode: TMode;
+    FZ: ShortInt;
+    FRandomZ: Boolean;
+    FRandomZValue: Byte;
+  public
+    property Mode: TMode read FMode write FMode;
+    property Z: ShortInt read FZ write FZ;
+
+    procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions,
+      AReverseActions: TPacketList); override;
+  end;
+
+  { TDeleteAction }
+
+  TDeleteAction = class(TRectangleEditAction)
+  public
+    procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions,
+      AReverseActions: TPacketList); override;
+  end;
+
+  { THueAction }
+
+  THueAction = class(TRectangleEditAction)
+  private
+    FHue: Word;
+  public
+    property Hue: Word read FHue write FHue;
+
+    procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions,
+      AReverseActions: TPacketList); override;
+  end;
+
+implementation
+
+uses
+  Math, UGameResources, UPackets;
+
+{ TBaseEditAction }
+
+constructor TBaseEditAction.Create(ALandscape: TLandscape);
+begin
+  FLandscape := ALandscape;
+  FMapTiles := TMapCellList.Create;
+  FStaticTiles := TStaticItemList.Create;
+end;
+
+destructor TBaseEditAction.Destroy;
+begin
+  FMapTiles.Free;
+  FStaticTiles.Free;
+  inherited Destroy;
+end;
+
+procedure TBaseEditAction.Execute(AScreenBuffer: TScreenBuffer; out
+  AForwardActions, AReverseActions: TPacketList);
+begin
+  AForwardActions := TPacketList.Create;
+  AReverseActions := TPacketList.Create;
+end;
+
+{ TRectangleEditAction }
+
+constructor TRectangleEditAction.Create(ALandscape: TLandscape);
+begin
+  inherited Create(ALandscape);
+  FRect.Left := -1;
+  FRect.Top := -1;
+  FRect.Bottom := -1;
+  FRect.Right := -1;
+end;
+
+procedure TRectangleEditAction.StartSelection(ATile: TWorldItem);
+begin
+  FFirstTile := ATile;
+  FLastTile := ATile;
+  UpdateArea;
+end;
+
+procedure TRectangleEditAction.AddSelection(ATile: TWorldItem);
+begin
+  FLastTile := ATile;
+  UpdateArea;
+end;
+
+function TRectangleEditAction.IsHighlighted(ATile: TWorldItem): Boolean;
+begin
+  Result := ((FFirstTile = FLastTile) and (FFirsttile = ATile)) or
+    FRect.Contains(TPoint.Create(ATile.X, ATile.Y));
+end;
+
+procedure TRectangleEditAction.UpdateArea;
+begin
+  if FFirstTile = FLastTile then
+  begin
+    FRect.Left := -1;
+    FRect.Top := -1;
+    FRect.Bottom := -1;
+    FRect.Right := -1;
+  end else
+  begin
+    FRect.Left := Min(FFirstTile.X, FLastTile.X);
+    FRect.Top := Min(FFirstTile.Y, FLastTile.Y);
+    FRect.Right := Max(FFirstTile.X, FLastTile.X);
+    FRect.Bottom := Max(FFirstTile.Y, FLastTile.Y);
+  end;
+end;
+
+function TRectangleEditAction.IsEditableTile(AWorldItem: TWorldItem): Boolean;
+begin
+  if not AWorldItem.CanBeEdited then
+    Exit(False);
+
+  if FFirstTile = FLastTile then
+  begin
+    if AWorldItem <> FFirstTile then
+      Exit(False);
+  end else
+  begin
+    if not FRect.Contains(TPoint.Create(AWorldItem.X, AWorldItem.Y)) then
+      Exit(False);
+  end;
+
+  Result := True;
+end;
+
+function TRectangleEditAction.IsEditableStaticTile(AWorldItem: TWorldItem): Boolean;
+begin
+  if not IsEditableTile(AWorldItem) then
+    Exit(False);
+
+  if not (AWorldItem is TStaticItem) then
+    Exit(False);
+
+  Result := True;
+end;
+
+{ TDrawAction }
+
+constructor TDrawAction.Create(ALandscape: TLandscape);
+begin
+  inherited Create(ALandscape);
+  FTileIds := TIdList.Create;
+end;
+
+function TDrawAction.IsHighlighted(ATile: TWorldItem): Boolean;
+begin
+  // Since we add new tiles, we don't need to highlight any existing
+  // tiles.
+  Result := False;
+end;
+
+procedure TDrawAction.Execute(AScreenBuffer: TScreenBuffer; out
+  AForwardActions, AReverseActions: TPacketList);
+var
+  staticTile: TStaticItem;
+  mapTile, previousMapTile: TMapCell;
+begin
+  inherited Execute(AScreenBuffer, AForwardActions, AReverseActions);
+
+  if FTileIds.Count < 1 then
+    Exit;
+
+  for mapTile in FMapTiles do
+  begin
+    previousMapTile := FLandscape.MapCell[mapTile.X, mapTile.Y];
+    AForwardActions.Add(TDrawMapPacket.Create(mapTile.X, mapTile.Y, mapTile.Z, mapTile.TileID));
+    AReverseActions.Add(TDrawMapPacket.Create(previousMapTile.X, previousMapTile.Y, previousMapTile.Z, previousMapTile.TileID));
+  end;
+
+  for staticTile in FStaticTiles do
+  begin
+    AForwardActions.Add(TInsertStaticPacket.Create(staticTile));
+    AReverseActions.Add(TDeleteStaticPacket.Create(staticTile));
+  end;
+end;
+
+procedure TDrawAction.UpdateArea;
+var
+  targetArea: TRect;
+  tileX, tileY: Word;
+  tileId: Word;
+  mapCell: TMapCell;
+  staticItem: TStaticItem;
+  worldItem: TWorldItem;
+begin
+  inherited UpdateArea;
+
+  FMapTiles.Clear;
+  FStaticTiles.Clear;
+
+  // TODO Only update relevant section of the tile lists.
+
+  if FFirstTile = nil then
+    Exit;
+
+  targetArea.Left := Min(FFirstTile.X, FLastTile.X);
+  targetArea.Top := Min(FFirstTile.Y, FLastTile.Y);
+  targetArea.Right := Max(FFirstTile.X, FLastTile.X);
+  targetArea.Bottom := Max(FFirstTile.Y, FLastTile.Y);
+
+  for tileX := targetArea.Left to targetArea.Right do
+    for tileY := targetArea.Top to targetArea.Bottom do
+    begin
+      tileId := FTileIds[Random(FTileIds.Count)];
+      if tileId < $4000 then
+      begin
+        // Map Tile
+        mapCell := FLandscape.MapCell[tileX, tileY].Clone;
+        mapCell.TileID := tileId;
+        worldItem := mapCell;
+        FMapTiles.Add(mapCell);
+      end else
+      begin
+        // Static Tile
+        staticItem := TStaticItem.Create(nil, nil, 0, 0);
+        staticItem.TileID := tileId - $4000;
+        staticItem.Hue := FHue;
+        if not FForceZ then
+        begin
+          staticItem.Z := FFirstTile.Z;
+          if FFirstTile is TStaticItem then
+            staticItem.Z := staticItem.Z + ResMan.Tiledata.StaticTiles[FFirstTile.TileID].Height;
+        end;
+        worldItem := staticItem;
+        FStaticTiles.Add(staticItem);
+      end;
+
+      worldItem.X := tileX;
+      worldItem.Y := tileY;
+
+      if FForceZ then
+        worldItem.Z := FForceZValue;
+      if FRandomZ then
+        worldItem.Z := worldItem.Z + Random(FRandomZValue);
+    end;
+end;
+
+{ TDeleteAction }
+
+procedure TDeleteAction.Execute(AScreenBuffer: TScreenBuffer; out
+  AForwardActions, AReverseActions: TPacketList);
+var
+  item: TWorldItem;
+begin
+  inherited Execute(AScreenBuffer, AForwardActions, AReverseActions);
+
+  for item in AScreenBuffer do
+  begin
+    if not IsEditableStaticTile(item) then
+      Continue;
+
+    AForwardActions.Add(TDeleteStaticPacket.Create(TStaticItem(item)));
+    AReverseActions.Add(TInsertStaticPacket.Create(TStaticItem(item)));
+  end;
+end;
+
+{ TMoveAction }
+
+procedure TMoveAction.Execute(AScreenBuffer: TScreenBuffer; out
+  AForwardActions, AReverseActions: TPacketList);
+var
+  newX, newY: Word;
+  item: TWorldItem;
+begin
+  inherited Execute(AScreenBuffer, AForwardActions, AReverseActions);
+
+  for item in AScreenBuffer do
+  begin
+    if not IsEditableStaticTile(item) then
+      Continue;
+
+    newX := EnsureRange(item.X + FOffsetX, 0, FLandscape.CellWidth - 1);
+    newY := EnsureRange(item.Y + FOffsetY, 0, FLandscape.CellHeight - 1);
+
+    AForwardActions.Add(TMoveStaticPacket.Create(TStaticItem(item), newX, newY));
+    AReverseActions.Add(TMoveStaticPacket.Create(TStaticItem(item), item.X, item.Y));
+  end;
+end;
+
+{ TElevateAction }
+
+procedure TElevateAction.Execute(AScreenBuffer: TScreenBuffer; out
+  AForwardActions, AReverseActions: TPacketList);
+var
+  item: TWorldItem;
+  newZ: Integer;
+begin
+  inherited Execute(AScreenBuffer, AForwardActions, AReverseActions);
+
+  for item in AScreenBuffer do
+  begin
+    if not IsEditableTile(item) then
+      Continue;
+
+    newZ := FZ;
+    if FRandomZ then
+      newZ := newZ + Random(FRandomZValue);
+
+    case FMode of
+      emRaise: newZ := item.Z + FZ;
+      emLower: newZ := item.Z - FZ;
+    end;
+
+    newZ := EnsureRange(newZ, -128, 127);
+
+    if item is TMapCell then
+    begin
+      AForwardActions.Add(TDrawMapPacket.Create(item.X, item.Y, newZ, item.TileID));
+      AReverseActions.Add(TDrawMapPacket.Create(item.X, item.Y, item.Z, item.TileID));
+    end else if item is TStaticItem then
+    begin
+      AForwardActions.Add(TElevateStaticPacket.Create(TStaticItem(item), newZ));
+      AReverseActions.Add(TElevateStaticPacket.Create(TStaticItem(item), item.Z));
+    end;
+  end;
+end;
+
+{ THueAction }
+
+procedure THueAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions,
+  AReverseActions: TPacketList);
+var
+  item: TWorldItem;
+begin
+  inherited Execute(AScreenBuffer, AForwardActions, AReverseActions);
+
+  for item in AScreenBuffer do
+  begin
+    if not IsEditableStaticTile(item) then
+      Continue;
+
+    if TStaticItem(item).Hue = FHue then
+      Continue;
+
+    AForwardActions.Add(THueStaticPacket.Create(TStaticItem(item), FHue));
+    AReverseActions.Add(THueStaticPacket.Create(TStaticItem(item), TStaticItem(item).Hue));
+  end;
+end;
+
+end.
+

Client/UGameResources.pas

@@ -1,125 +1,125 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UGameResources;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider,
-  ULandscape, UHueProvider, UAnimDataProvider, ULightProvider;
-
-type
-
-  { TGameResourceManager }
-
-  TGameResourceManager = class
-    constructor Create(ADataDir: String);
-    destructor Destroy; override;
-  protected
-    { Members }
-    FDataDir: String;
-    FArtProvider: TArtProvider;
-    FTiledataProvider: TTiledataProvider;
-    FAnimdataProvider: TAnimdataProvider;
-    FTexmapProvider: TTexmapProvider;
-    FHueProvider: THueProvider;
-    FLightProvider: TLightProvider;
-    FLandscape: TLandscape;
-  public
-    { Fields }
-    property Art: TArtProvider read FArtProvider;
-    property Hue: THueProvider read FHueProvider;
-    property Landscape: TLandscape read FLandscape;
-    property Tiledata: TTiledataProvider read FTiledataProvider;
-    property Animdata: TAnimDataProvider read FAnimdataProvider;
-    property Texmaps: TTexmapProvider read FTexmapProvider;
-    property Lights: TLightProvider read FLightProvider;
-
-    { Methods }
-    function GetFile(AFileName: String): String;
-    procedure InitLandscape(AWidth, AHeight: Word);
-  end;
-
-var
-  GameResourceManager: TGameResourceManager;
-  ResMan: TGameResourceManager absolute GameResourceManager;
-
-procedure InitGameResourceManager(ADataDir: String);
-
-implementation
-
-procedure InitGameResourceManager(ADataDir: String);
-begin
-  FreeAndNil(GameResourceManager);
-  GameResourceManager := TGameResourceManager.Create(ADataDir);
-end;
-
-{ TGameResourceManager }
-
-constructor TGameResourceManager.Create(ADataDir: String);
-begin
-  inherited Create;
-  FDataDir := IncludeTrailingPathDelimiter(ADataDir);
-
-  FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True);
-  FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True);
-  FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True);
-  FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'),
-    GetFile('texidx.mul'), True);
-  FHueProvider := THueProvider.Create(GetFile('hues.mul'), True);
-  FLightProvider := TLightProvider.Create(GetFile('light.mul'),
-    GetFile('lightidx.mul'), True);
-end;
-
-destructor TGameResourceManager.Destroy;
-begin
-  FreeAndNil(FArtProvider);
-  FreeAndNil(FTiledataProvider);
-  FreeAndNil(FAnimdataProvider);
-  FreeAndNil(FTexmapProvider);
-  FreeAndNil(FHueProvider);
-  FreeAndNil(FLightProvider);
-  FreeAndNil(FLandscape);
-  inherited Destroy;
-end;
-
-function TGameResourceManager.GetFile(AFileName: String): String;
-begin
-  Result := FDataDir + AFileName;
-end;
-
-procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word);
-begin
-  FreeAndNil(FLandscape);
-  FLandscape := TLandscape.Create(AWidth, AHeight);
-end;
-
-finalization
-  FreeAndNil(GameResourceManager);
-
-end.
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UGameResources;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider,
+  ULandscape, UHueProvider, UAnimDataProvider, ULightProvider;
+
+type
+
+  { TGameResourceManager }
+
+  TGameResourceManager = class
+    constructor Create(ADataDir: String);
+    destructor Destroy; override;
+  protected
+    { Members }
+    FDataDir: String;
+    FArtProvider: TArtProvider;
+    FTiledataProvider: TTiledataProvider;
+    FAnimdataProvider: TAnimdataProvider;
+    FTexmapProvider: TTexmapProvider;
+    FHueProvider: THueProvider;
+    FLightProvider: TLightProvider;
+    FLandscape: TLandscape;
+  public
+    { Fields }
+    property Art: TArtProvider read FArtProvider;
+    property Hue: THueProvider read FHueProvider;
+    property Landscape: TLandscape read FLandscape;
+    property Tiledata: TTiledataProvider read FTiledataProvider;
+    property Animdata: TAnimDataProvider read FAnimdataProvider;
+    property Texmaps: TTexmapProvider read FTexmapProvider;
+    property Lights: TLightProvider read FLightProvider;
+
+    { Methods }
+    function GetFile(AFileName: String): String;
+    procedure InitLandscape(AWidth, AHeight: Word);
+  end;
+
+var
+  GameResourceManager: TGameResourceManager;
+  ResMan: TGameResourceManager absolute GameResourceManager;
+
+procedure InitGameResourceManager(ADataDir: String);
+
+implementation
+
+procedure InitGameResourceManager(ADataDir: String);
+begin
+  FreeAndNil(GameResourceManager);
+  GameResourceManager := TGameResourceManager.Create(ADataDir);
+end;
+
+{ TGameResourceManager }
+
+constructor TGameResourceManager.Create(ADataDir: String);
+begin
+  inherited Create;
+  FDataDir := IncludeTrailingPathDelimiter(ADataDir);
+
+  FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True);
+  FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True);
+  FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True);
+  FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'),
+    GetFile('texidx.mul'), True);
+  FHueProvider := THueProvider.Create(GetFile('hues.mul'), True);
+  FLightProvider := TLightProvider.Create(GetFile('light.mul'),
+    GetFile('lightidx.mul'), True);
+end;
+
+destructor TGameResourceManager.Destroy;
+begin
+  FreeAndNil(FArtProvider);
+  FreeAndNil(FTiledataProvider);
+  FreeAndNil(FAnimdataProvider);
+  FreeAndNil(FTexmapProvider);
+  FreeAndNil(FHueProvider);
+  FreeAndNil(FLightProvider);
+  FreeAndNil(FLandscape);
+  inherited Destroy;
+end;
+
+function TGameResourceManager.GetFile(AFileName: String): String;
+begin
+  Result := FDataDir + AFileName;
+end;
+
+procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word);
+begin
+  FreeAndNil(FLandscape);
+  FLandscape := TLandscape.Create(AWidth, AHeight);
+end;
+
+finalization
+  FreeAndNil(GameResourceManager);
+
+end.

Client/ULandscape.pas

@@ -21,7 +21,8 @@
  * CDDL HEADER END
  *
  *
- *      Portions Copyright 2009 Andreas Schneider
+ *      Portions Copyright 2015 Andreas Schneider
+ *      Portions Copyright 2015 StaticZ
  *)
 unit ULandscape;
 
@@ -33,9 +34,7 @@ uses
   SysUtils, Classes, math, matrix, LCLIntf, GL, GLu, ImagingOpenGL, Imaging,
   ImagingClasses, ImagingTypes, ImagingUtility,
   UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
-  UMulBlock, UAnimData,
-  UEnhancedMemoryStream, UGLFont,
-  UCacheManager;
+  UMulBlock, UAnimData, UEnhancedMemoryStream, UGLFont, UCacheManager;
 
 type
   TGlVector3f = array[0..2] of GLfloat;
@@ -188,8 +187,8 @@ type
     FMaxStaticID: Cardinal;
     { Methods }
     function GetMapBlock(AX, AY: Word): TMapBlock;
-    function GetMapCell(AX, AY: Word): TMapCell;
-    function GetNormals(AX, AY: Word): TNormals;
+    function GetMapCell(AX, AY: Integer): TMapCell;
+    function GetNormals(AX, AY: Integer): TNormals;
     function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
     function GetStaticList(AX, AY: Word): TStaticItemList;
     { Events }
@@ -207,9 +206,9 @@ type
     property Height: Word read FHeight;
     property CellWidth: Word read FCellWidth;
     property CellHeight: Word read FCellHeight;
-    property MapCell[X, Y: Word]: TMapCell read GetMapCell;
+    property MapCell[X, Y: Integer]: TMapCell read GetMapCell;
     property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
-    property Normals[X, Y: Word]: TNormals read GetNormals;
+    property Normals[X, Y: Integer]: TNormals read GetNormals;
     property MaxStaticID: Cardinal read FMaxStaticID;
     property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
     property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged;
@@ -226,7 +225,7 @@ type
     function CanWrite(AX, AY: Word): Boolean;
     procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
       AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean;
-      AAdditionalTiles: TWorldItemList = nil);
+      AAdditionalTiles: TWorldItemList = nil; ATileFilters: TTileDataFlags = []);
     function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
     function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
     procedure GetNormals(AX, AY: Word; var ANormals: TNormals);
@@ -258,6 +257,8 @@ type
     ScreenRect: TRect;
     DrawQuad: array[0..3,0..1] of TGLint;
     RealQuad: array[0..3,0..1] of TGLint;
+    LineWidth: array[0..2] of GLfloat;
+    LineDraw: array[0..2,0..1,0..1] of TGLint;
     Item: TWorldItem;
     HighRes: TMaterial;
     LowRes: TMaterial;
@@ -265,6 +266,7 @@ type
     State: TScreenState;
     Highlighted: Boolean;
     HueOverride: Boolean;
+    Hue: Word;
     CheckRealQuad: Boolean;
     Translucent: Boolean;
     WalkRestriction: TWalkRestriction;
@@ -297,6 +299,18 @@ type
     { Events }
     procedure OnTileRemoved(ATile: TMulBlock);
   end;
+
+  { TScreenBufferItemEnumerator }
+
+  TScreenBufferItemEnumerator = object
+  private
+    FScreenBuffer: TScreenBuffer;
+    FCurrentBlock: PBlockInfo;
+    FCurrentItem: TWorldItem;
+  public
+    function MoveNext: Boolean;
+    property Current: TWorldItem read FCurrentItem;
+  end;
   
   TStaticInfo = packed record
     X: Word;
@@ -306,6 +320,23 @@ type
     Hue: Word;
   end;
 
+  TGhostTile = class(TStaticItem);
+
+  { TMovableGhostTile }
+
+  TMovableGhostTile = class(TGhostTile)
+  private
+    FOriginalX: Word;
+    FOriginalY: Word;
+    FOriginalZ: ShortInt;
+  public
+    property OriginalX: Word read FOriginalX write FOriginalX;
+    property OriginalY: Word read FOriginalY write FOriginalY;
+    property OriginalZ: ShortInt read FOriginalZ write FOriginalZ;
+  end;
+
+operator enumerator(AScreenBuffer: TScreenBuffer): TScreenBufferItemEnumerator;
+
 implementation
 
 uses
@@ -323,14 +354,29 @@ begin
   GLVector[2] := AVector.data[2];
 end;
 
+operator enumerator(AScreenBuffer: TScreenBuffer): TScreenBufferItemEnumerator;
+begin
+  Result.FScreenBuffer := AScreenBuffer;
+  Result.MoveNext;
+end;
+
+{ TScreenBufferItemEnumerator }
+
+function TScreenBufferItemEnumerator.MoveNext: Boolean;
+begin
+  Result := FScreenBuffer.Iterate(FCurrentBlock);
+  if not Result then
+    FCurrentItem := nil;
+end;
+
 { TLandTextureManager }
 
 constructor TLandTextureManager.Create;
 begin
   inherited Create;
-  FArtCache := TMaterialCache.Create(1024);
-  FTexCache := TMaterialCache.Create(128);
-  FAnimCache := TMaterialCache.Create(128);
+  FArtCache := TMaterialCache.Create(4096);
+  FTexCache := TMaterialCache.Create(512);
+  FAnimCache := TMaterialCache.Create(512);
   FUseAnims := True;
 end;
 
@@ -592,7 +638,7 @@ begin
   FHeight := AHeight;
   FCellWidth := FWidth * 8;
   FCellHeight := FHeight * 8;
-  FBlockCache := TBlockCache.Create(256);
+  FBlockCache := TBlockCache.Create(1024);
   FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
 
   FOnChange := nil;
@@ -661,7 +707,7 @@ begin
   end;
 end;
 
-function TLandscape.GetMapCell(AX, AY: Word): TMapCell;
+function TLandscape.GetMapCell(AX, AY: Integer): TMapCell;
 var
   block: TMapBlock;
 begin
@@ -674,7 +720,7 @@ begin
   end;
 end;
 
-function TLandscape.GetNormals(AX, AY: Word): TNormals;
+function TLandscape.GetNormals(AX, AY: Integer): TNormals;
 begin
   GetNormals(AX, AY, Result);
 end;
@@ -958,13 +1004,14 @@ end;
 
 procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
   AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean;
-  AAdditionalTiles: TWorldItemList = nil);
+  AAdditionalTiles: TWorldItemList; ATileFilters: TTileDataFlags);
 var
   drawMapCell: TMapCell;
   drawStatics: TStaticItemList;
   i, x, y: Integer;
   tempDrawList: TWorldItemList;
   staticTileData: TStaticTiledata;
+  blockInfo: PBlockInfo;
 begin
   ADrawList.Clear;
   tempDrawList := TWorldItemList.Create(False);;
@@ -993,6 +1040,10 @@ begin
             staticTileData := ResMan.Tiledata.StaticTiles[drawStatics[i].TileID];
             if ANoDraw or FDrawMap[drawStatics[i].TileID + $4000] then
             begin
+              // Check if filters match
+              if staticTileData.Flags * ATileFilters <> [] then
+                Continue;
+
               drawStatics[i].UpdatePriorities(staticTileData,
                 ADrawList.GetSerial);
               tempDrawList.Add(drawStatics[i]);
@@ -1007,7 +1058,11 @@ begin
 
   tempDrawList.Sort(@CompareWorldItems);
   for i := 0 to tempDrawList.Count - 1 do
-    ADrawList.Add(TWorldItem(tempDrawList[i]));
+  begin
+    blockInfo := ADrawList.Add(TWorldItem(tempDrawList[i]));
+    if tempDrawList[i] is TGhostTile then
+      blockInfo^.State := ssGhost;
+  end;
   tempDrawList.Free;
 end;
 
@@ -1587,7 +1642,7 @@ begin
   end
   else if FShortCuts[0] <> nil then
   begin
-    stepSize := FCount div 10;
+    stepSize := FCount div 10 + 1;
     nextStep := stepSize;
     step := 0;
     shortcut := 1;

Client/ULightManager.pas

@@ -21,7 +21,8 @@
  * CDDL HEADER END
  *
  *
- *      Portions Copyright 2009 Andreas Schneider
+ *      Portions Copyright 2015 Andreas Schneider
+ *      Portions Copyright 2015 StaticZ
  *)
 unit ULightManager;
 
@@ -31,10 +32,23 @@ interface
 
 uses
   Classes, SysUtils, Imaging, ImagingTypes, ImagingClasses, ImagingCanvases,
-  ImagingOpenGL, GL, GLu, GLext, fgl, ULandscape, UWorldItem, UCacheManager;
+  ImagingOpenGL, GL, GLu, GLext, Math, fgl, ULandscape, UWorldItem,
+  UCacheManager, DOM, XMLRead;
+
+const
+  ColorsCount = 15;
 
 type
 
+  TLightColor = record
+    r: Float;
+    g: Float;
+    b: Float;
+  end;
+  PLightColor = ^TLightColor;
+
+  TColorRefArray = array of Byte;
+
   TCalculateOffset = procedure(AX, AY: Integer; out DrawX, DrawY: Integer) of object;
 
   { TLightMaterial }
@@ -58,11 +72,13 @@ type
     constructor Create(AManager: TLightManager; AWorldItem: TWorldItem);
     destructor Destroy; override;
   protected
+    FColorID: Byte;
     FX: Integer;
     FY: Integer;
     FZ: SmallInt;
     FMaterial: TLightMaterial;
   public
+    property ColorID: Byte read FColorID;
     property X: Integer read FX;
     property Y: Integer read FY;
     property Z: SmallInt read FZ;
@@ -86,15 +102,20 @@ type
     FLightCache: TLightCache;
     FUseFBO: Boolean;
     FInitialized: Boolean;
+    FLightColors: array[1..ColorsCount] of TLightColor;
+    FTileCol: TColorRefArray;
     function GetLight(AID: Integer): TLightMaterial;
     procedure SetLightLevel(AValue: Byte);
     procedure UpdateOverlay(AScreenRect: TRect);
+  private
+    property TileCol: TColorRefArray read FTileCol;
   public
     property LightLevel: Byte read FLightLevel write SetLightLevel;
     procedure InitGL;
     procedure UpdateLightMap(ALeft, AWidth, ATop, AHeight: Integer;
       AScreenBuffer: TScreenBuffer);
     procedure Draw(AScreenRect: TRect);
+    procedure LoadConfig(AFileName: String);
   end;
 
 implementation
@@ -153,6 +174,7 @@ var
   lightMaterial: TLightMaterial;
   colorGL: GLclampf;
   fbo: GLuint;
+  colorref: PLightColor;
 begin
   glDeleteTextures(1, @FOverlayTexture);
   if FUseFBO then
@@ -182,7 +204,9 @@ begin
         lightMaterial := FLightSources[i].Material;
         if lightMaterial <> nil then
         begin
+          colorref := @FLightColors[FLightSources[i].ColorID];
           glBindTexture(GL_TEXTURE_2D, lightMaterial.Texture);
+          glColor3f(colorref^.R, colorref^.G, colorref^.B);
           glBegin(GL_QUADS);
             glTexCoord2i(0, 0);
             glVertex2i(FLightSources[i].FX - lightMaterial.RealWidth div 2,
@@ -279,8 +303,10 @@ begin
       if tdfLightSource in tileData.Flags then
         lights.Add(blockInfo^.Item)
       else
-        tileMap[blockInfo^.Item.X - ALeft, blockInfo^.Item.Y - ATop] :=
-          blockInfo^.Item;
+        x := blockInfo^.Item.X - ALeft;
+        y := blockInfo^.Item.Y - ATop;
+        if InRange(x, 0, AWidth - 1) and InRange(y, 0, AHeight - 1) then
+          tileMap[x, y] := blockInfo^.Item;
     end;
   end;
 
@@ -288,8 +314,9 @@ begin
   begin
     x := lights[i].X + 1 - ALeft;
     y := lights[i].Y + 1 - ATop;
-    if (x = AWidth) or (y = AHeight) or (tileMap[x,y] = nil) or
-      (tileMap[x,y].Z < lights[i].Z + 5) then
+    if (x = AWidth) or (y = AHeight) or
+      (InRange(x, 0, AWidth - 1) and InRange(y, 0, AHeight - 1) and
+        ((tileMap[x,y] = nil) or (tileMap[x,y].Z < lights[i].Z + 5))) then
       FLightSources.Add(TLightSource.Create(Self, lights[i]));
   end;
 
@@ -336,6 +363,104 @@ begin
   glEnd;
 end;
 
+procedure TLightManager.LoadConfig(AFileName: String);
+var
+  XMLDoc:  TXMLDocument;
+  iNode, node: TDOMNode;
+  s: string;
+  i, id, col, r, g, b: Integer;
+begin
+  //writeln('Loading Colors from ', AFileName); //TODO
+  for i := 1 to ColorsCount do begin
+    FLightColors[i].R := 1.0;
+    FLightColors[i].G := 1.0;
+    FLightColors[i].B := 1.0;
+  end;
+  SetLength(FTileCol, ResMan.Landscape.MaxStaticID + 1);
+  for i := 0 to ResMan.Landscape.MaxStaticID do
+    FTileCol[i] := 1;
+
+  //frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['ColorLight.xml']));
+  // Read xml file from your hard drive
+  ReadXMLFile(XMLDoc, AFileName);
+  if LowerCase(XMLDoc.DocumentElement.NodeName) = 'colorlight' then
+  begin
+    iNode := XMLDoc.DocumentElement.FirstChild;
+    while iNode <> nil do
+    begin
+      if LowerCase(iNode.NodeName) = 'colors' then
+      begin
+        node := iNode.FirstChild;
+        while node <> nil do
+        begin
+          if (LowerCase(node.NodeName) = 'color') then
+          begin
+            id := -1;
+            r := 255;
+            g := 255;
+            b := 255;
+            for i := node.Attributes.Length - 1 downto 0 do
+            begin
+              s := LowerCase(node.Attributes[i].NodeName);
+              if (s = 'id') then
+                TryStrToInt(node.Attributes[i].NodeValue, id);
+              if (s = 'r') then
+                TryStrToInt(node.Attributes[i].NodeValue, r);
+              if (s = 'g') then
+                TryStrToInt(node.Attributes[i].NodeValue, g);
+              if (s = 'b') then
+                TryStrToInt(node.Attributes[i].NodeValue, b);
+            end;
+            if (id > 0) and (id <= ColorsCount) then
+            begin
+              if (r <   0) then r :=   0;
+              if (g <   0) then g :=   0;
+              if (b <   0) then b :=   0;
+              if (r > 255) then r := 255;
+              if (g > 255) then g := 255;
+              if (b > 255) then b := 255;
+              FLightColors[id].R := (Float(r)) / 255.0;
+              FLightColors[id].G := (Float(g)) / 255.0;
+              FLightColors[id].B := (Float(b)) / 255.0;
+            end;
+          end;
+          node := node.NextSibling;
+        end;
+      end;
+      if LowerCase(iNode.NodeName) = 'sources' then
+      begin
+        node := iNode.FirstChild;
+        while node <> nil do
+        begin
+          s := LowerCase(node.NodeName);
+          if (s = 'tile') or (s = 'item') then begin
+            col := 1;
+            id := -1;
+            for i := node.Attributes.Length - 1 downto 0 do begin
+              if LowerCase(node.Attributes[i].NodeName) = 'id' then
+                if TryStrToInt(node.Attributes[i].NodeValue, id) then
+                begin
+                  if s = 'tile' then
+                    Dec(id, $4000);
+                end;
+              if LowerCase(node.Attributes[i].NodeName) = 'color' then
+                if TryStrToInt(node.Attributes[i].NodeValue, col) then
+                begin
+                  if (col < 1) or (col > ColorsCount) then
+                    col := 1;
+                end;
+            end;
+            if (id >= 0) and (id <= ResMan.Landscape.MaxStaticID) then
+              FTileCol[id] := col;
+          end;
+          node := node.NextSibling;
+        end;
+      end;
+      iNode := iNode.NextSibling;
+    end;
+  end;
+end;
+
 { TLightSource }
 
 constructor TLightSource.Create(AManager: TLightManager; AWorldItem: TWorldItem);
@@ -346,6 +471,9 @@ begin
   FMaterial := AManager.GetLight(lightID);
   if FMaterial <> nil then
   begin
+    FColorID := AManager.TileCol[AWorldItem.TileID];
+    if (FColorID < 1) or (FColorID > ColorsCount) then
+      FColorID := 1;
     AManager.FCalculateOffset(AWorldItem.X, AWorldItem.Y, FX, FY);
     FZ := AWorldItem.Z * 4;
     FY := FY + 22 - FZ;

Client/UOverlayUI.pas

@@ -1,255 +1,265 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2007 Andreas Schneider
- *)
-unit UOverlayUI;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, Gl, GLU, Imaging, ImagingTypes, ImagingClasses,
-  ImagingOpenGL, OpenGLContext, ImagingUtility;
-  
-type
-
-  { TGLArrow }
-
-  TGLArrow = class(TObject)
-    constructor Create(AGraphic: TSingleImage);
-    destructor Destroy; override;
-  protected
-    FGraphic: TSingleImage;
-    FTexture: GLuint;
-    FRealWidth: Integer;
-    FRealHeight: Integer;
-    FWidth: Integer;
-    FHeight: Integer;
-    FCurrentX: Integer;
-    FCurrentY: Integer;
-    procedure UpdateTexture;
-  public
-    property Width: Integer read FWidth;
-    property Height: Integer read FHeight;
-    property CurrentX: Integer read FCurrentX;
-    property CurrentY: Integer read FCurrentY;
-  
-    function HitTest(AX, AY: Integer): Boolean;
-    procedure DrawGL(AX, AY: Integer; AActive: Boolean = False);
-  end;
-  
-  { TOverlayUI }
-
-  TOverlayUI = class(TObject)
-    constructor Create;
-    destructor Destroy; override;
-  protected
-    FArrows: array[0..7] of TGLArrow;
-    FActiveArrow: Integer;
-    FVisible: Boolean;
-  public
-    property ActiveArrow: Integer read FActiveArrow write FActiveArrow;
-    property Visible: Boolean read FVisible write FVisible;
-    function HitTest(AX, AY: Integer): Integer;
-    procedure Draw(AContext: TOpenGLControl);
-  end;
-
-implementation
-
-uses
-  UResourceManager;
-
-{ TGLArrow }
-
-constructor TGLArrow.Create(AGraphic: TSingleImage);
-var
-  caps: TGLTextureCaps;
-begin
-  inherited Create;
-  FRealWidth := AGraphic.Width;
-  FRealHeight := AGraphic.Height;
-  GetGLTextureCaps(caps);
-  if caps.NonPowerOfTwo then
-  begin
-    FWidth := FRealWidth;
-    FHeight := FRealHeight;
-  end else
-  begin
-    if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth);
-    if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight);
-  end;
-  FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8);
-  AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0);
-  FTexture := 0;
-end;
-
-destructor TGLArrow.Destroy;
-begin
-  if FGraphic <> nil then FreeAndNil(FGraphic);
-  if FTexture <> 0 then glDeleteTextures(1, @FTexture);
-  inherited Destroy;
-end;
-
-procedure TGLArrow.UpdateTexture;
-begin
-  if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then
-  begin
-    FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False);
-
-    glBindTexture(GL_TEXTURE_2D, FTexture);
-    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
-    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
-    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
-    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
-  end;
-end;
-
-function TGLArrow.HitTest(AX, AY: Integer): Boolean;
-var
-  pixel: TColor32Rec;
-begin
-  if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then
-  begin
-    pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY);
-    Result := pixel.A > 0;
-  end else
-    Result := False;
-end;
-
-procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False);
-begin
-  FCurrentX := AX;
-  FCurrentY := AY;
-
-  if FTexture = 0 then UpdateTexture;
-
-  if FTexture <> 0 then
-  begin
-    if AActive then
-    begin
-      glEnable(GL_COLOR_LOGIC_OP);
-      glLogicOp(GL_COPY_INVERTED);
-    end;
-
-    glBindTexture(GL_TEXTURE_2D, FTexture);
-    glBegin(GL_QUADS);
-      glTexCoord2f(0, 0); glVertex2d(AX, AY);
-      glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY);
-      glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight);
-      glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight);
-    glEnd;
-    
-    if AActive then
-      glDisable(GL_COLOR_LOGIC_OP);
-  end;
-end;
-
-{ TOverlayUI }
-
-constructor TOverlayUI.Create;
-var
-  i: Integer;
-  arrow: TSingleImage;
-begin
-  inherited Create;
-  FActiveArrow := -1;
-  FVisible := False;
-  
-  arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0));
-  for i := 0 to 3 do
-  begin
-    FArrows[2*i] := TGLArrow.Create(arrow);
-    if i < 3 then
-      arrow.Rotate(-90);
-  end;
-  arrow.Free;
-
-  arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1));
-  for i := 0 to 3 do
-  begin
-    FArrows[2*i+1] := TGLArrow.Create(arrow);
-    if i < 3 then
-      arrow.Rotate(-90);
-  end;
-  arrow.Free;
-end;
-
-destructor TOverlayUI.Destroy;
-var
-  i: Integer;
-begin
-  for i := 0 to 7 do
-    if FArrows[i] <> nil then FreeAndNil(FArrows[i]);
-    
-  inherited Destroy;
-end;
-
-function TOverlayUI.HitTest(AX, AY: Integer): Integer;
-var
-  i: Integer;
-begin
-  Result := -1;
-  i := 0;
-  while (i <= 7) and (Result = -1) do
-  begin
-    if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then
-      Result := i;
-    Inc(i);
-  end;
-end;
-
-procedure TOverlayUI.Draw(AContext: TOpenGLControl);
-begin
-  if FVisible then
-  begin
-    glColor4f(1.0, 1.0, 1.0, 1.0);
-    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
-    FArrows[0].DrawGL(10, 10, FActiveArrow = 0);
-    FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10,
-                      FActiveArrow = 1);
-    FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10,
-                      FActiveArrow = 2);
-
-    FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width,
-                      AContext.Height div 2 - FArrows[3].Height div 2,
-                      FActiveArrow = 3);
-
-    FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width,
-                      AContext.Height - 10 - FArrows[4].Height,
-                      FActiveArrow = 4);
-    FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2,
-                      AContext.Height - 10 - FArrows[5].Height,
-                      FActiveArrow = 5);
-    FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height,
-                      FActiveArrow = 6);
-
-    FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2,
-                      FActiveArrow = 7);
-  end;
-end;
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2007 Andreas Schneider
+ *)
+unit UOverlayUI;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLType, Gl, GLU, Imaging, ImagingTypes, ImagingClasses,
+  ImagingOpenGL, OpenGLContext, ImagingUtility;
+  
+type
+
+  { TGLArrow }
+
+  TGLArrow = class(TObject)
+    constructor Create(AGraphic: TSingleImage);
+    destructor Destroy; override;
+  protected
+    FGraphic: TSingleImage;
+    FTexture: GLuint;
+    FRealWidth: Integer;
+    FRealHeight: Integer;
+    FWidth: Integer;
+    FHeight: Integer;
+    FCurrentX: Integer;
+    FCurrentY: Integer;
+    procedure UpdateTexture;
+  public
+    property Width: Integer read FWidth;
+    property Height: Integer read FHeight;
+    property CurrentX: Integer read FCurrentX;
+    property CurrentY: Integer read FCurrentY;
+  
+    function HitTest(AX, AY: Integer): Boolean;
+    procedure DrawGL(AX, AY: Integer; AActive: Boolean = False);
+  end;
+  
+  { TOverlayUI }
+
+  TOverlayUI = class(TObject)
+    constructor Create;
+    destructor Destroy; override;
+  protected
+    FArrows: array[0..7] of TGLArrow;
+    FActiveArrow: Integer;
+    FVisible: Boolean;
+  public
+    property ActiveArrow: Integer read FActiveArrow write FActiveArrow;
+    property Visible: Boolean read FVisible write FVisible;
+    function HitTest(AX, AY: Integer): Integer;
+    procedure Draw(AContext: TOpenGLControl);
+  end;
+
+implementation
+
+{ TGLArrow }
+
+constructor TGLArrow.Create(AGraphic: TSingleImage);
+var
+  caps: TGLTextureCaps;
+begin
+  inherited Create;
+  FRealWidth := AGraphic.Width;
+  FRealHeight := AGraphic.Height;
+  GetGLTextureCaps(caps);
+  if caps.NonPowerOfTwo then
+  begin
+    FWidth := FRealWidth;
+    FHeight := FRealHeight;
+  end else
+  begin
+    if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth);
+    if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight);
+  end;
+  FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8);
+  AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0);
+  FTexture := 0;
+end;
+
+destructor TGLArrow.Destroy;
+begin
+  if FGraphic <> nil then FreeAndNil(FGraphic);
+  if FTexture <> 0 then glDeleteTextures(1, @FTexture);
+  inherited Destroy;
+end;
+
+procedure TGLArrow.UpdateTexture;
+begin
+  if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then
+  begin
+    FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False);
+
+    glBindTexture(GL_TEXTURE_2D, FTexture);
+    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
+    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
+    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
+    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
+  end;
+end;
+
+function TGLArrow.HitTest(AX, AY: Integer): Boolean;
+var
+  pixel: TColor32Rec;
+begin
+  if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then
+  begin
+    pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY);
+    Result := pixel.A > 0;
+  end else
+    Result := False;
+end;
+
+procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False);
+begin
+  FCurrentX := AX;
+  FCurrentY := AY;
+
+  if FTexture = 0 then UpdateTexture;
+
+  if FTexture <> 0 then
+  begin
+    if AActive then
+    begin
+      glEnable(GL_COLOR_LOGIC_OP);
+      glLogicOp(GL_COPY_INVERTED);
+    end;
+
+    glBindTexture(GL_TEXTURE_2D, FTexture);
+    glBegin(GL_QUADS);
+      glTexCoord2f(0, 0); glVertex2d(AX, AY);
+      glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY);
+      glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight);
+      glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight);
+    glEnd;
+    
+    if AActive then
+      glDisable(GL_COLOR_LOGIC_OP);
+  end;
+end;
+
+{ TOverlayUI }
+
+constructor TOverlayUI.Create;
+var
+  i: Integer;
+  arrow: TSingleImage;
+  resStream: TResourceStream;
+begin
+  inherited Create;
+  FActiveArrow := -1;
+  FVisible := False;
+
+  resStream := TResourceStream.Create(HINSTANCE, 'LEFTTOPARROW', RT_RCDATA);
+  try
+    arrow := TSingleImage.CreateFromStream(resStream);
+  finally
+    resStream.Free;
+  end;
+
+  for i := 0 to 3 do
+  begin
+    FArrows[2*i] := TGLArrow.Create(arrow);
+    if i < 3 then
+      arrow.Rotate(-90);
+  end;
+  arrow.Free;
+
+  resStream := TResourceStream.Create(HINSTANCE, 'TOPARROW', RT_RCDATA);
+  try
+    arrow := TSingleImage.CreateFromStream(resStream);
+  finally
+    resStream.Free;
+  end;
+
+  for i := 0 to 3 do
+  begin
+    FArrows[2*i+1] := TGLArrow.Create(arrow);
+    if i < 3 then
+      arrow.Rotate(-90);
+  end;
+  arrow.Free;
+end;
+
+destructor TOverlayUI.Destroy;
+var
+  i: Integer;
+begin
+  for i := 0 to 7 do
+    if FArrows[i] <> nil then FreeAndNil(FArrows[i]);
+    
+  inherited Destroy;
+end;
+
+function TOverlayUI.HitTest(AX, AY: Integer): Integer;
+var
+  i: Integer;
+begin
+  Result := -1;
+  i := 0;
+  while (i <= 7) and (Result = -1) do
+  begin
+    if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then
+      Result := i;
+    Inc(i);
+  end;
+end;
+
+procedure TOverlayUI.Draw(AContext: TOpenGLControl);
+begin
+  if FVisible then
+  begin
+    glColor4f(1.0, 1.0, 1.0, 1.0);
+    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+    FArrows[0].DrawGL(10, 10, FActiveArrow = 0);
+    FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10,
+                      FActiveArrow = 1);
+    FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10,
+                      FActiveArrow = 2);
+
+    FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width,
+                      AContext.Height div 2 - FArrows[3].Height div 2,
+                      FActiveArrow = 3);
+
+    FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width,
+                      AContext.Height - 10 - FArrows[4].Height,
+                      FActiveArrow = 4);
+    FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2,
+                      AContext.Height - 10 - FArrows[5].Height,
+                      FActiveArrow = 5);
+    FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height,
+                      FActiveArrow = 6);
+
+    FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2,
+                      FActiveArrow = 7);
+  end;
+end;
+
+end.
+

Client/UPacketHandlers.pas

@@ -1,150 +1,151 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2007 Andreas Schneider
- *)
-unit UPacketHandlers;
-
-interface
-
-uses
-  SysUtils, dzlib, UEnhancedMemoryStream;
-
-type
-  TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream);
-  TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object;
-
-  { TPacketHandler }
-
-  TPacketHandler = class(TObject)
-    constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
-    constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
-    procedure Process(ABuffer: TEnhancedMemoryStream);
-  protected
-    FLength: Cardinal;
-    FPacketProcessor: TPacketProcessor;
-    FPacketProcessorMethod: TPacketProcessorMethod;
-  published
-    property PacketLength: Cardinal read FLength;
-  end;
-
-var
-  PacketHandlers: array[0..$FF] of TPacketHandler;
-  
-procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
-
-implementation
-
-uses
-  UAdminHandling;
-
-procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
-begin
-  FreeAndNil(PacketHandlers[AID]);
-  PacketHandlers[AID] := APacketHandler;
-end;
-
-{ TPacketHandler }
-
-constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
-begin
-  inherited Create;
-  FLength := ALength;
-  FPacketProcessor := APacketProcessor;
-  FPacketProcessorMethod := nil;
-end;
-
-constructor TPacketHandler.Create(ALength: Cardinal;
-  APacketProcessorMethod: TPacketProcessorMethod);
-begin
-  inherited Create;
-  FLength := ALength;
-  FPacketProcessor := nil;
-  FPacketProcessorMethod := APacketProcessorMethod;
-end;
-
-procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream);
-begin
-  if Assigned(FPacketProcessor) then
-    FPacketProcessor(ABuffer)
-  else if Assigned(FPacketProcessorMethod) then
-    FPacketProcessorMethod(ABuffer);
-end;
-
-procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream);
-var
-  uncompStream: TEnhancedMemoryStream;
-  uncompBuffer: TDecompressionStream;
-  targetSize: Cardinal;
-  packetID: Byte;
-begin
-  //writeln('compressed size: ', ABuffer.Size);
-  targetSize := ABuffer.ReadCardinal;
-  //writeln('uncompressed size: ', targetSize);
-  uncompBuffer := TDecompressionStream.Create(ABuffer);
-  uncompStream := TEnhancedMemoryStream.Create;
-  try
-    uncompStream.CopyFrom(uncompBuffer, targetSize);
-    uncompStream.Position := 0;
-    packetID := uncompStream.ReadByte;
-    if PacketHandlers[packetID] <> nil then
-    begin
-      if PacketHandlers[PacketID].PacketLength = 0 then
-        uncompStream.Position := uncompStream.Position + 4;
-      uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
-      PacketHandlers[PacketID].Process(uncompStream);
-      uncompStream.Unlock;
-    end else
-    begin
-      {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
-      ANetState.Socket.Disconnect;
-      ANetState.ReceiveQueue.Clear;}
-    end;
-  finally
-    if uncompBuffer <> nil then uncompBuffer.Free;
-    if uncompStream <> nil then uncompStream.Free;
-  end;
-end;
-
-
-{$WARNINGS OFF}
-var
-  i: Integer;
-
-initialization
-  for i := 0 to $FF do
-    PacketHandlers[i] := nil;
-  PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
-  //$02 --> ConnectionHandling, done by TdmNetwork
-  PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);;
-  //$04 --> handled by TLandscape
-  //$06-$0B --> handled by TLandscape
-  //$0C --> ClientHandling, done by TfrmMain
-  //$0D --> RadarMapHandling, done by TfrmRadarMap
-finalization
-  for i := 0 to $FF do
-    if PacketHandlers[i] <> nil then
-      PacketHandlers[i].Free;
-{$WARNINGS ON}
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2007 Andreas Schneider
+ *)
+unit UPacketHandlers;
+
+interface
+
+uses
+  SysUtils, dzlib, UEnhancedMemoryStream;
+
+type
+  TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream);
+  TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object;
+
+  { TPacketHandler }
+
+  TPacketHandler = class(TObject)
+    constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
+    constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
+    procedure Process(ABuffer: TEnhancedMemoryStream);
+  protected
+    FLength: Cardinal;
+    FPacketProcessor: TPacketProcessor;
+    FPacketProcessorMethod: TPacketProcessorMethod;
+  published
+    property PacketLength: Cardinal read FLength;
+  end;
+
+var
+  PacketHandlers: array[0..$FF] of TPacketHandler;
+  
+procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
+
+implementation
+
+uses
+  UAdminHandling;
+
+procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
+begin
+  FreeAndNil(PacketHandlers[AID]);
+  PacketHandlers[AID] := APacketHandler;
+end;
+
+{ TPacketHandler }
+
+constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
+begin
+  inherited Create;
+  FLength := ALength;
+  FPacketProcessor := APacketProcessor;
+  FPacketProcessorMethod := nil;
+end;
+
+constructor TPacketHandler.Create(ALength: Cardinal;
+  APacketProcessorMethod: TPacketProcessorMethod);
+begin
+  inherited Create;
+  FLength := ALength;
+  FPacketProcessor := nil;
+  FPacketProcessorMethod := APacketProcessorMethod;
+end;
+
+procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream);
+begin
+  if Assigned(FPacketProcessor) then
+    FPacketProcessor(ABuffer)
+  else if Assigned(FPacketProcessorMethod) then
+    FPacketProcessorMethod(ABuffer);
+end;
+
+procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream);
+var
+  uncompStream: TEnhancedMemoryStream;
+  uncompBuffer: TDecompressionStream;
+  targetSize: Cardinal;
+  packetID: Byte;
+begin
+  //writeln('compressed size: ', ABuffer.Size);
+  targetSize := ABuffer.ReadCardinal;
+  //writeln('uncompressed size: ', targetSize);
+  uncompBuffer := TDecompressionStream.Create(ABuffer);
+  uncompStream := TEnhancedMemoryStream.Create;
+  try
+    uncompStream.CopyFrom(uncompBuffer, targetSize);
+    uncompStream.Position := 0;
+    packetID := uncompStream.ReadByte;
+    if PacketHandlers[packetID] <> nil then
+    begin
+      if PacketHandlers[PacketID].PacketLength = 0 then
+        uncompStream.Position := uncompStream.Position + 4;
+      uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
+      PacketHandlers[PacketID].Process(uncompStream);
+      uncompStream.Unlock;
+    end else
+    begin
+      {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
+      ANetState.Socket.Disconnect;
+      ANetState.ReceiveQueue.Clear;}
+    end;
+  finally
+    if uncompBuffer <> nil then uncompBuffer.Free;
+    if uncompStream <> nil then uncompStream.Free;
+  end;
+end;
+
+
+{$WARNINGS OFF}
+var
+  i: Integer;
+
+initialization
+  for i := 0 to $FF do
+    PacketHandlers[i] := nil;
+  PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
+  //$02 --> ConnectionHandling, done by TdmNetwork
+  PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);;
+  //$04 --> handled by TLandscape
+  //$06-$0B --> handled by TLandscape
+  //$0C --> ClientHandling, done by TfrmMain
+  //$0D --> RadarMapHandling, done by TfrmRadarMap
+  //$0E --> LargeScaleCommands, done by TfrmLargeScaleCommands
+finalization
+  for i := 0 to $FF do
+    if PacketHandlers[i] <> nil then
+      PacketHandlers[i].Free;
+{$WARNINGS ON}
+end.
+

Client/UPackets.pas

@@ -1,373 +1,396 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UPackets;
-
-interface
-
-uses
-  Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics;
-
-type
-  TBlockCoords = packed record
-    X: Word;
-    Y: Word;
-  end;
-  TBlockCoordsArray = array of TBlockCoords;
-  
-  { TCompressedPacket }
-
-  TCompressedPacket = class(TPacket)
-    constructor Create(APacket: TPacket);
-  end;
-  
-  { TLoginRequestPacket }
-
-  TLoginRequestPacket = class(TPacket)
-    constructor Create(AUsername, APassword: string);
-  end;
-  
-  { TQuitPacket }
-
-  TQuitPacket = class(TPacket)
-    constructor Create;
-  end;
-    
-  { TRequestBlocksPacket }
-
-  TRequestBlocksPacket = class(TPacket)
-    constructor Create(ACoords: TBlockCoordsArray);
-  end;
-  
-  { TFreeBlockPacket }
-
-  TFreeBlockPacket = class(TPacket)
-    constructor Create(AX, AY: Word);
-  end;
-  
-  { TDrawMapPacket }
-
-  TDrawMapPacket = class(TPacket)
-    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
-  end;
-
-  { TStaticPacket }
-
-  TStaticPacket = class(TPacket)
-  protected
-    procedure WriteStaticItem(AStaticItem: TStaticItem);
-  end;
-  
-  { TInsertStaticPacket }
-
-  TInsertStaticPacket = class(TPacket)
-    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
-  end;
-  
-  { TDeleteStaticPacket }
-
-  TDeleteStaticPacket = class(TStaticPacket)
-    constructor Create(AStaticItem: TStaticItem);
-  end;
-  
-  { TElevateStaticPacket }
-
-  TElevateStaticPacket = class(TStaticPacket)
-    constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
-    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
-      ANewZ: Word);
-  end;
-  
-  { TMoveStaticPacket }
-
-  TMoveStaticPacket = class(TStaticPacket)
-    constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
-    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
-      ANewX, ANewY: Word);
-  end;
-  
-  { THueStaticPacket }
-
-  THueStaticPacket = class(TStaticPacket)
-    constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
-    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
-      ANewHue: Word);
-  end;
-  
-  { TUpdateClientPosPacket }
-
-  TUpdateClientPosPacket = class(TPacket)
-    constructor Create(AX, AY: Word);
-  end;
-  
-  { TChatMessagePacket }
-
-  TChatMessagePacket = class(TPacket)
-    constructor Create(AMessage: string);
-  end;
-  
-  { TGotoClientPosPacket }
-
-  TGotoClientPosPacket = class(TPacket)
-    constructor Create(AUsername: string);
-  end;
-  
-  { TRequestRadarChecksumPacket }
-
-  TRequestRadarChecksumPacket = class(TPacket)
-    constructor Create;
-  end;
-  
-  { TRequestRadarMapPacket }
-
-  TRequestRadarMapPacket = class(TPacket)
-    constructor Create;
-  end;
-  
-  { TNoOpPacket }
-
-  TNoOpPacket = class(TPacket)
-    constructor Create;
-  end;
-
-implementation
-
-{ TCompressedPacket }
-
-constructor TCompressedPacket.Create(APacket: TPacket);
-var
-  compBuffer: TEnhancedMemoryStream;
-  compStream: TCompressionStream;
-  sourceStream: TStream;
-begin
-  inherited Create($01, 0);
-  compBuffer := TEnhancedMemoryStream.Create;
-  compStream := TCompressionStream.Create(clMax, compBuffer);
-  sourceStream := APacket.Stream;  
-  compStream.CopyFrom(sourceStream, 0);
-  compStream.Free;  
-  FStream.WriteCardinal(sourceStream.Size);
-  FStream.CopyFrom(compBuffer, 0);
-  compBuffer.Free;
-  APacket.Free;
-end;
-
-{ TLoginRequestPacket }
-
-constructor TLoginRequestPacket.Create(AUsername, APassword: string);
-begin
-  inherited Create($02, 0);
-  FStream.WriteByte($03);
-  FStream.WriteStringNull(AUsername);
-  FStream.WriteStringNull(APassword);
-end;
-
-{ TQuitPacket }
-
-constructor TQuitPacket.Create;
-begin
-  inherited Create($02, 0);
-  FStream.WriteByte($05);
-end;
-
-{ TRequestBlocksPacket }
-
-constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
-begin
-  inherited Create($04, 0);
-  FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
-end;
-
-{ TFreeBlockPacket }
-
-constructor TFreeBlockPacket.Create(AX, AY: Word);
-begin
-  inherited Create($05, 5);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-end;
-
-{ TDrawMapPacket }
-
-constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
-begin
-  inherited Create($06, 8);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-  FStream.WriteShortInt(AZ);
-  FStream.WriteWord(ATileID);
-end;
-
-{ TStaticPacket }
-
-procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
-begin
-  FStream.WriteWord(AStaticItem.X);
-  FStream.WriteWord(AStaticItem.Y);
-  FStream.WriteShortInt(AStaticItem.Z);
-  FStream.WriteWord(AStaticItem.TileID);
-  FStream.WriteWord(AStaticItem.Hue);
-end;
-
-{ TInsertStaticPacket }
-
-constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
-  ATileID: Word; AHue: Word);
-begin
-  inherited Create($07, 10);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-  FStream.WriteShortInt(AZ);
-  FStream.WriteWord(ATileID);
-  FStream.WriteWord(AHue);
-end;
-
-{ TDeleteStaticPacket }
-
-constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
-begin
-  inherited Create($08, 10);
-  WriteStaticItem(AStaticItem);
-end;
-
-{ TElevateStaticPacket }
-
-constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
-begin
-  inherited Create($09, 11);
-  WriteStaticItem(AStaticItem);
-  FStream.WriteShortInt(ANewZ);
-end;
-
-constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
-  ATileID: Word; AHue: Word; ANewZ: Word);
-begin
-  inherited Create($09, 11);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-  FStream.WriteShortInt(AZ);
-  FStream.WriteWord(ATileID);
-  FStream.WriteWord(AHue);
-  FStream.WriteShortInt(ANewZ);
-end;
-
-{ TMoveStaticPacket }
-
-constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
-  ANewY: Word);
-begin
-  inherited Create($0A, 14);
-  WriteStaticItem(AStaticItem);
-  FStream.WriteWord(ANewX);
-  FStream.WriteWord(ANewY);
-end;
-
-constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
-  AHue: Word; ANewX, ANewY: Word);
-begin
-  inherited Create($0A, 14);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-  FStream.WriteShortInt(AZ);
-  FStream.WriteWord(ATileID);
-  FStream.WriteWord(AHue);
-  FStream.WriteWord(ANewX);
-  FStream.WriteWord(ANewY);
-end;
-
-{ THueStaticPacket }
-
-constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
-begin
-  inherited Create($0B, 12);
-  WriteStaticItem(AStaticItem);
-  FStream.WriteWord(ANewHue);
-end;
-
-constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
-  AHue: Word; ANewHue: Word);
-begin
-  inherited Create($0B, 12);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-  FStream.WriteShortInt(AZ);
-  FStream.WriteWord(ATileID);
-  FStream.WriteWord(AHue);
-  FStream.WriteWord(ANewHue);
-end;
-
-{ TUpdateClientPosPacket }
-
-constructor TUpdateClientPosPacket.Create(AX, AY: Word);
-begin
-  inherited Create($0C, 0);
-  FStream.WriteByte($04);
-  FStream.WriteWord(AX);
-  FStream.WriteWord(AY);
-end;
-
-{ TChatMessagePacket }
-
-constructor TChatMessagePacket.Create(AMessage: string);
-begin
-  inherited Create($0C, 0);
-  FStream.WriteByte($05);
-  FStream.WriteStringNull(AMessage);
-end;
-
-{ TGotoClientPosPacket }
-
-constructor TGotoClientPosPacket.Create(AUsername: string);
-begin
-  inherited Create($0C, 0);
-  FStream.WriteByte($06);
-  FStream.WriteStringNull(AUsername);
-end;
-
-{ TRequestRadarChecksumPacket }
-
-constructor TRequestRadarChecksumPacket.Create;
-begin
-  inherited Create($0D, 2);
-  FStream.WriteByte($01);
-end;
-
-{ TRequestRadarMapPacket }
-
-constructor TRequestRadarMapPacket.Create;
-begin
-  inherited Create($0D, 2);
-  FStream.WriteByte($02);
-end;
-
-{ TNoOpPacket }
-
-constructor TNoOpPacket.Create;
-begin
-  inherited Create($FF, 1);
-end;
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2013 Andreas Schneider
+ *)
+unit UPackets;
+
+interface
+
+uses
+  Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics;
+
+type
+  TBlockCoords = packed record
+    X: Word;
+    Y: Word;
+  end;
+  TBlockCoordsArray = array of TBlockCoords;
+  
+  { TCompressedPacket }
+
+  TCompressedPacket = class(TPacket)
+    constructor Create(APacket: TPacket);
+  end;
+  
+  { TLoginRequestPacket }
+
+  TLoginRequestPacket = class(TPacket)
+    constructor Create(AUsername, APassword: string);
+  end;
+  
+  { TQuitPacket }
+
+  TQuitPacket = class(TPacket)
+    constructor Create;
+  end;
+    
+  { TRequestBlocksPacket }
+
+  TRequestBlocksPacket = class(TPacket)
+    constructor Create(ACoords: TBlockCoordsArray);
+  end;
+  
+  { TFreeBlockPacket }
+
+  TFreeBlockPacket = class(TPacket)
+    constructor Create(AX, AY: Word);
+  end;
+  
+  { TDrawMapPacket }
+
+  TDrawMapPacket = class(TPacket)
+    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
+  end;
+
+  { TStaticPacket }
+
+  TStaticPacket = class(TPacket)
+  protected
+    procedure WriteStaticItem(AStaticItem: TStaticItem);
+  end;
+  
+  { TInsertStaticPacket }
+
+  TInsertStaticPacket = class(TStaticPacket)
+    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word); overload;
+    constructor Create(AStaticItem: TStaticItem); overload;
+  end;
+  
+  { TDeleteStaticPacket }
+
+  TDeleteStaticPacket = class(TStaticPacket)
+    constructor Create(AStaticItem: TStaticItem);
+  end;
+  
+  { TElevateStaticPacket }
+
+  TElevateStaticPacket = class(TStaticPacket)
+    constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
+    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
+      ANewZ: Word);
+  end;
+  
+  { TMoveStaticPacket }
+
+  TMoveStaticPacket = class(TStaticPacket)
+    constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
+    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
+      ANewX, ANewY: Word);
+  end;
+  
+  { THueStaticPacket }
+
+  THueStaticPacket = class(TStaticPacket)
+    constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
+    constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
+      ANewHue: Word);
+  end;
+  
+  { TUpdateClientPosPacket }
+
+  TUpdateClientPosPacket = class(TPacket)
+    constructor Create(AX, AY: Word);
+  end;
+  
+  { TChatMessagePacket }
+
+  TChatMessagePacket = class(TPacket)
+    constructor Create(AMessage: string);
+  end;
+  
+  { TGotoClientPosPacket }
+
+  TGotoClientPosPacket = class(TPacket)
+    constructor Create(AUsername: string);
+  end;
+
+  { TChangePasswordPacket }
+
+  TChangePasswordPacket = class(TPacket)
+    constructor Create(AOldPassword, ANewPassword: String);
+  end;
+  
+  { TRequestRadarChecksumPacket }
+
+  TRequestRadarChecksumPacket = class(TPacket)
+    constructor Create;
+  end;
+  
+  { TRequestRadarMapPacket }
+
+  TRequestRadarMapPacket = class(TPacket)
+    constructor Create;
+  end;
+  
+  { TNoOpPacket }
+
+  TNoOpPacket = class(TPacket)
+    constructor Create;
+  end;
+
+implementation
+
+{ TCompressedPacket }
+
+constructor TCompressedPacket.Create(APacket: TPacket);
+var
+  compBuffer: TEnhancedMemoryStream;
+  compStream: TCompressionStream;
+  sourceStream: TStream;
+begin
+  inherited Create($01, 0);
+  compBuffer := TEnhancedMemoryStream.Create;
+  compStream := TCompressionStream.Create(clMax, compBuffer);
+  sourceStream := APacket.Stream;  
+  compStream.CopyFrom(sourceStream, 0);
+  compStream.Free;  
+  FStream.WriteCardinal(sourceStream.Size);
+  FStream.CopyFrom(compBuffer, 0);
+  compBuffer.Free;
+  APacket.Free;
+end;
+
+{ TLoginRequestPacket }
+
+constructor TLoginRequestPacket.Create(AUsername, APassword: string);
+begin
+  inherited Create($02, 0);
+  FStream.WriteByte($03);
+  FStream.WriteStringNull(AUsername);
+  FStream.WriteStringNull(APassword);
+end;
+
+{ TQuitPacket }
+
+constructor TQuitPacket.Create;
+begin
+  inherited Create($02, 0);
+  FStream.WriteByte($05);
+end;
+
+{ TRequestBlocksPacket }
+
+constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
+begin
+  inherited Create($04, 0);
+  FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
+end;
+
+{ TFreeBlockPacket }
+
+constructor TFreeBlockPacket.Create(AX, AY: Word);
+begin
+  inherited Create($05, 5);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+end;
+
+{ TDrawMapPacket }
+
+constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
+begin
+  inherited Create($06, 8);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+  FStream.WriteShortInt(AZ);
+  FStream.WriteWord(ATileID);
+end;
+
+{ TStaticPacket }
+
+procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
+begin
+  FStream.WriteWord(AStaticItem.X);
+  FStream.WriteWord(AStaticItem.Y);
+  FStream.WriteShortInt(AStaticItem.Z);
+  FStream.WriteWord(AStaticItem.TileID);
+  FStream.WriteWord(AStaticItem.Hue);
+end;
+
+{ TInsertStaticPacket }
+
+constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
+  ATileID: Word; AHue: Word);
+begin
+  inherited Create($07, 10);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+  FStream.WriteShortInt(AZ);
+  FStream.WriteWord(ATileID);
+  FStream.WriteWord(AHue);
+end;
+
+constructor TInsertStaticPacket.Create(AStaticItem: TStaticItem);
+begin
+  inherited Create($07, 10);
+  WriteStaticItem(AStaticItem);
+end;
+
+{ TDeleteStaticPacket }
+
+constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
+begin
+  inherited Create($08, 10);
+  WriteStaticItem(AStaticItem);
+end;
+
+{ TElevateStaticPacket }
+
+constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
+begin
+  inherited Create($09, 11);
+  WriteStaticItem(AStaticItem);
+  FStream.WriteShortInt(ANewZ);
+end;
+
+constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
+  ATileID: Word; AHue: Word; ANewZ: Word);
+begin
+  inherited Create($09, 11);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+  FStream.WriteShortInt(AZ);
+  FStream.WriteWord(ATileID);
+  FStream.WriteWord(AHue);
+  FStream.WriteShortInt(ANewZ);
+end;
+
+{ TMoveStaticPacket }
+
+constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
+  ANewY: Word);
+begin
+  inherited Create($0A, 14);
+  WriteStaticItem(AStaticItem);
+  FStream.WriteWord(ANewX);
+  FStream.WriteWord(ANewY);
+end;
+
+constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
+  AHue: Word; ANewX, ANewY: Word);
+begin
+  inherited Create($0A, 14);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+  FStream.WriteShortInt(AZ);
+  FStream.WriteWord(ATileID);
+  FStream.WriteWord(AHue);
+  FStream.WriteWord(ANewX);
+  FStream.WriteWord(ANewY);
+end;
+
+{ THueStaticPacket }
+
+constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
+begin
+  inherited Create($0B, 12);
+  WriteStaticItem(AStaticItem);
+  FStream.WriteWord(ANewHue);
+end;
+
+constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
+  AHue: Word; ANewHue: Word);
+begin
+  inherited Create($0B, 12);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+  FStream.WriteShortInt(AZ);
+  FStream.WriteWord(ATileID);
+  FStream.WriteWord(AHue);
+  FStream.WriteWord(ANewHue);
+end;
+
+{ TUpdateClientPosPacket }
+
+constructor TUpdateClientPosPacket.Create(AX, AY: Word);
+begin
+  inherited Create($0C, 0);
+  FStream.WriteByte($04);
+  FStream.WriteWord(AX);
+  FStream.WriteWord(AY);
+end;
+
+{ TChatMessagePacket }
+
+constructor TChatMessagePacket.Create(AMessage: string);
+begin
+  inherited Create($0C, 0);
+  FStream.WriteByte($05);
+  FStream.WriteStringNull(AMessage);
+end;
+
+{ TGotoClientPosPacket }
+
+constructor TGotoClientPosPacket.Create(AUsername: string);
+begin
+  inherited Create($0C, 0);
+  FStream.WriteByte($06);
+  FStream.WriteStringNull(AUsername);
+end;
+
+{ TChangePasswordPacket }
+
+constructor TChangePasswordPacket.Create(AOldPassword, ANewPassword: String);
+begin
+  inherited Create($0C, 0);
+  FStream.WriteByte($08);
+  FStream.WriteStringNull(AOldPassword);
+  FStream.WriteStringNull(ANewPassword);
+end;
+
+{ TRequestRadarChecksumPacket }
+
+constructor TRequestRadarChecksumPacket.Create;
+begin
+  inherited Create($0D, 2);
+  FStream.WriteByte($01);
+end;
+
+{ TRequestRadarMapPacket }
+
+constructor TRequestRadarMapPacket.Create;
+begin
+  inherited Create($0D, 2);
+  FStream.WriteByte($02);
+end;
+
+{ TNoOpPacket }
+
+constructor TNoOpPacket.Create;
+begin
+  inherited Create($FF, 1);
+end;
+
+end.
+

Client/UPlatformTypes.pas

@@ -1,41 +1,42 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2007 Andreas Schneider
- *)
-unit UPlatformTypes;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, ActiveX;
-  
-type
-  IDataObject = ActiveX.IDataObject;
-
-implementation
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2007 Andreas Schneider
+ *)
+unit UPlatformTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  {$IFDEF WINDOWS}ActiveX{$ELSE}laz.FakeActiveX{$ENDIF};
+  
+type
+  IDataObject = {$IFDEF WINDOWS}ActiveX{$ELSE}laz.FakeActiveX{$ENDIF}.IDataObject;
+
+implementation
+
+end.
+

Client/UResourceManager.pas

@@ -1,105 +0,0 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UResourceManager;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils;
-  
-type
-
-  { TResourceManager }
-
-  TResourceManager = class
-    constructor Create(AFileName: string);
-    destructor Destroy; override;
-  protected
-    FFileStream: TFileStream;
-    FCount: Integer;
-    FLookupTable: array of Cardinal;
-    FCurrentResource: Integer;
-    FResourceStream: TMemoryStream;
-  public
-    function GetResource(AIndex: Integer): TStream;
-  end;
-  
-var
-  ResourceManager: TResourceManager;
-
-implementation
-
-{ TResourceManager }
-
-constructor TResourceManager.Create(AFileName: string);
-begin
-  inherited Create;
-  FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
-  FFileStream.Position := 0;
-  FFileStream.Read(FCount, SizeOf(Integer));
-  SetLength(FLookupTable, FCount);
-  FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
-  FCurrentResource := -1;
-end;
-
-destructor TResourceManager.Destroy;
-begin
-  FreeAndNil(FFileStream);
-  FreeAndNil(FResourceStream);
-  inherited Destroy;
-end;
-
-function TResourceManager.GetResource(AIndex: Integer): TStream;
-var
-  size: Cardinal;
-begin
-  if AIndex <> FCurrentResource then
-  begin
-    FFileStream.Position := FLookupTable[AIndex];
-    FResourceStream.Free;
-    FResourceStream := TMemoryStream.Create;
-    FFileStream.Read(size, SizeOf(Cardinal));
-    FResourceStream.CopyFrom(FFileStream, size);
-    FCurrentResource := AIndex;
-  end;
-  FResourceStream.Position := 0;
-  Result := FResourceStream;
-end;
-
-initialization
-begin
-  ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
-end;
-
-finalization
-begin
-  if ResourceManager <> nil then FreeAndNil(ResourceManager);
-end;
-
-end.
-

Client/USelectionHelper.pas

@@ -0,0 +1,113 @@
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2015 Andreas Schneider
+ *)
+unit USelectionHelper;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  TSelectedRangeCallback = procedure(AX1, AY1, AX2, AY2: Word) of object;
+
+procedure SelectRange(ACallback: TSelectedRangeCallback);
+
+implementation
+
+uses
+  UfrmMain, UWorldItem, math;
+
+type
+
+  { TRangeSelectionHelper }
+
+  TRangeSelectionHelper = class
+    constructor Create(ACallback: TSelectedRangeCallback);
+  protected
+    FCallback: TSelectedRangeCallback;
+    FItem1: TWorldItem;
+    FItem2: TWorldItem;
+    procedure TileSelected(AWorldItem: TWorldItem);
+    procedure Finish;
+  public
+    procedure Run;
+  end;
+
+procedure SelectRange(ACallback: TSelectedRangeCallback);
+var
+  helper: TRangeSelectionHelper;
+begin
+  helper := TRangeSelectionHelper.Create(ACallback);
+  helper.Run;
+  //Cleanup will follow asynchroneously
+end;
+
+{ TRangeSelectionHelper }
+
+constructor TRangeSelectionHelper.Create(ACallback: TSelectedRangeCallback);
+begin
+  FCallback := ACallback;
+  FItem1 := nil;
+  FItem2 := nil;
+end;
+
+procedure TRangeSelectionHelper.TileSelected(AWorldItem: TWorldItem);
+begin
+  if FItem1 = nil then
+    FItem1 := AWorldItem
+  else if FItem2 = nil then
+  begin
+    FItem2 := AWorldItem;
+    Finish;
+  end;
+end;
+
+procedure TRangeSelectionHelper.Finish;
+var
+  minX, minY: Word;
+  maxX, maxY: Word;
+begin
+  frmMain.UnregisterSelectionListener(@TileSelected);
+  minX := Min(FItem1.X, FItem2.X);
+  minY := Min(FItem1.Y, FItem2.Y);
+  maxX := Max(FItem1.X, FItem2.X);
+  maxY := Max(FItem1.Y, FItem2.Y);
+  FCallback(minX, minY, maxX, maxY);
+  Free; //We use this class only once, so it can cleanup after itself
+end;
+
+procedure TRangeSelectionHelper.Run;
+begin
+  //TODO show indicator and option to cancel
+  //TODO keep track of instance (global variable maybe?)
+  frmMain.RegisterSelectionListener(@TileSelected);
+  frmMain.SwitchToSelection;
+end;
+
+end.
+

Client/UUoaDesigns.pas

@@ -0,0 +1,187 @@
+unit UUoaDesigns;
+
+{$mode ObjFPC}{$H+}
+{$modeSwitch advancedRecords}
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Collections, UStatics;
+
+type
+
+  { TUoaDesignHeader }
+
+  TUoaDesignHeader = record
+    Name: String;
+    Category: String;
+    Subcategory: String;
+    Width: Int32;
+    Height: Int32;
+    UserWidth: Int32;
+    UserHeight: Int32;
+    FilePosition: Int64;
+    TileCount: Int32;
+  public
+    constructor CreateFromStream(AStream: TStream);
+  end;
+
+  { TUoaDesignHeaders }
+
+  TUoaDesignHeaders = class(specialize TList<TUoaDesignHeader>)
+    constructor CreateFromStream(AStream: TStream);
+  end;
+
+  TUoaDesign = class
+  private
+    FHeader: TUoaDesignHeader;
+    FTiles: TStaticItemList;
+
+    constructor Create(AHeader: TUoaDesignHeader; AData: TStream);
+  public
+    property Header: TUoaDesignHeader read FHeader;
+    property Tiles: TStaticItemList read Ftiles;
+
+    destructor Destroy; override;
+  end;
+
+  { TUoaDesigns }
+
+  TUoaDesigns = class
+  private
+    FHeaders: TUoaDesignHeaders;
+    FData: TFileStream;
+  public
+    constructor Create(AIdxFile, ABinFile: String);
+    destructor Destroy; override;
+
+    function LoadDesign(AHeader: TUoaDesignHeader): TUoaDesign;
+  public
+    property Headers: TUoaDesignHeaders read FHeaders;
+  end;
+
+implementation
+
+uses
+  Math;
+
+function ReadString(AStream: TStream): String;
+var
+  nonNullFlag: Byte;
+  length: Byte;
+begin
+  nonNullFlag := AStream.ReadByte;
+  if nonNullFlag = 1 then
+  begin
+    length := AStream.ReadByte;
+    SetLength(Result, length);
+    if length > 0 then
+      AStream.Read(PChar(Result)^, length);
+  end;
+end;
+
+{ TUoaDesign }
+
+constructor TUoaDesign.Create(AHeader: TUoaDesignHeader; AData: TStream);
+var
+  i: Integer;
+  tile: TStaticItem;
+  version: Int32;
+
+  function ReadInt: Int32;
+  begin
+    AData.Read(Result, SizeOf(Result));
+  end;
+
+begin
+  FHeader := AHeader;
+  FTiles := TStaticItemList.Create(True);
+  AData.Seek(FHeader.FilePosition, soFromBeginning);
+  for i := 0 to FHeader.TileCount - 1 do
+  begin
+    AData.Read(version, SizeOf(version));
+    if (version < 0) or (version > 1) then
+      raise Exception.Create('Unsupported binary version');
+
+    tile := TStaticItem.Create(nil);
+    tile.TileID := ReadInt;
+    tile.X := ReadInt;
+    tile.Y := ReadInt;
+    tile.Z := EnsureRange(ReadInt, -128, 127);
+    ReadInt; // Level; unused
+
+    if version = 1 then
+      tile.Hue := ReadInt;
+
+    FTiles.Add(tile);
+  end;
+end;
+
+destructor TUoaDesign.Destroy;
+begin
+  FTiles.Free;
+  inherited Destroy;
+end;
+
+{ TUoaDesignHeaders }
+
+constructor TUoaDesignHeaders.CreateFromStream(AStream: TStream);
+var
+  headerCount, version: Int32;
+  i: Integer;
+begin
+  AStream.Read(headerCount, SizeOf(headerCount));
+  AStream.Read(version, SizeOf(version));
+
+  if version <> 0 then
+    raise Exception.Create('Unknown UOA design index version');
+
+  inherited Create;
+
+  for i := 0 to headerCount-1 do
+    Add(TUoaDesignHeader.CreateFromStream(AStream));
+end;
+
+{ TUoaDesignHeader }
+
+constructor TUoaDesignHeader.CreateFromStream(AStream: TStream);
+begin
+  Name := ReadString(AStream);
+  Category := ReadString(AStream);
+  Subcategory := ReadString(AStream);
+  AStream.Read(Width, SizeOf(Width));
+  AStream.Read(Height, SizeOf(Height));
+  AStream.Read(UserWidth, SizeOf(UserWidth));
+  AStream.Read(UserHeight, SizeOf(UserHeight));
+  AStream.Read(FilePosition, SizeOf(FilePosition));
+  AStream.Read(TileCount, SizeOf(TileCount));
+end;
+
+{ TUoaDesigns }
+
+constructor TUoaDesigns.Create(AIdxFile, ABinFile: String);
+var
+  idxStream: TFileStream;
+begin
+  idxStream := TFileStream.Create(AIdxFile, fmOpenRead);
+  try
+    FHeaders := TUoaDesignHeaders.CreateFromStream(idxStream);
+  finally
+    idxStream.Free;
+  end;
+
+  FData := TFileStream.Create(ABinFile, fmOpenRead);
+end;
+
+destructor TUoaDesigns.Destroy;
+begin
+  Headers.Free;
+end;
+
+function TUoaDesigns.LoadDesign(AHeader: TUoaDesignHeader): TUoaDesign;
+begin
+  Result := TUoaDesign.Create(AHeader, FData);
+end;
+
+end.
+

Client/UdmNetwork.lfm

@@ -2,10 +2,11 @@ object dmNetwork: TdmNetwork
   OnCreate = DataModuleCreate
   OnDestroy = DataModuleDestroy
   OldCreateOrder = False
-  Height = 300
-  HorizontalOffset = 290
-  VerticalOffset = 171
-  Width = 400
+  Height = 375
+  HorizontalOffset = 363
+  VerticalOffset = 214
+  Width = 500
+  PPI = 120
   object TCPClient: TLTCPComponent
     Port = 0
     OnReceive = TCPClientReceive
@@ -14,15 +15,15 @@ object dmNetwork: TdmNetwork
     OnConnect = TCPClientConnect
     Timeout = 0
     ReuseAddress = False
-    left = 40
-    top = 24
+    Left = 50
+    Top = 30
   end
   object tmNoOp: TTimer
     Enabled = False
     Interval = 30000
     OnTimer = tmNoOpTimer
     OnStartTimer = tmNoOpStartTimer
-    left = 112
-    top = 24
+    Left = 140
+    Top = 30
   end
 end

Client/UdmNetwork.pas

@@ -1,371 +1,374 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UdmNetwork;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
-  UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;
-
-type
-
-  { TdmNetwork }
-
-  TdmNetwork = class(TDataModule)
-    TCPClient: TLTCPComponent;
-    tmNoOp: TTimer;
-    procedure DataModuleCreate(Sender: TObject);
-    procedure DataModuleDestroy(Sender: TObject);
-    procedure TCPClientConnect(aSocket: TLSocket);
-    procedure TCPClientDisconnect(aSocket: TLSocket);
-    procedure TCPClientError(const msg: string; aSocket: TLSocket);
-    procedure TCPClientReceive(aSocket: TLSocket);
-    procedure tmNoOpStartTimer(Sender: TObject);
-    procedure tmNoOpTimer(Sender: TObject);
-  protected
-    FSendQueue: TEnhancedMemoryStream;
-    FReceiveQueue: TEnhancedMemoryStream;
-    FUsername: string;
-    FPassword: string;
-    FAccessLevel: TAccessLevel;
-    FDataDir: string;
-    FLastPacket: TDateTime;
-    procedure OnCanSend(ASocket: TLSocket);
-    procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
-    procedure ProcessQueue;
-    procedure DoLogin;
-  public
-    property Username: string read FUsername;
-    property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
-    procedure Send(APacket: TPacket);
-    procedure Disconnect;
-    procedure CheckClose(ASender: TForm);
-  end; 
-
-var
-  dmNetwork: TdmNetwork;
-
-implementation
-
-uses
-  UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
-  UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
-  UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
-  UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
-  UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel;
-  
-{$I version.inc}
-
-{ TdmNetwork }
-
-procedure TdmNetwork.DataModuleCreate(Sender: TObject);
-begin
-  FSendQueue := TEnhancedMemoryStream.Create;
-  FReceiveQueue := TEnhancedMemoryStream.Create;
-  TCPClient.OnCanSend := @OnCanSend;
-  PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
-  DoLogin;
-end;
-
-procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
-begin
-  FreeAndNil(FSendQueue);
-  FreeAndNil(FReceiveQueue);
-  FreeAndNil(PacketHandlers[$02]);
-end;
-
-procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
-begin
-  FSendQueue.Clear;
-  FReceiveQueue.Clear;
-end;
-
-procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
-begin
-  FSendQueue.Clear;
-  FReceiveQueue.Clear;
-  DoLogin;
-end;
-
-procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
-begin
-  MessageDlg('Connection error', msg, mtError, [mbOK], 0);
-  if not TCPClient.Connected then
-    TCPClientDisconnect(aSocket);
-end;
-
-procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
-var
-  buffer: array[0..4095] of byte;
-  size: Integer;
-begin
-  repeat
-    size := TCPClient.Get(buffer, 4096);
-    if size > 0 then
-      FReceiveQueue.Enqueue(buffer, size);
-  until size <= 0;
-  ProcessQueue;
-end;
-
-procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
-begin
-  FLastPacket := Now;
-end;
-
-procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
-begin
-  if SecondsBetween(FLastPacket, Now) > 25 then
-    Send(TNoOpPacket.Create);
-end;
-
-procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
-var
-  size: Integer;
-begin
-  while FSendQueue.Size > 0 do
-  begin
-    FLastPacket := Now;
-    size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
-    if size > 0 then
-      FSendQueue.Dequeue(size)
-    else
-      Break;
-  end;
-end;
-
-procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
-var
-  subID: Byte;
-  loginState: TLoginState;
-  width, height: Word;
-  serverState: TServerState;
-begin
-  subID := ABuffer.ReadByte;
-  case subID of
-    $01:
-      begin
-        if ABuffer.ReadCardinal = ProtocolVersion then
-        begin
-          frmInitialize.lblStatus.Caption := 'Authenticating';
-          Send(TLoginRequestPacket.Create(FUsername, FPassword));
-        end else
-        begin
-          MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
-          Disconnect;
-        end;
-      end;
-    $03:
-      begin
-        loginState := TLoginState(ABuffer.ReadByte);
-        if loginState = lsOK then
-        begin
-          frmInitialize.lblStatus.Caption := 'Initializing';
-          frmInitialize.Repaint;
-          frmInitialize.lblStatus.Repaint;
-          Application.ProcessMessages;
-          FAccessLevel := TAccessLevel(ABuffer.ReadByte);
-          InitGameResourceManager(FDataDir);
-          width := ABuffer.ReadWord;
-          height := ABuffer.ReadWord;
-          ResMan.InitLandscape(width, height);
-          ResMan.Landscape.UpdateWriteMap(ABuffer);
-
-          frmMain := TfrmMain.Create(dmNetwork);
-          frmRadarMap := TfrmRadarMap.Create(frmMain);
-          frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
-          frmRegionControl := TfrmRegionControl.Create(frmMain);
-          frmAccountControl := TfrmAccountControl.Create(frmMain);
-          frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
-          frmConfirmation := TfrmConfirmation.Create(frmMain);
-          frmDrawSettings := TfrmDrawSettings.Create(frmMain);
-          frmMoveSettings := TfrmMoveSettings.Create(frmMain);
-          frmElevateSettings := TfrmElevateSettings.Create(frmMain);
-          frmHueSettings := TfrmHueSettings.Create(frmMain);
-          frmBoundaries := TfrmBoundaries.Create(frmMain);
-          frmFilter := TfrmFilter.Create(frmMain);
-          frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
-          frmLightlevel := TfrmLightlevel.Create(frmMain);
-          frmAbout := TfrmAbout.Create(frmMain);
-          frmMain.Show;
-          frmInitialize.Hide;
-          tmNoOp.Enabled := True;
-        end else
-        begin
-          if loginState = lsInvalidUser then
-            MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
-          else if loginState = lsInvalidPassword then
-            MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
-          else if loginState = lsAlreadyLoggedIn then
-            MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
-          else if loginState = lsNoAccess then
-            MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
-        end;
-      end;
-    $04: //Server state
-      begin
-        serverState := TServerState(ABuffer.ReadByte);
-        if serverState = ssRunning then
-        begin
-          frmInitialize.UnsetModal;
-          frmInitialize.Hide;
-          tmNoOp.Enabled := True;
-        end else
-        begin
-          case serverState of
-            ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
-            ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
-          end;
-          tmNoOp.Enabled := False;
-          frmInitialize.Show;
-          frmInitialize.SetModal;
-        end;
-      end;
-  end;
-end;
-
-procedure TdmNetwork.ProcessQueue;
-var
-  packetHandler: TPacketHandler;
-  size: Cardinal;
-begin
-  FReceiveQueue.Position := 0;
-  while FReceiveQueue.Size >= 1 do
-  begin
-    packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
-    if packetHandler <> nil then
-    begin
-      size := packetHandler.PacketLength;
-      if size = 0 then
-      begin
-        if FReceiveQueue.Size > 5 then
-          size := FReceiveQueue.ReadCardinal
-        else
-          Break; //wait for more data
-      end;
-
-      if FReceiveQueue.Size >= size then
-      begin
-        FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
-        packetHandler.Process(FReceiveQueue);
-        FReceiveQueue.Unlock;
-        FReceiveQueue.Dequeue(size);
-      end else
-        Break; //wait for more data
-    end else
-    begin
-      {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
-      Disconnect;
-      FReceiveQueue.Clear;
-    end;
-  end;
-end;
-
-procedure TdmNetwork.DoLogin;
-begin
-  tmNoOp.Enabled := False;
-  frmLogin := TfrmLogin.Create(dmNetwork);
-  if frmInitialize = nil then
-    frmInitialize := TfrmInitialize.Create(dmNetwork);
-
-  FreeAndNil(frmEditAccount);
-  FreeAndNil(frmAccountControl);
-  FreeAndNil(frmConfirmation);
-  FreeAndNil(frmDrawSettings);
-  FreeAndNil(frmMoveSettings);
-  FreeAndNil(frmElevateSettings);
-  FreeAndNil(frmHueSettings);
-  FreeAndNil(frmBoundaries);
-  FreeAndNil(frmFilter);
-  FreeAndNil(frmVirtualLayer);
-  FreeAndNil(frmAbout);
-  FreeAndNil(frmRegionControl);
-  FreeAndNil(frmLargeScaleCommand);
-  FreeAndNil(frmRadarMap);
-  FreeAndNil(frmLightlevel);
-
-  if frmMain <> nil then
-  begin
-    frmMain.ApplicationProperties1.OnIdle := nil;
-    FreeAndNil(frmMain);
-  end;
-
-  FreeAndNil(GameResourceManager);
-
-  frmInitialize.Hide;
-  while frmLogin.ShowModal = mrOK do
-  begin
-    if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
-    begin
-      FUsername := frmLogin.edUsername.Text;
-      FPassword := frmLogin.edPassword.Text;
-      FDataDir := frmLogin.edData.Text;
-      frmInitialize.lblStatus.Caption := 'Connecting';
-      frmInitialize.Show;
-      Break;
-    end else
-      MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
-  end;
-  frmLogin.Close;
-  FreeAndNil(frmLogin);
-end;
-
-procedure TdmNetwork.Send(APacket: TPacket);
-var
-  source: TEnhancedMemoryStream;
-begin
-  if TCPClient.Connected then
-  begin
-    FSendQueue.Seek(0, soFromEnd);
-    source := APacket.Stream;
-    FSendQueue.CopyFrom(source, 0);
-    OnCanSend(nil);
-  end;
-  APacket.Free;
-end;
-
-procedure TdmNetwork.Disconnect;
-begin
-  Send(TQuitPacket.Create);
-end;
-
-procedure TdmNetwork.CheckClose(ASender: TForm);
-begin
-  if ((frmLogin = nil) or (ASender = frmLogin)) and
-     ((frmMain = nil) or (ASender = frmMain)) and
-     ((frmInitialize = nil) or (not frmInitialize.Visible)) then
-  begin
-    Application.Terminate;
-  end;
-end;
-
-initialization
-  {$I UdmNetwork.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UdmNetwork;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
+  UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;
+
+type
+
+  { TdmNetwork }
+
+  TdmNetwork = class(TDataModule)
+    TCPClient: TLTCPComponent;
+    tmNoOp: TTimer;
+    procedure DataModuleCreate(Sender: TObject);
+    procedure DataModuleDestroy(Sender: TObject);
+    procedure TCPClientConnect(aSocket: TLSocket);
+    procedure TCPClientDisconnect(aSocket: TLSocket);
+    procedure TCPClientError(const msg: string; aSocket: TLSocket);
+    procedure TCPClientReceive(aSocket: TLSocket);
+    procedure tmNoOpStartTimer(Sender: TObject);
+    procedure tmNoOpTimer(Sender: TObject);
+  protected
+    FSendQueue: TEnhancedMemoryStream;
+    FReceiveQueue: TEnhancedMemoryStream;
+    FUsername: string;
+    FPassword: string;
+    FAccessLevel: TAccessLevel;
+    FDataDir: string;
+    FLastPacket: TDateTime;
+    procedure OnCanSend(ASocket: TLSocket);
+    procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
+    procedure ProcessQueue;
+    procedure DoLogin;
+  public
+    property Username: string read FUsername;
+    property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
+    procedure Send(APacket: TPacket);
+    procedure Disconnect;
+    procedure CheckClose(ASender: TForm);
+  end; 
+
+var
+  dmNetwork: TdmNetwork;
+
+implementation
+
+uses
+  UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
+  UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
+  UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
+  UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
+  UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel,
+  UfrmChangePassword;
+  
+{$I version.inc}
+
+{ TdmNetwork }
+
+procedure TdmNetwork.DataModuleCreate(Sender: TObject);
+begin
+  FSendQueue := TEnhancedMemoryStream.Create;
+  FReceiveQueue := TEnhancedMemoryStream.Create;
+  TCPClient.OnCanSend := @OnCanSend;
+  PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
+  DoLogin;
+end;
+
+procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
+begin
+  FreeAndNil(FSendQueue);
+  FreeAndNil(FReceiveQueue);
+  FreeAndNil(PacketHandlers[$02]);
+end;
+
+procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
+begin
+  FSendQueue.Clear;
+  FReceiveQueue.Clear;
+end;
+
+procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
+begin
+  FSendQueue.Clear;
+  FReceiveQueue.Clear;
+  DoLogin;
+end;
+
+procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
+begin
+  MessageDlg('Connection error', msg, mtError, [mbOK], 0);
+  if not TCPClient.Connected then
+    TCPClientDisconnect(aSocket);
+end;
+
+procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
+var
+  buffer: array[0..4095] of byte;
+  size: Integer;
+begin
+  repeat
+    size := TCPClient.Get(buffer, 4096);
+    if size > 0 then
+      FReceiveQueue.Enqueue(buffer, size);
+  until size <= 0;
+  ProcessQueue;
+end;
+
+procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
+begin
+  FLastPacket := Now;
+end;
+
+procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
+begin
+  if SecondsBetween(FLastPacket, Now) > 25 then
+    Send(TNoOpPacket.Create);
+end;
+
+procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
+var
+  size: Integer;
+begin
+  while FSendQueue.Size > 0 do
+  begin
+    FLastPacket := Now;
+    size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
+    if size > 0 then
+      FSendQueue.Dequeue(size)
+    else
+      Break;
+  end;
+end;
+
+procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
+var
+  subID: Byte;
+  loginState: TLoginState;
+  width, height: Word;
+  serverState: TServerState;
+begin
+  subID := ABuffer.ReadByte;
+  case subID of
+    $01:
+      begin
+        if ABuffer.ReadCardinal = ProtocolVersion then
+        begin
+          frmInitialize.lblStatus.Caption := 'Authenticating';
+          Send(TLoginRequestPacket.Create(FUsername, FPassword));
+        end else
+        begin
+          MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
+          Disconnect;
+        end;
+      end;
+    $03:
+      begin
+        loginState := TLoginState(ABuffer.ReadByte);
+        if loginState = lsOK then
+        begin
+          frmInitialize.lblStatus.Caption := 'Initializing';
+          frmInitialize.Repaint;
+          frmInitialize.lblStatus.Repaint;
+          Application.ProcessMessages;
+          FAccessLevel := TAccessLevel(ABuffer.ReadByte);
+          InitGameResourceManager(FDataDir);
+          width := ABuffer.ReadWord;
+          height := ABuffer.ReadWord;
+          ResMan.InitLandscape(width, height);
+          ResMan.Landscape.UpdateWriteMap(ABuffer);
+
+          frmMain := TfrmMain.Create(dmNetwork);
+          frmRadarMap := TfrmRadarMap.Create(frmMain);
+          frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
+          frmRegionControl := TfrmRegionControl.Create(frmMain);
+          frmAccountControl := TfrmAccountControl.Create(frmMain);
+          frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
+          frmConfirmation := TfrmConfirmation.Create(frmMain);
+          frmDrawSettings := TfrmDrawSettings.Create(frmMain);
+          frmMoveSettings := TfrmMoveSettings.Create(frmMain);
+          frmElevateSettings := TfrmElevateSettings.Create(frmMain);
+          frmHueSettings := TfrmHueSettings.Create(frmMain);
+          frmBoundaries := TfrmBoundaries.Create(frmMain);
+          frmFilter := TfrmFilter.Create(frmMain);
+          frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
+          frmLightlevel := TfrmLightlevel.Create(frmMain);
+          frmAbout := TfrmAbout.Create(frmMain);
+          frmChangePassword := TfrmChangePassword.Create(frmMain);
+          frmMain.Show;
+          frmInitialize.Hide;
+          tmNoOp.Enabled := True;
+        end else
+        begin
+          if loginState = lsInvalidUser then
+            MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
+          else if loginState = lsInvalidPassword then
+            MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
+          else if loginState = lsAlreadyLoggedIn then
+            MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
+          else if loginState = lsNoAccess then
+            MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
+        end;
+      end;
+    $04: //Server state
+      begin
+        serverState := TServerState(ABuffer.ReadByte);
+        if serverState = ssRunning then
+        begin
+          frmInitialize.UnsetModal;
+          frmInitialize.Hide;
+          tmNoOp.Enabled := True;
+        end else
+        begin
+          case serverState of
+            ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
+            ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
+          end;
+          tmNoOp.Enabled := False;
+          frmInitialize.Show;
+          frmInitialize.SetModal;
+        end;
+      end;
+  end;
+end;
+
+procedure TdmNetwork.ProcessQueue;
+var
+  packetHandler: TPacketHandler;
+  size: Cardinal;
+begin
+  FReceiveQueue.Position := 0;
+  while FReceiveQueue.Size >= 1 do
+  begin
+    packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
+    if packetHandler <> nil then
+    begin
+      size := packetHandler.PacketLength;
+      if size = 0 then
+      begin
+        if FReceiveQueue.Size > 5 then
+          size := FReceiveQueue.ReadCardinal
+        else
+          Break; //wait for more data
+      end;
+
+      if FReceiveQueue.Size >= size then
+      begin
+        FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
+        packetHandler.Process(FReceiveQueue);
+        FReceiveQueue.Unlock;
+        FReceiveQueue.Dequeue(size);
+      end else
+        Break; //wait for more data
+    end else
+    begin
+      {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
+      Disconnect;
+      FReceiveQueue.Clear;
+    end;
+  end;
+end;
+
+procedure TdmNetwork.DoLogin;
+begin
+  tmNoOp.Enabled := False;
+  frmLogin := TfrmLogin.Create(dmNetwork);
+  if frmInitialize = nil then
+    frmInitialize := TfrmInitialize.Create(dmNetwork);
+
+  FreeAndNil(frmEditAccount);
+  FreeAndNil(frmAccountControl);
+  FreeAndNil(frmConfirmation);
+  FreeAndNil(frmDrawSettings);
+  FreeAndNil(frmMoveSettings);
+  FreeAndNil(frmElevateSettings);
+  FreeAndNil(frmHueSettings);
+  FreeAndNil(frmBoundaries);
+  FreeAndNil(frmFilter);
+  FreeAndNil(frmVirtualLayer);
+  FreeAndNil(frmAbout);
+  FreeAndNil(frmRegionControl);
+  FreeAndNil(frmLargeScaleCommand);
+  FreeAndNil(frmRadarMap);
+  FreeAndNil(frmLightlevel);
+  FreeAndNil(frmChangePassword);
+
+  if frmMain <> nil then
+  begin
+    frmMain.ApplicationProperties1.OnIdle := nil;
+    FreeAndNil(frmMain);
+  end;
+
+  FreeAndNil(GameResourceManager);
+
+  frmInitialize.Hide;
+  while frmLogin.ShowModal = mrOK do
+  begin
+    if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
+    begin
+      FUsername := frmLogin.edUsername.Text;
+      FPassword := frmLogin.edPassword.Text;
+      FDataDir := frmLogin.edData.Text;
+      frmInitialize.lblStatus.Caption := 'Connecting';
+      frmInitialize.Show;
+      Break;
+    end else
+      MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
+  end;
+  frmLogin.Close;
+  FreeAndNil(frmLogin);
+end;
+
+procedure TdmNetwork.Send(APacket: TPacket);
+var
+  source: TEnhancedMemoryStream;
+begin
+  if TCPClient.Connected then
+  begin
+    FSendQueue.Seek(0, soFromEnd);
+    source := APacket.Stream;
+    FSendQueue.CopyFrom(source, 0);
+    OnCanSend(nil);
+  end;
+  APacket.Free;
+end;
+
+procedure TdmNetwork.Disconnect;
+begin
+  Send(TQuitPacket.Create);
+end;
+
+procedure TdmNetwork.CheckClose(ASender: TForm);
+begin
+  if ((frmLogin = nil) or (ASender = frmLogin)) and
+     ((frmMain = nil) or (ASender = frmMain)) and
+     ((frmInitialize = nil) or (not frmInitialize.Visible)) then
+  begin
+    Application.Terminate;
+  end;
+end;
+
+initialization
+  {$I UdmNetwork.lrs}
+
+end.
+

Client/UfrmAbout.lfm

@@ -1,143 +1,151 @@
 object frmAbout: TfrmAbout
   Left = 290
-  Height = 308
+  Height = 579
   Top = 171
-  Width = 354
+  Width = 388
   AutoSize = True
   BorderIcons = [biSystemMenu]
   BorderStyle = bsDialog
   Caption = 'About CentrED'
-  ClientHeight = 308
-  ClientWidth = 354
-  Font.Height = -11
+  ClientHeight = 579
+  ClientWidth = 388
+  DesignTimePPI = 120
+  Font.Height = -18
   OnCreate = FormCreate
   Position = poScreenCenter
-  LCLVersion = '0.9.29'
   object Label3: TLabel
-    Left = 8
-    Height = 53
-    Top = 189
-    Width = 338
+    Left = 12
+    Height = 182
+    Top = 334
+    Width = 364
     Align = alTop
-    BorderSpacing.Top = 16
-    BorderSpacing.Around = 8
-    Caption = 'Ultima(tm) Online (c)  1997 Electronic Arts Inc. Ultima, the UO logo, Are You With Us?, ORIGIN, the ORIGIN logo and We create worlds are trademarks or registered trademarks of Electronic Arts Inc. in the U.S. and/or other countries. All rights reserved.'
+    BorderSpacing.Top = 25
+    BorderSpacing.Around = 12
+    Caption = 'Ultima™ Online © 1997 Electronic Arts Inc. Ultima, the UO logo, Are You With Us?, ORIGIN, the ORIGIN logo and We create worlds are trademarks or registered trademarks of Electronic Arts Inc. in the U.S. and/or other countries. All rights reserved.'
+    Color = clDefault
     ParentColor = False
     WordWrap = True
   end
   object Label5: TLabel
-    Left = 8
-    Height = 14
-    Top = 98
-    Width = 338
+    Left = 12
+    Height = 26
+    Top = 167
+    Width = 364
     Align = alTop
-    BorderSpacing.Left = 8
-    BorderSpacing.Right = 8
+    BorderSpacing.Left = 12
+    BorderSpacing.Right = 12
     Caption = 'It is using the following great components:'
+    Color = clDefault
     ParentColor = False
   end
   object Label6: TLabel
-    Left = 16
-    Height = 53
-    Top = 112
-    Width = 330
+    Left = 25
+    Height = 104
+    Top = 193
+    Width = 351
     Align = alTop
-    BorderSpacing.Left = 16
-    BorderSpacing.Right = 8
+    BorderSpacing.Left = 25
+    BorderSpacing.Right = 12
     Caption = '- Vampyre Imaging Lib by Marek Mauder'#13#10'- lNet by Ales Katona and Micha Nelissen'#13#10'- VirtualTrees by Mike Lischke'#13#10'- Silk Icons by Mark James'
+    Color = clDefault
     ParentColor = False
   end
   object Label7: TLabel
-    Left = 8
-    Height = 14
-    Top = 84
-    Width = 338
+    Left = 12
+    Height = 52
+    Top = 115
+    Width = 364
     Align = alTop
-    BorderSpacing.Left = 8
-    BorderSpacing.Right = 8
+    BorderSpacing.Left = 12
+    BorderSpacing.Right = 12
     Caption = 'CentrED has been developed using Lazarus and FreePascal.'
+    Color = clDefault
     ParentColor = False
     WordWrap = True
   end
   object Panel2: TPanel
     Left = 0
-    Height = 76
+    Height = 103
     Top = 0
-    Width = 354
+    Width = 388
     Align = alTop
     AutoSize = True
-    BorderSpacing.Bottom = 8
+    BorderSpacing.Bottom = 12
     BevelOuter = bvNone
-    ClientHeight = 76
-    ClientWidth = 354
+    ClientHeight = 103
+    ClientWidth = 388
     TabOrder = 0
     object Panel1: TPanel
       Left = 0
-      Height = 76
+      Height = 103
       Top = 0
-      Width = 167
+      Width = 307
       AutoSize = True
       BevelInner = bvRaised
       BevelOuter = bvLowered
-      ClientHeight = 76
-      ClientWidth = 167
+      ClientHeight = 103
+      ClientWidth = 307
       TabOrder = 0
       object Label1: TLabel
         Left = 2
-        Height = 38
+        Height = 60
         Top = 2
-        Width = 163
+        Width = 303
         Align = alTop
         Alignment = taCenter
         AutoSize = False
         Caption = 'UO CentrED'
-        Font.Height = -29
+        Color = clDefault
+        Font.Height = -45
         Font.Style = [fsBold]
         Layout = tlCenter
         ParentColor = False
         ParentFont = False
       end
       object lblVersion: TLabel
-        Left = 6
-        Height = 14
-        Top = 40
-        Width = 155
+        Left = 8
+        Height = 1
+        Top = 62
+        Width = 291
         Align = alTop
         Alignment = taRightJustify
-        BorderSpacing.Left = 4
-        BorderSpacing.Right = 4
+        BorderSpacing.Left = 6
+        BorderSpacing.Right = 6
+        Color = clDefault
         ParentColor = False
       end
       object lblCopyright: TLabel
-        Left = 6
-        Height = 14
-        Top = 58
-        Width = 155
+        Left = 8
+        Height = 26
+        Top = 69
+        Width = 291
         Align = alTop
         Alignment = taCenter
-        BorderSpacing.Around = 4
+        BorderSpacing.Around = 6
+        Caption = 'Copyright 2022 Andreas Schneider'
+        Color = clDefault
         ParentColor = False
       end
     end
   end
   object Panel3: TPanel
-    Left = 8
-    Height = 25
-    Top = 250
-    Width = 338
+    Left = 12
+    Height = 39
+    Top = 528
+    Width = 364
     Align = alTop
-    BorderSpacing.Around = 8
+    BorderSpacing.Around = 12
     BevelOuter = bvNone
-    ClientHeight = 25
-    ClientWidth = 338
+    ClientHeight = 39
+    ClientWidth = 364
     TabOrder = 1
     object btnClose: TButton
-      Left = 263
-      Height = 25
+      Left = 246
+      Height = 39
       Top = 0
-      Width = 75
+      Width = 118
       Align = alRight
-      BorderSpacing.InnerBorder = 4
+      BorderSpacing.InnerBorder = 6
       Caption = 'Close'
       OnClick = btnCloseClick
       TabOrder = 0

Client/UfrmAbout.pas

@@ -21,7 +21,7 @@
  * CDDL HEADER END
  *
  *
- *      Portions Copyright 2007 Andreas Schneider
+ *      Portions Copyright 2012 Andreas Schneider
  *)
 unit UfrmAbout;
 
@@ -62,7 +62,8 @@ var
 
 implementation
 
-{$I version.inc}
+uses
+  vinfo;
 
 { TfrmAbout }
 
@@ -73,8 +74,8 @@ end;
 
 procedure TfrmAbout.FormCreate(Sender: TObject);
 begin
-  lblVersion.Caption := Format('Version %s', [ProductVersion]);
-  lblCopyright.Caption := Format('Copyright %s', [Copyright]);
+  lblVersion.Caption := Format('Version %s', [VersionInfo.GetProductVersionString]);
+  lblCopyright.Caption := VersionInfo.GetCopyright(True);
 end;
 
 initialization

Client/UfrmAccountControl.lfm

@@ -1,381 +1,272 @@
-object frmAccountControl: TfrmAccountControl
-  Left = 290
-  Height = 378
-  Top = 171
-  Width = 369
-  ActiveControl = vstAccounts
-  BorderIcons = [biSystemMenu]
-  BorderStyle = bsDialog
-  Caption = 'Account Management'
-  ClientHeight = 378
-  ClientWidth = 369
-  Font.Height = -11
-  OnClose = FormClose
-  OnCreate = FormCreate
-  OnDestroy = FormDestroy
-  OnShow = FormShow
-  Position = poOwnerFormCenter
-  LCLVersion = '0.9.29'
-  object tbMain: TToolBar
-    Left = 0
-    Height = 26
-    Top = 0
-    Width = 369
-    Caption = 'tbMain'
-    Images = ilToolbar
-    TabOrder = 0
-    object tbRefresh: TToolButton
-      Left = 1
-      Hint = 'Refresh'
-      Top = 2
-      Caption = 'Refresh'
-      ImageIndex = 0
-      ParentShowHint = False
-      ShowHint = True
-      OnClick = tbRefreshClick
-    end
-    object tbAddUser: TToolButton
-      Left = 32
-      Hint = 'Add User'
-      Top = 2
-      Caption = 'Add User'
-      ImageIndex = 1
-      ParentShowHint = False
-      ShowHint = True
-      OnClick = tbAddUserClick
-    end
-    object tbEditUser: TToolButton
-      Left = 55
-      Hint = 'Edit User'
-      Top = 2
-      Caption = 'Edit User'
-      ImageIndex = 2
-      ParentShowHint = False
-      ShowHint = True
-      OnClick = tbEditUserClick
-    end
-    object tbDeleteUser: TToolButton
-      Left = 78
-      Hint = 'Delete User'
-      Top = 2
-      Caption = 'Delete User'
-      ImageIndex = 3
-      ParentShowHint = False
-      ShowHint = True
-      OnClick = tbDeleteUserClick
-    end
-    object tbSeparator1: TToolButton
-      Left = 24
-      Top = 2
-      Width = 8
-      Caption = 'tbSeparator1'
-      Style = tbsDivider
-    end
-  end
-  object vstAccounts: TVirtualStringTree
-    Left = 0
-    Height = 352
-    Top = 26
-    Width = 369
-    Align = alClient
-    DefaultText = 'Node'
-    Header.AutoSizeIndex = 1
-    Header.Columns = <    
-      item
-        Position = 0
-        Width = 30
-      end    
-      item
-        Position = 1
-        Text = 'Username'
-        Width = 200
-      end    
-      item
-        Position = 2
-        Text = 'Accesslevel'
-        Width = 100
-      end>
-    Header.DefaultHeight = 17
-    Header.Options = [hoColumnResize, hoDrag, hoVisible]
-    Header.ParentFont = True
-    Header.Style = hsFlatButtons
-    Images = ilAccesslevel
-    TabOrder = 1
-    TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
-    TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
-    TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
-    TreeOptions.SelectionOptions = [toFullRowSelect]
-    OnDblClick = vstAccountsDblClick
-    OnFreeNode = vstAccountsFreeNode
-    OnGetText = vstAccountsGetText
-    OnGetImageIndex = vstAccountsGetImageIndex
-  end
-  object ilToolbar: TImageList
-    left = 144
-    Bitmap = {
-      4C69040000001000000010000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      00000000000000000000000000000000000047994FFF419149FF000000000000
-      0000000000000000000000000000000000000000000000000000000000005BB4
-      65FF56AD5FFF50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3AFF0000
-      000000000000000000000000000000000000000000005EB968FF79C383FF89CA
-      92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D
-      2CFF000000000000000000000000000000005CB667FF85C98EFF9BD4A4FF8FCE
-      98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265
-      25FF0000000000000000000000000000000075BF7EFF98D2A1FF94CF9CFF86C7
-      8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF206324FF0000
-      000000000000000000000000000054AB5EFF80C389FF8DCC95FF83C48AFF3D8B
-      44FF37833EFF000000000000000000000000236627FF1F6123FF000000000000
-      00000000000000000000000000004DA155FF47994FFF419149FF3B8842FF3580
-      3CFF000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      00000000000000000000000000000000000000000000000000004DA155FF4799
-      4FFF419149FF3B8842FF35803CFF000000000000000000000000000000000000
-      000063C06EFF5FBB6AFF0000000000000000000000004B9E53FF45964DFF86C6
-      8EFF88C98FFF6FB376FF2E7633FF0000000000000000000000000000000062BE
-      6DFF7BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9
-      8FFF82C689FF509756FF0000000000000000000000000000000060BC6CFF79C4
-      83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4
-      85FF5DA463FF266B2AFF000000000000000000000000000000005BB465FF73BD
-      7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92
-      51FF246829FF0000000000000000000000000000000000000000000000004EA3
-      57FF66B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432FF276D2CFF0000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000419149FF3B8842FF00000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000
-      0000000000000000000000000000000000000000000000000000000000000F4B
-      97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000
-      0000000000000000000000000000000000000000000000000000000000000C3E
-      87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000
-      0000000000000000000000000000000000000000000000000000000000001F5E
-      9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000
-      0000000000000000000000000000000000000000000000000000000000002A5B
-      92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000
-      0000000000000000000000000000000000000000000000000000000000006A3C
-      25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000
-      000000000000000000000000000000000000000000000000000000000000BC48
-      1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000
-      0000000000000000000000000000000000000000000000000000C44C1FFFF6E4
-      D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFFAEAB78FF609772FF4F8E
-      66FF428357FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1
-      98FFFEC76DFFFEBF68FFFEB964FFFEB15EFFA79B61FF61AB81FF95D4B4FFBAE6
-      D0FF6ABB8FFF2D8F57FF196B37FF00000000287CCEFF78B3EAFFB39E94FFFFB7
-      60FFFFB663FFFEB261FFFEAC5DFFFEA559FF4A885DFF90D3B1FF92D6B1FFFFFF
-      FFFF65BC8CFF67BC8FFF196B37FF00000000297DD1FF82BAEEFF9F6658FFF5BB
-      84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF317B4CFF9CD4B6FFFFFFFFFFFFFF
-      FFFFFFFFFFFF95D2B2FF196B37FF00000000000000002579CDFF866161FFBF60
-      35FFFEB961FFFEB962FFFEB962FFFEB962FF226E3AFF62BA8BFF60BA87FFFFFF
-      FFFF60B987FF67BC8FFF196B37FF00000000000000000000000000000000B350
-      20FFA0401FFFAA4522FFAC4622FFAB4422FF5C572DFF288C53FF64BA8DFF95D2
-      B2FF64BA8DFF288C53FF196B37FF000000000000000000000000000000000000
-      00000000000000000000000000000000000000000000196B37FF196B37FF196B
-      37FF196B37FF196B37FF00000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      000012488DFF104B90FF0F488AFF11427DFF15335BFF00000000000000000000
-      000000000000000000000000000000000000000000000000000000000000114E
-      96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF000000000000
-      00000000000000000000000000000000000000000000000000000F4B97FF1258
-      9FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF000000000000
-      00000000000000000000000000000000000000000000000000000C3E87FF7C97
-      B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF000000000000
-      00000000000000000000000000000000000000000000000000001F5E9BFFD9E8
-      F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000000058A5
-      D8FF85B1DBFF469DD0FF000000000000000000000000000000002A5B92FFA6CA
-      EEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2884B7FF77BEE7FFB4D2
-      F0FFE5F3FFFFACD2EFFF488CC7FF0000000000000000000000006A3C25FF346D
-      A7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF2E8ABFFF7ED3EBFFB2E3F9FF8BC0
-      E7FFAED3F6FFC4E0FCFF669FD3FF000000000000000000000000BC481CFFF4E2
-      D4FF4E7BA9FF4D7BA8FF4D7BA8FF428CBAFF7DD4EEFFC4F6FDFF6CDDF6FF6DCA
-      EDFF63A3D7FF5D9BD2FF000000000000000000000000C44C1FFFF6E4D6FFFFE4
-      A4FFFFD472FFFFC969FFBFBB86FF79D3EEFFC7F7FDFF5FDCF5FF5BE2F7FF7AD6
-      F2FF4099DFFF0000000000000000000000008A5444FFFCC8ABFFFFD198FFFEC7
-      6DFFFEBF68FFB0A780FF77CBE7FFC7F7FDFF5EDCF5FF5AE1F7FF7BD4F1FF4691
-      D4FF686672FF0000000000000000287CCEFF78B3EAFFB39E94FFFFB760FFFFB6
-      63FFB3A37DFF76B8D3FFC2F6FDFF63DFF7FF5DE2F8FF79D3F0FF4795D8FF75B2
-      EAFF2974C7FF0000000000000000297DD1FF82BAEEFF9F6658FFF5BB84FFA792
-      74FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0EDFF5196D2FF96645DFF83BC
-      EFFF2A77CAFF0000000000000000000000002579CDFF866161FFBF6035FF4389
-      AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF4988B7FF9C5442FF7A646DFF2E7E
-      CEFF6DA2D3FF0000000000000000000000000000000000000000B35020FF2D64
-      81FF94C7F9FF91C9F9FF4185C9FF2362A4FF89493DFFB24F24FF000000000000
-      000000000000000000000000000000000000000000000000000000000000113D
-      55FF285F87FF4988BDFF428DBCFF000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000
-      0000000000000000000000000000000000000000000000000000000000000F4B
-      97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000
-      0000000000000000000000000000000000000000000000000000000000000C3E
-      87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000
-      0000000000000000000000000000000000000000000000000000000000001F5E
-      9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000
-      0000000000000000000000000000000000000000000000000000000000002A5B
-      92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000
-      0000000000000000000000000000000000000000000000000000000000006A3C
-      25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000
-      000000000000000000000000000000000000000000000000000000000000BC48
-      1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000
-      0000000000000000000000000000000000000000000000000000C44C1FFFF6E4
-      D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFF9590A0FF295DC1FF0542
-      BBFF0B45B0FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1
-      98FFFEC76DFFFEBF68FFFEB964FFFEB15EFF95828BFF3D74CEFF8DB5F7FFB8D6
-      FEFF72A8F5FF2D6BCAFF0000000000000000287CCEFF78B3EAFFB39E94FFFFB7
-      60FFFFB663FFFEB261FFFEAC5DFFFEA559FF2450ABFF8DB5F6FF4D92FFFF1177
-      FFFF2186FFFF408AEBFF0344B9FF00000000297DD1FF82BAEEFF9F6658FFF5BB
-      84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF0542BCFFAECDFEFFFFFFFFFFFFFF
-      FFFFFFFFFFFF187FEFFF0442BCFF00000000000000002579CDFF866161FFBF60
-      35FFFEB961FFFEB962FFFEB962FFFEB962FF1F52AFFF639DF4FF187FFFFF0076
-      F8FF0076EEFF0368E1FF0345B9FF00000000000000000000000000000000B350
-      20FFA0401FFFAA4522FFAC4622FFAB4422FF5F4C74FF2763C6FF2177E6FF0579
-      EAFF0164DDFF044DBDFF00000000000000000000000000000000000000000000
-      00000000000000000000000000000000000000000000000000000345B9FF0442
-      BCFF0345B9FF0000000000000000
-    }
-  end
-  object ilAccesslevel: TImageList
-    left = 176
-    Bitmap = {
-      4C69040000001000000010000000000000000000000000000000000000000000
-      0000A3A3A3FFA0A0A0FF9D9D9DFF9A9A9AFF979797FF949494FF000000000000
-      000000000000000000000000000000000000000000000000000000000000A2A2
-      A2FFBCBCBCFFCACACAFFCCCCCCFFCACACAFFC2C2C2FFADADADFF8C8C8CFF0000
-      0000000000000000000000000000000000000000000000000000A1A1A1FFC4C4
-      C4FFBEBEBEFFA1A1A1FF969696FF939393FF979797FFAEAEAEFFAEAEAEFF8484
-      84FF000000000000000000000000000000000000000000000000BABABAFFBFBF
-      BFFF989898FF00000000000000000000000000000000878787FFA8A8A8FF9E9E
-      9EFF00000000000000000000000000000000000000009D9D9DFFC4C4C4FFA1A1
-      A1FF000000000000000000000000000000000000000000000000898989FFA9A9
-      A9FF797979FF00000000000000000000000000000000999999FFC6C6C6FF9494
-      94FF0000000000000000000000000000000000000000000000007D7D7DFFABAB
-      ABFF767676FF00000000000000000000000061C3E1FF88A0A8FF919191FF8E8E
-      8EFF5AB9DCFF55B8DFFF51B5DEFF4DB1DDFF49ADDCFF46A8D7FF787878FF7676
-      76FF657E8DFF3199D8FF000000000000000060C2E1FFC9F3FCFFCBF3FDFFD4F6
-      FEFFD7F6FFFFD8F4FFFFE0F8FFFFDFF8FFFFDAF5FFFFCDF1FCFFC2EDFAFFBDEB
-      FAFFBDEBFAFF2B93D6FF00000000000000005CBFE0FFC8F3FCFF75DFF9FF89E6
-      FDFF95E7FFFF9AE5FFFFAAEEFFFFA8EDFFFF99E3FFFF74D5F9FF59CCF3FF4FC8
-      F1FFBBE9FAFF248DD5FF000000000000000058BBDFFFC7F1FCFF6FDCF9FF56BB
-      EDFF61BDEFFF9BE7FFFF35A6E2FF4BA4E1FF90E2FFFF49ADE9FF38A4E3FF49C4
-      F0FFB8E8F9FF1E88D4FF000000000000000053B7DEFFC6F0FCFF6AD9F8FF7CE2
-      FDFF90E8FFFF99E9FFFF329FDFFF548BB2FF8AE2FFFF6AD0F9FF50C5F1FF46C1
-      F0FFB6E7F9FF1883D3FF00000000000000004EB2DDFFC3EFFBFF65D6F8FF4CB6
-      ECFF5ABDEFFF95EBFFFF3097DDFF4D82ABFF84E1FFFF41A9E9FF329FE1FF42BE
-      EFFFB4E5F9FF137ED2FF000000000000000049ADDCFFC1EEFBFF5FD3F7FF6CDB
-      FCFF7FE5FFFF8FEDFFFF97F2FFFF93EDFFFF7CDFFFFF5BCCF8FF46BEEFFF3CBA
-      EEFFB3E3F9FF0E79D1FF000000000000000043A8DBFFBFECFBFF59CFF5FF41B0
-      ECFF4EBAEFFF5AC2EFFF60C6EFFF5CC4EFFF4CB6EFFF37A5E6FF2A9AE1FF38B8
-      EEFFB1E3F8FF0975D0FF00000000000000003DA3DAFFBCEBFAFFBCEBFCFFBFEE
-      FEFFC6F4FFFFCEF8FFFFD3FAFFFFD0F8FFFFC7F2FFFFBAE9FCFFB3E4F9FFB0E2
-      F8FFB0E2F8FF0571CFFF0000000000000000369DD9FF3199D8FF2C94D7FF2890
-      D6FF238CD5FF1E88D4FF1A84D3FF1580D2FF117CD1FF0E79D1FF0A76D0FF0773
-      CFFF0470CFFF016ECEFF00000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
-      0000000000000000000000000000000000000000000000000000000000005F63
-      69FF284D7DFF2D6196FF0F4988FF2C6093FF0C3E73FF1B3D60FF595E63FF0000
-      0000000000000000000000000000000000000000000000000000000000003752
-      79FF255A93FF0C3E76FF245485FF0E3E73FF265584FF163E69FF143050FF0000
-      0000000000000000000000000000000000000000000000000000000000001136
-      67FF2A4B71FF4C759EFF3B638EFF11355BFF28527BFF1C3959FF103255FF0000
-      0000000000000000000000000000000000000000000000000000000000001848
-      78FF9BB7D1FFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFF96B3CEFF1A4C7EFF0000
-      000000000000000000000000000000000000000000000000000000000000305D
-      8FFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2E629AFF0000
-      0000000000000000000000000000000000000000000000000000000000003D3D
-      3DFF416F9EFF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF4176A6FF373737FF0000
-      0000000000000000000000000000000000000000000000000000494949FF4B4B
-      4BFF989898FF5C5C5CFF557CA3FF557CA3FF4C4C4CFF989898FF4E4E4EFF4C4C
-      4CFF0000000000000000000000000000000000000000777777FF4C4C4CFF4E4E
-      4EFF979797FF595959FFABABABFFA5A5A5FF545454FF868686FF626262FF4A4A
-      4AFF0000000000000000000000000000000000000000636363FFA4A4A4FF5050
-      50FF525252FF5B5B5BFFB8B8B8FFC1C1C1FF575757FF4D4D4DFF5A5A5AFF7E7E
-      7EFF606060FF000000000000000000000000287CCEFF78B3EAFF7A7A7AFF8383
-      83FF7E7E7EFF5D5D5DFF494949FF4C4C4CFF555555FF646464FF5F5F5FFF6D6D
-      6DFF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF5F5F5FFF8F8F
-      8FFF7A7A7AFF777777FF6D6D6DFF4E4E4EFF727272FF6F6F6FFF848484FF5555
-      55FF83BCEFFF2A77CAFF0000000000000000000000002579CDFF5E5E5EFF4F4F
-      4FFF848484FF848484FF808080FF545454FF838383FF848484FF4A4A4AFF4545
-      45FF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000003D3D
-      3DFF4D4D4DFF494949FF474747FF474747FF454545FF474747FF383838FF0000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      000027B2E5FF1BA7F3FF1CACF4FF1CA8F4FF1BA1F1FF27ACDEFF000000000000
-      00000000000000000000000000000000000000000000000000000000000028B5
-      E5FF1BB6F5FF1CB6F5FF1CB6F5FF1CB2F5FF1CABF4FF1DAAF0FF28B0E0FF0000
-      0000000000000000000000000000000000000000000000000000000000001DBA
-      F5FF1CB6F5FF1CAAF4FF1CACF4FF1CACF4FF1CACF3FF1CA1F0FF1C93E4FF0000
-      0000000000000000000000000000000000000000000000000000000000001B9E
-      F3FF62ABCEFF8AB7E4FF3EC6EBFF1C9FEDFF1DA4EEFF1EA5EBFF1C9AE9FF0000
-      0000000000000000000000000000000000000000000000000000000000001E6D
-      ADFFBDD7EFFFA3C9EDFF9DC5E8FF44CEEFFF5BCDEFFFA8DCF1FF207CBDFF0000
-      0000000000000000000000000000000000000000000000000000000000002C61
-      8EFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D6299FF0000
-      0000000000000000000000000000000000000000000000000000000000004C72
-      49FF347499FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF357AA1FF4A6A46FF0000
-      000000000000000000000000000000000000000000000000000079935DFF2785
-      4EFFB3F5C8FF49898FFF4B7FA0FF4B7FA0FF49898FFFA9E8BAFF26844DFF738C
-      59FF0000000000000000000000000000000000000000AFE0ACFF37945DFF9FFD
-      C6FF91EFB8FF78D69FFF6FCD96FF69C68FFF62BF88FF73CF98FF94F0B9FF3088
-      51FF788754FF000000000000000000000000849D6CFF45A26BFF82E0A9FF82E0
-      A9FF6FCD96FF69C790FF64C28BFF5EBC85FF57B57EFF50AE77FF6BC891FF67C0
-      8AFF4F9A66FF769264FF0000000000000000287CCEFF78B3EAFF5AB881FF62C0
-      89FF62C089FF5FBD86FF5AB881FF55B37CFF4FAD76FF49A770FF419E67FF4DAB
-      74FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF409E67FF6ECC
-      95FF5BB881FF58B57EFF53B17AFF4FAC75FF54B17AFF51AD76FF67C18AFF3B92
-      5CFF83BCEFFF2A77CAFF0000000000000000000000002579CDFF429D67FF318F
-      58FF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF2D8A53FF2F88
-      53FF2E7ECEFF6DA2D3FF0000000000000000000000000000000000000000668C
-      57FF428B55FF338952FF2E8851FF2D8750FF2E854EFF39854EFF4F824EFF0000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
-      0000000000000000000000000000000000000000000000000000000000005F63
-      69FF284D7DFF0F498AFF0F4988FF0E4581FF0C3E73FF1B3D60FF595E63FF0000
-      0000000000000000000000000000000000000000000000000000000000003752
-      79FF0F498FFF0C3E76FF0C3E73FF0E3E73FF113F70FF0F3661FF143050FF0000
-      0000000000000000000000000000000000000000000000000000000000001037
-      73FF7893B5FF8AB7E4FF6793C3FF11355BFF15395FFF1C3959FF103255FF0000
-      0000000000000000000000000000000000000000000000000000000000001F5C
-      99FFBDD7EFFFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFFB7D3EBFF2365A4FF0000
-      000000000000000000000000000000000000000000000000000000000000395F
-      89FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2F6299FF0000
-      000000000000000000000000000000000000000000000000000000000000966B
-      3EFF537291FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF51799AFF8C643CFF0000
-      0000000000000000000000000000000000000000000000000000A57645FFB17D
-      3FFFD8BEA0FF968271FF5572A4FF435EB5FFA2795FFFD9BEA0FFB48042FFA875
-      46FF0000000000000000000000000000000000000000C29A70FFB27D41FFB480
-      42FFDCBF9EFFBE8A4CFFC4B6BCFF5E67C8FFB3814DFFD3B088FFC29159FFAF7A
-      3EFF9F6F41FF000000000000000000000000A5774AFFC3925BFFE2CAB0FFB682
-      44FFB78345FFB88855FF4A5BD0FF5060D2FFBA874CFFB37F41FFBF8A4EFFD0A9
-      7DFFBE8D57FF9C6F46FF0000000000000000287CCEFF78B3EAFFCEA679FFD2AE
-      83FFD0A97DFFB78859FF4D4EA6FF77627CFFB6844BFFC4935CFFC18E55FFC79A
-      67FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFFC18F55FFD8B9
-      94FFCEA678FFCCA375FFBA9370FFB27F44FFCA9F6EFFC89C69FFD3AE85FFB884
-      49FF83BCEFFF2A77CAFF0000000000000000000000002579CDFFC08E54FFB581
-      43FFD3AF85FFD3AF85FFD1AB7FFFB98547FFD2AE83FFD3AF85FFB07B3FFFA976
-      3CFF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000009966
-      34FFAF7A41FFAE793DFFAD783CFFAD783CFFAA7539FFAA753CFF936131FF0000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000
-    }
-  end
-end
+object frmAccountControl: TfrmAccountControl
+  Left = 290
+  Height = 472
+  Top = 171
+  Width = 542
+  ActiveControl = vstAccounts
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsDialog
+  Caption = 'Account Management'
+  ClientHeight = 472
+  ClientWidth = 542
+  Font.Height = -14
+  OnClose = FormClose
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  Position = poOwnerFormCenter
+  object tbMain: TToolBar
+    Left = 0
+    Top = 0
+    Width = 542
+    Caption = 'tbMain'
+    Images = ilToolbar
+    TabOrder = 0
+    object tbRefresh: TToolButton
+      Left = 1
+      Hint = 'Refresh'
+      Top = 2
+      Caption = 'Refresh'
+      ImageIndex = 0
+      OnClick = tbRefreshClick
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object tbAddUser: TToolButton
+      Left = 35
+      Hint = 'Add User'
+      Top = 2
+      Caption = 'Add User'
+      ImageIndex = 1
+      OnClick = tbAddUserClick
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object tbEditUser: TToolButton
+      Left = 64
+      Hint = 'Edit User'
+      Top = 2
+      Caption = 'Edit User'
+      ImageIndex = 2
+      OnClick = tbEditUserClick
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object tbDeleteUser: TToolButton
+      Left = 93
+      Hint = 'Delete User'
+      Top = 2
+      Caption = 'Delete User'
+      ImageIndex = 3
+      OnClick = tbDeleteUserClick
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object tbSeparator1: TToolButton
+      Left = 30
+      Height = 28
+      Top = 2
+      Caption = 'tbSeparator1'
+      Style = tbsDivider
+    end
+  end
+  object vstAccounts: TLazVirtualStringTree
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = tbMain
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 0
+    Height = 440
+    Top = 32
+    Width = 542
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    DefaultText = 'Node'
+    Header.AutoSizeIndex = 1
+    Header.Columns = <    
+      item
+        Position = 0
+        Width = 38
+      end    
+      item
+        Position = 1
+        Text = 'Username'
+        Width = 250
+      end    
+      item
+        Position = 2
+        Text = 'Accesslevel'
+        Width = 125
+      end    
+      item
+        Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coFixed, coAllowFocus]
+        Position = 3
+        Text = 'Restricted'
+        Width = 94
+      end>
+    Header.DefaultHeight = 21
+    Header.Height = 21
+    Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
+    Header.ParentFont = True
+    Header.Style = hsFlatButtons
+    HintMode = hmHint
+    Images = ilAccesslevel
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 1
+    TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
+    TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
+    TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
+    TreeOptions.SelectionOptions = [toFullRowSelect]
+    OnCompareNodes = vstAccountsCompareNodes
+    OnDblClick = vstAccountsDblClick
+    OnFreeNode = vstAccountsFreeNode
+    OnGetText = vstAccountsGetText
+    OnGetImageIndex = vstAccountsGetImageIndex
+    OnGetHint = vstAccountsGetHint
+    OnHeaderClick = vstAccountsHeaderClick
+  end
+  object ilToolbar: TImageList
+    Left = 180
+    Bitmap = {
+      4C7A0400000010000000100000004E0500000000000078DAED95794C94671087
+      6DD4BFDA946263521B1314B1822926F588A957700B2A725A51ACC8B9805B111B
+      2982802087B0B0DC9453103CD045411450904350411014E5D8A24D6B50EBD168
+      C413D044F7E9B79B4841D05DFFB069132799ECB7D9F799996FE6FDED8C1AF5FE
+      6D69960D8B93CDD1E6ACC3310F561F76C6F6C05A2C725762966E854B810487BD
+      6ECC0E99F7C6184E951202EA2388694921B52D87B4F65C922E6511773E156973
+      22A10D52ACD3EC98E6FDF5B018EBCAD713D99C40B6229FC48B99A45CDA49FC85
+      34A25B9288688C25A4219280D3DB591A6F89BEC7D461FC96BA10323BF6907A29
+      87A8A6789CE41E7C1B65A2AE7786DF2CCC936C308B5DCE24B1C130D6AED089D0
+      FA1875BE8806190B634D991BB168C8B9299ED3D0739D32E2BB5BED59C5ABFECE
+      8F1631277401EF6B8EDAE6129FDA8473F58621BFBD9A65546302D1C23C7E2AF3
+      53F7E675D6ADD69BA0A648FCCF84A1EA8DF53E7BCCB357202EF222A23E563DCB
+      F0C6186C33560F635D6A3612D01041EE65B97A96191D7943661978265C3D4BC7
+      7C315F794D67A4BBF7F3C96DA4B7E7A96799D89A8EAC2599C8A658026BC3F038
+      BC118B941518488CDED86355BD9E4737E17A483230CB994173F9DA77E688776F
+      247BD5DF51FF631BB72C9ECF2C92D05926435714CCF8590E5ABF8FAE753AE3D6
+      640B9E85EECA5FD0592EE5D3459BF97C8685C6183A16190297273032742CA4E8
+      0A3EDE3292718BB7A0336B9D46FE934552B6659C40567193CD39E7186FB28909
+      A63EE89B79A13BDF5323AFE794CD6F7FF59371F61109D5B7D87EB09D98E3DDB4
+      76F7304522D7C84F7748E1404B0F8517EE226FEBA34070F5736B0FC66E3B35F2
+      1B164C65B6B79C9C0BCF38A2E857FBFE4B7DCCF62D46B2C858235FB36C224F6F
+      28B00E3A88555081DA55CF4FBAEAA95D32F1AD7C83A51E7D37BBE0663E287CA0
+      F94738258672678A0BB7E292E1834D8227A208FB61716476A6BC385708ED9928
+      9BBC51D6495056BAA32C71429EED8A6B6118698A6354DD6E63437522C689F64C
+      F09AAB8E63B8ED225BCBEE52969B0A152E423E31CA525794458E28F7FFC0F268
+      47923A4B48E92A41651E3571ACAF491CE08D82DB09AFEA21CF730DBDD53BA0C8
+      0165C15A947BED51E6ACE49B204B7214E50CB6B48ED2015E6553035A897275A5
+      CE658E50B790BBD26DC0F537CDC3AD2A16972AA99A75A9940EC93FD8CA6C27B1
+      DB448F4366FA142DD1A7D0549F75F6C618C6ADC4BD2A5E9D57F5A9FA3E12FF26
+      539D7DDD3F68FFDFD7FE9AFD57882CF99D25BBDA7817ED1BEEA8C0BFF60EC73A
+      1E72EB8970453B1EB02CAE096DB43F43564748E73D4AFF7C4EECA93B1477F6D1
+      70ED059E799D68D2BE28AE8A60450F0D7D2FD978B50FEF96FB88F75DC631BB03
+      4DDAAFAB8E22A0B387A6FE9738FFD18BC38D7E02BB1E6392D58D26ED1F9587E2
+      7FFE8E9A7512D8B5D7FB09523C6249B20289A7CF003F92F6CBF605E377A29333
+      42CDE2EE7E1C6F3C13EA78C8D2B42B6C29BD8B91EF3F7D7B5DFBF2145F02CB7F
+      25A9A29D55CD3771E8EE656BDB7D56A47790EEEE4844CD03A6FBB70CA97FB0F6
+      BF8B39C4B5C760B7F30A5F06D6629E7916F3E80A72EC4404BA7B3323E422DE7B
+      3B47BC4B2AED1BBB8791DAF49CE4E6E72C8E6C668A5B3E31E60B29B531D04A43
+      BA0B5761E82C15729E44145FC387FDFF61FFFF17F67F5AD26E8C1C4F335654CD
+      C76647DF69FFA785C7B2D0F722F1C7FB39D1A5C4A7A01763AF96B7FE070CDEFF
+      06B68502DB87550AE8FAC3E4283091DD63B469A556FB7FACA886E256E590FDFF
+      C5F6078C11D568B5FFF5BE3F8278D7538181517ECF04EF61B4E43AA3CD2AB5DA
+      FFCE96BE4C133732D9FF366303EEF291FB55C6589D7C676DABF2A96A1E9CF76F
+      3E77AC68
+    }
+  end
+  object ilAccesslevel: TImageList
+    Left = 230
+    Bitmap = {
+      4C7A060000001000000010000000BB0A00000000000078DAD597075454571AC7
+      B39288214643DA2611DDEC3131C608B1031154547487DE46040686A6088A18CA
+      C0209D418A14471064A477A48820550441442074AC5905414D2C341731A038FF
+      BDEFB9B0BAD4E4247B76DF39FFF3EE9B777FDF77EFF7DEFFDD3B6FBC31FE484C
+      4C445C5C1CA2A3A321100810111181B0B030BC318323212101A5A5A5A8ABAB43
+      7D7D3D7DAEACAC44565616020303A78C111F1F8FAAAA2A949595816A87878723
+      343494CE9F9D9D4D8BC7E34D1AA3A4A404E5E5E5387EFCF8B83EBEBEBE484B4B
+      434C4CCC843C35572A379577B2F8FEFEFE484F4F0797CB1DD727323212D5D5D5
+      53D6C9D5D515191919E07038AFF531B9D009BFB834F0F97C04070743BFF82698
+      451DD0CC6F87EAE95B6064DDC4B6B46B707272A2D95D6E415819797D2C867165
+      276A0746F0C3C00B5C7E2AC4B5A7C0F527C0ED21A083E8C741A0E1F1082A7B9E
+      E1DCA397FA26F4EA18CF2ABF8D1AC23B740CC3FFA71738F63320B8079CEC05D2
+      7A80C83B80FD9561E8D50F40BDE631CE3E78862F82AE8CF13BCF76E012896F73
+      73183BCEF6C0E45C1F4E90186B53BAA09CD489235D2073780099A43B6054F5A3
+      E8FE3016F95D1EE3B50BDB51DD3F02AB1B4370E97A8123F749CE07C0AAD80EE8
+      1CCE4500E1AD9A87A171F131B655F4A3E0E7617CE2DD36C6ABE5DEC285BEE7D8
+      7575082A05DDD027F98F3D025644DC82AA5706789D8042FA0312AF139BCBFA70
+      E6DE303E706B1DE3A9FA56F43E07BBED17ECFBFB08DCC9DC43C8BC23FE018492
+      B34B0760503F846D84952BE945DE9D61CCE3B68CF15BD2FE8EF2EEE7D06B1A84
+      424E37D44AFAA05FD907E3EA3EB0AAFAC898FA209DFC1396093A2153D48BD377
+      86F0B643F3182F9FF8234AC933297D3482F25E21AAC9B36B24CFADED19D04CCE
+      97C8384A1E8C20EFEE3072BA8668BDF57DD318BF2EFA06FD3E2C0FBB86A547AE
+      6271E015BABE9FF1DAF091472BC45D5AE8F18A719A216AD784370F34E14FFB1B
+      67E4E7DF72EC30DC830F363AE3DD0DAE982BC7C1FBB29650DB6136A37C6C334B
+      2C557585A44938E633FCB0DC38147337D86181BC31F48CA68F21ADC5C597FA14
+      C3C1173A3E9847D8254C1E3EDE60890F57684CCB8BAFB3C032E5EFA1E21083F5
+      66C1105F6B80A55A072121AB87F75631A7E53FF99B134E14B620B1B607B117EF
+      C33EBE019E39B7109ED788CF54DCA6E557188620A5AE1719F50F91DAFC146944
+      74BBA11752A682697979797928D8C4208ABCAFA72EFF422BB9E9291438299096
+      969E92673018505656A6BF9F2C160B4C97445A2A2A2AF46F6A6A6A747B22D6D1
+      D191BE47F5A1BED77A7A7AF4B72E3939193A3A3A3874E8104C4D4DA1A4A43421
+      6F666686A4A424686868404B4B0B060606282A2A42454505747575A1AAAA0A7D
+      7D7DB8B9B9C1D8D8F8B5184B5D1AE194F710CECECEF0F6F6A6FB181A1A829A0F
+      3526269309737373B0D96C585B5BC3ADA8075FDB5F1A8BF1B56B0BBC88AFA9FB
+      212121741C6A3E545F6A3EB6B6B6B0B1B1A1D71E2A9677691F9639D6BD36862F
+      B90D30323282BABA3ADD8F928787073D776A4CD435357745454548B935C23AA1
+      0D933D3F6AAED4D8B76FDF4E8B62A8B38C8CCCEFEE5900BFBB16C7375F147179
+      88591E3D98E5DC0D11DB9FF1B9A0B67926EC97292D6745A37A2012DEF75241BD
+      98E5DA8DB75CEE607162C3A5E978B1548AEDA799591E243725CF4710B1B98B37
+      D92D988E17D9FF104649B50828BC8BD5C5F720B2AF036FDA77E12D875B10B1B8
+      01797EC9FCA9F80516E98FCF5DEBA3FD1F4DFC2F7BE121742E7623E5463F24EC
+      8A06ADE25A674FC52F610BEA26F3BFA4A9A07E2A56D9EAF8DC6526C7DABFB1CD
+      1FE7FFE54E2558C10ABAA5667EF883895825CBE3E2F27B630B677B5E4115595F
+      567AD741D1359716D5CEBC3288D99E97B17E4F54F9E63D824F5F65F5CDBD6669
+      08DAE3E6F8DE44C95DB26E5E0358E781ED85C0BA1C21969C1442B5588813D785
+      98CBBB8A4DBBC2CE6CB188101BE537D9A4468A86F6C3BE16B0AB7DC9C9E402DF
+      64029FA70AF169C233BC1FF51472B9424865BE80447017E4AC62534779E2FF11
+      CAFF0B9346B02403B4FE9A268404B9FE73DC30C409FB4EC40044F9DD784F3038
+      EAFF67A33CF1BF90F2FF6C727F6B01B028E9393E4B18C647B143103F31888F63
+      7FC187518374EE7901EDA3FE178EF2C4CB5CE2FFE76F1F7988D97EEDF89AE49F
+      48A2BC1B78C7B38DF2FF1061BC5FADA1655AC7BBEB5DAB24650E9CEC5CE8D524
+      9CCFBB0231AFAB449731CFB3159FBA3708256D4E0D7CC72D5B6D99DEF9EEEFE5
+      D53FE2F82AF71E16A40E4022F30924D29E6041FC637C95D93EA3644BF3095B30
+      088951E512653CC1C293FD589A737BDA180B4BFEC59D7CF2323F2D329678E2BF
+      D0BBD3F20B6206609AD148FB7F43F52348C4F690F7AA178B92495BF0605A7E91
+      75165EF5FFD6C63E1834F421EDE6637CEE726E5A7EB9493026F77FE4B4BC8A2D
+      036BEC23C7F97FAD733C94ACB64DC973430DF1958F1AF2066BC0F00F81B27B1C
+      2DAA9D7EBF044B78AAB00BD49B30C6A9DB99900E3344EC8B6AF0FB8AE0743516
+      360DE1B0AC0E8169B91FEC9A8E23ACBF182BFC34E1E4ABF35A0C5EF43E2826EC
+      85D7ED745A3477E908CC2B0FC3A8D407BAF96ED0C876C4DE1A3E2CCE07405DB0
+      1B9CA3E6F8CFF55FBFC813A6E7FD69B1CF1DA2AF99792E50CFE280917A000A31
+      1650CDB09F74FDDF44EEEFAF3F0603C2ED2439B54F3B433DD3013AE4AC496258
+      540460FD51D6A4EBFFE6680BAC0CD90933D26F22490668E35B3FED29D7FFDD81
+      BAD87C9889D5FE5A9022B592F4D580147926B244EA5E6A7FD89EFD7F6DFF3F9F
+      1140EFFFE7297AFEEAFDFF7C4608BDFFA7386AFF2FBEF100E6AF3399D1FEFF3D
+      693B3885E6D3FEB708BD40EFFF3F9265CF78FFFF1756E498FF5FDDFF17B63DC2
+      E25D49D3F2B26CFF49FDFFED0CFC1FBE7703B46DF9E3FCAFC91520D05C6E4A3E
+      99A388D3AE1B71BD2C0EE15EDF83699B842D46F948E0B27183FC76C66333D21C
+      26FE86540A0E20D75581EE73B33C0665012AA82A288591450DF23C55D196E387
+      4ABE1E4E396F40AC8DC26B31921D9570E1A801BAEA7250E0B51585DE8A28F263
+      42C9A0191AC6AD28F155419EBB02CA03D4D09CEE8AB2205D44D96C1BE7FFC614
+      2E5AB3BDE93E857E7A50554B81A3A90B0A78CAA80A65A12298894B028B49FD5F
+      11C2C4F5E23012C709F5890E2809257372DF8ABAD8FDA889B2445BB60F8A788C
+      49FD7F3E5807F99E5BD076CA87564B863B8A7DB6D363A2AE730E6E443A476E4A
+      FF47EE5E436AA4806CAE3CB29CE4689D7490259243A8C9CAFF8BFDFF1F29B504
+      5DBE52B496FB6F6155E377F0CDF2ACC13E6509053E83FB6B58953826DF34771F
+      BC5AC8FFC31AB226A5184386B7F1E04C58E5581DBE718E153C9B82E0DE74183B
+      534DC8F77C13D6B87D3767B40FFBACD51656A1C5AE716C8C369F1AAF7B6300DC
+      1AFDE9BCD25EF223AB5D65FFCD9658C9B10A76FF647D9E0B6626DB666C4F1FAD
+      C537CADE03D7067FB834F86247321BEB3CE54656B9C88CB146C596DB0CF277DF
+      E5D61E824763103453F447489D6C18519A8759591670A93F04EE0F3ED04932C4
+      5A8FF5232B0F4ACF796DEF7F66D7DB7A3966D87B8E035EEB1138D7FAC038D70A
+      6667ACE154EB0DA71FBCA09DC8C21AF7EF5EAC745E3767A2FA68A7B3C4485E98
+      E55BD3733C58EF0B4E9D2738B59ED04AD0A7EA245CC15D3B67CA1AC7688B3104
+      9A30C83487639D17EC6BDCA019A7075227E1B74E53B3A3DA7C9421B629783B74
+      C878D5637541EA2494725C33E7D7BC27E4B98A497BCB83D4E9B91467B5E86F79
+      4F499DC4241D5689FE37FCF44F29E8A03D
+    }
+  end
+end

Client/UfrmAccountControl.pas

@@ -1,411 +1,487 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2008 Andreas Schneider
- *)
-unit UfrmAccountControl;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
-  VirtualTrees, Math, UEnhancedMemoryStream, UEnums;
-
-type
-
-  { TfrmAccountControl }
-
-  TfrmAccountControl = class(TForm)
-    ilToolbar: TImageList;
-    ilAccesslevel: TImageList;
-    tbMain: TToolBar;
-    tbRefresh: TToolButton;
-    tbAddUser: TToolButton;
-    tbEditUser: TToolButton;
-    tbDeleteUser: TToolButton;
-    tbSeparator1: TToolButton;
-    vstAccounts: TVirtualStringTree;
-    procedure tbEditUserClick(Sender: TObject);
-    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
-    procedure FormCreate(Sender: TObject);
-    procedure FormDestroy(Sender: TObject);
-    procedure FormShow(Sender: TObject);
-    procedure tbAddUserClick(Sender: TObject);
-    procedure tbDeleteUserClick(Sender: TObject);
-    procedure tbRefreshClick(Sender: TObject);
-    procedure vstAccountsDblClick(Sender: TObject);
-    procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
-    procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
-      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
-      var Ghosted: Boolean; var ImageIndex: Integer);
-    procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
-      Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
-  protected
-    procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
-    procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
-    procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
-    function FindNode(AUsername: string): PVirtualNode;
-  end;
-
-var
-  frmAccountControl: TfrmAccountControl;
-
-implementation
-
-uses
-  UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount;
-
-type
-  PAccountInfo = ^TAccountInfo;
-  TAccountInfo = record
-    Username: string;
-    AccessLevel: TAccessLevel;
-    Regions: TStringList;
-  end;
-  
-  { TModifyUserPacket }
-
-  TModifyUserPacket = class(TPacket)
-    constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel;
-      ARegions: TStrings);
-  end;
-  
-  { TDeleteUserPacket }
-
-  TDeleteUserPacket = class(TPacket)
-    constructor Create(AUsername: string);
-  end;
-  
-  { TRequestUserListPacket }
-
-  TRequestUserListPacket = class(TPacket)
-    constructor Create;
-  end;
-
-{ TModifyUserPacket }
-
-constructor TModifyUserPacket.Create(AUsername, APassword: string;
-  AAccessLevel: TAccessLevel; ARegions: TStrings);
-var
-  regionCount: Byte;
-  i: Integer;
-begin
-  inherited Create($03, 0);
-  FStream.WriteByte($05);
-  FStream.WriteStringNull(AUsername);
-  FStream.WriteStringNull(APassword);
-  FStream.WriteByte(Byte(AAccessLevel));
-
-  regionCount := Min(ARegions.Count, 256);
-  FStream.WriteByte(regionCount);
-
-  for i := 0 to regionCount - 1 do
-    FStream.WriteStringNull(ARegions.Strings[i]);
-end;
-
-{ TDeleteUserPacket }
-
-constructor TDeleteUserPacket.Create(AUsername: string);
-begin
-  inherited Create($03, 0);
-  FStream.WriteByte($06);
-  FStream.WriteStringNull(AUsername);
-end;
-
-{ TRequestUserListPacket }
-
-constructor TRequestUserListPacket.Create;
-begin
-  inherited Create($03, 0);
-  FStream.WriteByte($07);
-end;
-
-{ TfrmAccountControl }
-
-procedure TfrmAccountControl.FormCreate(Sender: TObject);
-begin
-  vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
-  
-  AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
-  AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
-  AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
-end;
-
-procedure TfrmAccountControl.FormClose(Sender: TObject;
-  var CloseAction: TCloseAction);
-begin
-  CloseAction := caHide;
-end;
-
-procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
-var
-  selected: PVirtualNode;
-  accountInfo: PAccountInfo;
-  regions: TStrings;
-begin
-  selected := vstAccounts.GetFirstSelected;
-  if selected <> nil then
-  begin
-    accountInfo := vstAccounts.GetNodeData(selected);
-    with frmEditAccount do
-    begin
-      edUsername.Text := accountInfo^.Username;
-      edUsername.Color := clBtnFace;
-      edUsername.ReadOnly := True;
-      edPassword.Text := '';
-      lblPasswordHint.Visible := True;
-      SetAccessLevel(accountInfo^.AccessLevel);
-      SetRegions(accountInfo^.Regions);
-      if ShowModal = mrOK then
-      begin
-        regions := GetRegions;
-        dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text,
-          edPassword.Text, GetAccessLevel, regions));
-        regions.Free;
-      end;
-    end;
-  end;
-end;
-
-procedure TfrmAccountControl.FormDestroy(Sender: TObject);
-begin
-  if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]);
-  if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]);
-  if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]);
-end;
-
-procedure TfrmAccountControl.FormShow(Sender: TObject);
-begin
-  tbRefreshClick(Sender);
-end;
-
-procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
-var
-  regions: TStrings;
-begin
-  with frmEditAccount do
-  begin
-    edUsername.Text := '';
-    edUsername.Color := clWindow;
-    edUsername.ReadOnly := False;
-    edPassword.Text := '';
-    lblPasswordHint.Visible := False;
-    cbAccessLevel.ItemIndex := 2;
-    SetRegions(nil);
-    if ShowModal = mrOK then
-    begin
-      regions := GetRegions;
-      dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text,
-        GetAccessLevel, regions));
-      regions.Free;
-    end;
-  end;
-end;
-
-procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject);
-var
-  selected: PVirtualNode;
-  accountInfo: PAccountInfo;
-begin
-  selected := vstAccounts.GetFirstSelected;
-  if selected <> nil then
-  begin
-    accountInfo := vstAccounts.GetNodeData(selected);
-    if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?',
-      [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
-      dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
-  end;
-end;
-
-procedure TfrmAccountControl.tbRefreshClick(Sender: TObject);
-begin
-  dmNetwork.Send(TRequestUserListPacket.Create);
-end;
-
-procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
-begin
-  tbEditUserClick(Sender);
-end;
-
-procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree;
-  Node: PVirtualNode);
-var
-  accountInfo: PAccountInfo;
-begin
-  accountInfo := vstAccounts.GetNodeData(Node);
-  accountInfo^.Username := '';
-  if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions);
-end;
-
-procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
-  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
-  var Ghosted: Boolean; var ImageIndex: Integer);
-var
-  accountInfo: PAccountInfo;
-begin
-  if Column = 0 then
-  begin
-    accountInfo := Sender.GetNodeData(Node);
-    case accountInfo^.AccessLevel of
-      alNone: ImageIndex := 0;
-      alView: ImageIndex := 1;
-      alNormal: ImageIndex := 2;
-      alAdministrator: ImageIndex := 3;
-    end;
-  end;
-end;
-
-procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree;
-  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
-  var CellText: String);
-var
-  accountInfo: PAccountInfo;
-begin
-  accountInfo := Sender.GetNodeData(Node);
-  case Column of
-    1: CellText := accountInfo^.Username;
-    2: CellText := GetAccessLevelString(accountInfo^.AccessLevel);
-  else
-    CellText := '';
-  end;
-end;
-
-procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
-var
-  node: PVirtualNode;
-  modifyStatus: TModifyUserStatus;
-  username: string;
-  accountInfo: PAccountInfo;
-  i, regions: Integer;
-begin
-  modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
-  username := ABuffer.ReadStringNull;
-  case modifyStatus of
-    muAdded:
-      begin
-        node := vstAccounts.AddChild(nil);
-        accountInfo := vstAccounts.GetNodeData(node);
-        accountInfo^.Username := username;
-        accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
-        accountInfo^.Regions := TStringList.Create;
-        regions := ABuffer.ReadByte;
-        for i := 0 to regions - 1 do
-          accountInfo^.Regions.Add(ABuffer.ReadStringNull);
-
-        Messagedlg('Success', Format('The user "%s" has been added.', [username]),
-          mtInformation, [mbOK], 0);
-      end;
-    muModified:
-      begin
-        node := FindNode(username);
-        if node <> nil then
-        begin
-          accountInfo := vstAccounts.GetNodeData(node);
-          accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
-          accountInfo^.Regions.Clear;
-          regions := ABuffer.ReadByte;
-          for i := 0 to regions - 1 do
-            accountInfo^.Regions.Add(ABuffer.ReadStringNull);
-
-          Messagedlg('Success', Format('The user "%s" has been modified.', [username]),
-            mtInformation, [mbOK], 0);
-        end;
-      end;
-    muInvalidUsername:
-      MessageDlg('Error', Format('The username "%s" is not valid.', [username]),
-        mtError, [mbOK], 0);
-  end;
-end;
-
-procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
-var
-  node: PVirtualNode;
-  deleteStatus: TDeleteUserStatus;
-  username: string;
-begin
-  deleteStatus := TDeleteUserStatus(ABuffer.ReadByte);
-  username := ABuffer.ReadStringNull;
-  case deleteStatus of
-    duDeleted:
-      begin
-        node := FindNode(username);
-        if node <> nil then
-        begin
-          vstAccounts.DeleteNode(node);
-          Messagedlg('Success', Format('The user "%s" has been deleted.', [username]),
-            mtInformation, [mbOK], 0);
-        end;
-      end;
-    duNotFound:
-      MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' +
-        'your list is out of date or you tried to delete yourself.', [username]),
-         mtError, [mbOK], 0);
-  end;
-end;
-
-procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
-var
-  node: PVirtualNode;
-  accountInfo: PAccountInfo;
-  i, j, count, regions: Integer;
-begin
-  vstAccounts.BeginUpdate;
-  vstAccounts.Clear;
-  count := ABuffer.ReadWord;
-  for i := 1 to count do
-  begin
-    node := vstAccounts.AddChild(nil);
-    accountInfo := vstAccounts.GetNodeData(node);
-    accountInfo^.Username := ABuffer.ReadStringNull;
-    accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
-    accountInfo^.Regions := TStringList.Create;
-    regions := ABuffer.ReadByte;
-    for j := 0 to regions - 1 do
-      accountInfo^.Regions.Add(ABuffer.ReadStringNull);
-  end;
-  vstAccounts.EndUpdate;
-end;
-
-function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
-var
-  node: PVirtualNode;
-  accountInfo: PAccountInfo;
-begin
-  Result := nil;
-  node := vstAccounts.GetFirst;
-  while (node <> nil) and (Result = nil) do
-  begin
-    accountInfo := vstAccounts.GetNodeData(node);
-    if accountInfo^.Username = AUsername then
-      Result := node;
-    node := vstAccounts.GetNext(node);
-  end;
-end;
-
-initialization
-  {$I UfrmAccountControl.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2008 Andreas Schneider
+ *)
+unit UfrmAccountControl;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
+  StdCtrls, ExtCtrls, laz.VirtualTrees, Math, UEnhancedMemoryStream, UEnums;
+
+type
+
+  { TfrmAccountControl }
+
+  TfrmAccountControl = class(TForm)
+    ilToolbar: TImageList;
+    ilAccesslevel: TImageList;
+    tbMain: TToolBar;
+    tbRefresh: TToolButton;
+    tbAddUser: TToolButton;
+    tbEditUser: TToolButton;
+    tbDeleteUser: TToolButton;
+    tbSeparator1: TToolButton;
+    vstAccounts: TLazVirtualStringTree;
+    procedure tbEditUserClick(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure tbAddUserClick(Sender: TObject);
+    procedure tbDeleteUserClick(Sender: TObject);
+    procedure tbRefreshClick(Sender: TObject);
+    procedure vstAccountsCompareNodes(Sender: TBaseVirtualTree; Node1,
+      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
+    procedure vstAccountsDblClick(Sender: TObject);
+    procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
+    procedure vstAccountsGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
+      Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
+      var HintText: String);
+    procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
+      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
+      var Ghosted: Boolean; var ImageIndex: Integer);
+    procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
+      Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
+    procedure vstAccountsHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
+      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+  protected
+    procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
+    procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
+    procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
+    function FindNode(AUsername: string): PVirtualNode;
+  private
+    procedure OnListModified;
+  end;
+
+var
+  frmAccountControl: TfrmAccountControl;
+
+implementation
+
+uses
+  UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount;
+
+type
+  PAccountInfo = ^TAccountInfo;
+  TAccountInfo = record
+    Username: string;
+    AccessLevel: TAccessLevel;
+    Regions: TStringList;
+  end;
+  
+  { TModifyUserPacket }
+
+  TModifyUserPacket = class(TPacket)
+    constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel;
+      ARegions: TStrings);
+  end;
+  
+  { TDeleteUserPacket }
+
+  TDeleteUserPacket = class(TPacket)
+    constructor Create(AUsername: string);
+  end;
+  
+  { TRequestUserListPacket }
+
+  TRequestUserListPacket = class(TPacket)
+    constructor Create;
+  end;
+
+{ TModifyUserPacket }
+
+constructor TModifyUserPacket.Create(AUsername, APassword: string;
+  AAccessLevel: TAccessLevel; ARegions: TStrings);
+var
+  regionCount: Byte;
+  i: Integer;
+begin
+  inherited Create($03, 0);
+  FStream.WriteByte($05);
+  FStream.WriteStringNull(AUsername);
+  FStream.WriteStringNull(APassword);
+  FStream.WriteByte(Byte(AAccessLevel));
+
+  regionCount := Min(ARegions.Count, 256);
+  FStream.WriteByte(regionCount);
+
+  for i := 0 to regionCount - 1 do
+    FStream.WriteStringNull(ARegions.Strings[i]);
+end;
+
+{ TDeleteUserPacket }
+
+constructor TDeleteUserPacket.Create(AUsername: string);
+begin
+  inherited Create($03, 0);
+  FStream.WriteByte($06);
+  FStream.WriteStringNull(AUsername);
+end;
+
+{ TRequestUserListPacket }
+
+constructor TRequestUserListPacket.Create;
+begin
+  inherited Create($03, 0);
+  FStream.WriteByte($07);
+end;
+
+{ TfrmAccountControl }
+
+procedure TfrmAccountControl.FormCreate(Sender: TObject);
+begin
+  vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
+  
+  AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
+  AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
+  AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
+end;
+
+procedure TfrmAccountControl.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction := caHide;
+end;
+
+procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
+var
+  selected: PVirtualNode;
+  accountInfo: PAccountInfo;
+  regions: TStrings;
+begin
+  selected := vstAccounts.GetFirstSelected;
+  if selected <> nil then
+  begin
+    accountInfo := vstAccounts.GetNodeData(selected);
+    with frmEditAccount do
+    begin
+      edUsername.Text := accountInfo^.Username;
+      edUsername.Color := clBtnFace;
+      edUsername.ReadOnly := True;
+      edPassword.Text := '';
+      lblPasswordHint.Visible := True;
+      SetAccessLevel(accountInfo^.AccessLevel);
+      SetRegions(accountInfo^.Regions);
+      if ShowModal = mrOK then
+      begin
+        regions := GetRegions;
+        dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text,
+          edPassword.Text, GetAccessLevel, regions));
+        regions.Free;
+      end;
+    end;
+  end;
+end;
+
+procedure TfrmAccountControl.FormDestroy(Sender: TObject);
+begin
+  if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]);
+  if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]);
+  if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]);
+end;
+
+procedure TfrmAccountControl.FormShow(Sender: TObject);
+begin
+  tbRefreshClick(Sender);
+end;
+
+procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
+var
+  regions: TStrings;
+begin
+  with frmEditAccount do
+  begin
+    edUsername.Text := '';
+    edUsername.Color := clWindow;
+    edUsername.ReadOnly := False;
+    edPassword.Text := '';
+    lblPasswordHint.Visible := False;
+    cbAccessLevel.ItemIndex := 2;
+    SetRegions(nil);
+    if ShowModal = mrOK then
+    begin
+      regions := GetRegions;
+      dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text,
+        GetAccessLevel, regions));
+      regions.Free;
+    end;
+  end;
+end;
+
+procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject);
+var
+  selected: PVirtualNode;
+  accountInfo: PAccountInfo;
+begin
+  selected := vstAccounts.GetFirstSelected;
+  if selected <> nil then
+  begin
+    accountInfo := vstAccounts.GetNodeData(selected);
+    if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?',
+      [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
+      dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
+  end;
+end;
+
+procedure TfrmAccountControl.tbRefreshClick(Sender: TObject);
+begin
+  dmNetwork.Send(TRequestUserListPacket.Create);
+end;
+
+procedure TfrmAccountControl.vstAccountsCompareNodes(Sender: TBaseVirtualTree;
+  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
+var
+  accountInfo1, accountInfo2: PAccountInfo;
+begin
+  accountInfo1 := Sender.GetNodeData(Node1);
+  accountInfo2 := Sender.GetNodeData(Node2);
+  case Column of
+    1: Result := CompareText(accountInfo1^.Username, accountInfo2^.Username);
+    2: Result := Integer(accountInfo1^.AccessLevel) - Integer(accountInfo2^.AccessLevel);
+  end;
+end;
+
+procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
+begin
+  tbEditUserClick(Sender);
+end;
+
+procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree;
+  Node: PVirtualNode);
+var
+  accountInfo: PAccountInfo;
+begin
+  accountInfo := vstAccounts.GetNodeData(Node);
+  accountInfo^.Username := '';
+  if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions);
+end;
+
+procedure TfrmAccountControl.vstAccountsGetHint(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Column: TColumnIndex;
+  var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
+var
+  accountInfo: PAccountInfo;
+begin
+  if Column = 3 then
+  begin
+    accountInfo := Sender.GetNodeData(Node);
+    if accountInfo^.Regions.Count > 0 then
+      HintText := Trim(accountInfo^.Regions.Text);
+  end;
+end;
+
+procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
+  var Ghosted: Boolean; var ImageIndex: Integer);
+var
+  accountInfo: PAccountInfo;
+begin
+  accountInfo := Sender.GetNodeData(Node);
+  if Column = 0 then
+  begin
+    case accountInfo^.AccessLevel of
+      alNone: ImageIndex := 0;
+      alView: ImageIndex := 1;
+      alNormal:
+        begin
+          if accountInfo^.Regions.Count > 0 then
+            ImageIndex := 2
+          else
+            ImageIndex := 3;
+        end;
+      alAdministrator: ImageIndex := 4;
+    end;
+  end else if Column = 3 then
+  begin
+    if accountInfo^.Regions.Count > 0 then
+      ImageIndex := 5;
+  end;
+end;
+
+procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+  var CellText: String);
+var
+  accountInfo: PAccountInfo;
+begin
+  accountInfo := Sender.GetNodeData(Node);
+  case Column of
+    1: CellText := accountInfo^.Username;
+    2: CellText := GetAccessLevelString(accountInfo^.AccessLevel);
+  else
+    CellText := '';
+  end;
+end;
+
+procedure TfrmAccountControl.vstAccountsHeaderClick(Sender: TVTHeader;
+  Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  if Column in [1, 2] then
+  begin
+    if Sender.SortColumn <> Column then
+    begin
+      Sender.SortColumn := Column;
+      Sender.SortDirection := sdAscending;
+    end else
+    begin
+      case Sender.SortDirection of
+        sdAscending: Sender.SortDirection := sdDescending;
+        sdDescending: Sender.SortDirection := sdAscending;
+      end;
+    end;
+    Sender.Treeview.SortTree(Sender.SortColumn, Sender.SortDirection);
+  end;
+end;
+
+procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
+var
+  node: PVirtualNode;
+  modifyStatus: TModifyUserStatus;
+  username: string;
+  accountInfo: PAccountInfo;
+  i, regions: Integer;
+begin
+  modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
+  username := ABuffer.ReadStringNull;
+  case modifyStatus of
+    muAdded:
+      begin
+        node := vstAccounts.AddChild(nil);
+        accountInfo := vstAccounts.GetNodeData(node);
+        accountInfo^.Username := username;
+        accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
+        accountInfo^.Regions := TStringList.Create;
+        regions := ABuffer.ReadByte;
+        for i := 0 to regions - 1 do
+          accountInfo^.Regions.Add(ABuffer.ReadStringNull);
+        OnListModified;
+
+        Messagedlg('Success', Format('The user "%s" has been added.', [username]),
+          mtInformation, [mbOK], 0);
+      end;
+    muModified:
+      begin
+        node := FindNode(username);
+        if node <> nil then
+        begin
+          accountInfo := vstAccounts.GetNodeData(node);
+          accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
+          accountInfo^.Regions.Clear;
+          regions := ABuffer.ReadByte;
+          for i := 0 to regions - 1 do
+            accountInfo^.Regions.Add(ABuffer.ReadStringNull);
+          OnListModified;
+
+          Messagedlg('Success', Format('The user "%s" has been modified.', [username]),
+            mtInformation, [mbOK], 0);
+        end;
+      end;
+    muInvalidUsername:
+      MessageDlg('Error', Format('The username "%s" is not valid.', [username]),
+        mtError, [mbOK], 0);
+  end;
+end;
+
+procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
+var
+  node: PVirtualNode;
+  deleteStatus: TDeleteUserStatus;
+  username: string;
+begin
+  deleteStatus := TDeleteUserStatus(ABuffer.ReadByte);
+  username := ABuffer.ReadStringNull;
+  case deleteStatus of
+    duDeleted:
+      begin
+        node := FindNode(username);
+        if node <> nil then
+        begin
+          vstAccounts.DeleteNode(node);
+          OnListModified;
+
+          Messagedlg('Success', Format('The user "%s" has been deleted.', [username]),
+            mtInformation, [mbOK], 0);
+        end;
+      end;
+    duNotFound:
+      MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' +
+        'your list is out of date or you tried to delete yourself.', [username]),
+         mtError, [mbOK], 0);
+  end;
+end;
+
+procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
+var
+  node: PVirtualNode;
+  accountInfo: PAccountInfo;
+  i, j, count, regions: Integer;
+begin
+  vstAccounts.BeginUpdate;
+  vstAccounts.Clear;
+  count := ABuffer.ReadWord;
+  for i := 1 to count do
+  begin
+    node := vstAccounts.AddChild(nil);
+    accountInfo := vstAccounts.GetNodeData(node);
+    accountInfo^.Username := ABuffer.ReadStringNull;
+    accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
+    accountInfo^.Regions := TStringList.Create;
+    regions := ABuffer.ReadByte;
+    for j := 0 to regions - 1 do
+      accountInfo^.Regions.Add(ABuffer.ReadStringNull);
+  end;
+  vstAccounts.EndUpdate;
+  OnListModified;
+end;
+
+function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
+var
+  node: PVirtualNode;
+  accountInfo: PAccountInfo;
+begin
+  Result := nil;
+  node := vstAccounts.GetFirst;
+  while (node <> nil) and (Result = nil) do
+  begin
+    accountInfo := vstAccounts.GetNodeData(node);
+    if accountInfo^.Username = AUsername then
+      Result := node;
+    node := vstAccounts.GetNext(node);
+  end;
+end;
+
+procedure TfrmAccountControl.OnListModified;
+begin
+  vstAccounts.Header.SortColumn := -1;
+end;
+
+initialization
+  {$I UfrmAccountControl.lrs}
+
+end.
+

Client/UfrmChangePassword.lfm

@@ -0,0 +1,132 @@
+object frmChangePassword: TfrmChangePassword
+  Left = 283
+  Height = 186
+  Top = 193
+  Width = 387
+  BorderStyle = bsDialog
+  Caption = 'Change Password'
+  ClientHeight = 186
+  ClientWidth = 387
+  DesignTimePPI = 120
+  OnShow = FormShow
+  Position = poMainFormCenter
+  object Label1: TLabel
+    AnchorSideTop.Control = edOldPwd
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = edOldPwd
+    Left = 40
+    Height = 23
+    Top = 16
+    Width = 110
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 10
+    Caption = 'Old Password:'
+    Color = clDefault
+    ParentColor = False
+  end
+  object Label2: TLabel
+    AnchorSideTop.Control = edNewPwd
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = edNewPwd
+    Left = 32
+    Height = 23
+    Top = 61
+    Width = 118
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 10
+    Caption = 'New Password:'
+    Color = clDefault
+    ParentColor = False
+  end
+  object lblNewPwdRepeat: TLabel
+    AnchorSideTop.Control = edNewPwdRepeat
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = edNewPwdRepeat
+    Left = 14
+    Height = 23
+    Top = 106
+    Width = 136
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 10
+    Caption = 'Repeat Password:'
+    Color = clDefault
+    ParentColor = False
+  end
+  object edOldPwd: TEdit
+    Left = 160
+    Height = 35
+    Top = 10
+    Width = 220
+    EchoMode = emPassword
+    PasswordChar = '*'
+    TabOrder = 0
+  end
+  object edNewPwd: TEdit
+    AnchorSideLeft.Control = edOldPwd
+    AnchorSideTop.Control = edOldPwd
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = edOldPwd
+    AnchorSideRight.Side = asrBottom
+    Left = 160
+    Height = 35
+    Top = 55
+    Width = 220
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 10
+    EchoMode = emPassword
+    OnChange = edNewPwdChange
+    PasswordChar = '*'
+    TabOrder = 1
+  end
+  object edNewPwdRepeat: TEdit
+    AnchorSideLeft.Control = edNewPwd
+    AnchorSideTop.Control = edNewPwd
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = edNewPwd
+    AnchorSideRight.Side = asrBottom
+    Left = 160
+    Height = 35
+    Top = 100
+    Width = 220
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 10
+    EchoMode = emPassword
+    OnChange = edNewPwdChange
+    PasswordChar = '*'
+    TabOrder = 2
+  end
+  object btnOK: TButton
+    AnchorSideTop.Control = btnCancel
+    AnchorSideRight.Control = btnCancel
+    Left = 179
+    Height = 32
+    Top = 144
+    Width = 94
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 10
+    Caption = '&OK'
+    Default = True
+    Enabled = False
+    ModalResult = 1
+    OnClick = btnOKClick
+    TabOrder = 3
+  end
+  object btnCancel: TButton
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 283
+    Height = 32
+    Top = 144
+    Width = 94
+    Anchors = [akRight, akBottom]
+    BorderSpacing.Right = 10
+    BorderSpacing.Bottom = 10
+    Cancel = True
+    Caption = 'Cancel'
+    ModalResult = 2
+    OnClick = btnCancelClick
+    TabOrder = 4
+  end
+end

Client/UfrmChangePassword.pas

@@ -0,0 +1,81 @@
+unit UfrmChangePassword;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+  { TfrmChangePassword }
+
+  TfrmChangePassword = class(TForm)
+    btnOK: TButton;
+    btnCancel: TButton;
+    edOldPwd: TEdit;
+    edNewPwd: TEdit;
+    edNewPwdRepeat: TEdit;
+    Label1: TLabel;
+    Label2: TLabel;
+    lblNewPwdRepeat: TLabel;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnOKClick(Sender: TObject);
+    procedure edNewPwdChange(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end;
+
+var
+  frmChangePassword: TfrmChangePassword;
+
+implementation
+
+uses
+  UdmNetwork, UPackets, UEnums;
+
+{$R *.lfm}
+
+{ TfrmChangePassword }
+
+procedure TfrmChangePassword.FormShow(Sender: TObject);
+begin
+  edOldPwd.Text := '';
+  edNewPwd.Text := '';
+  edNewPwdRepeat.Text := '';
+end;
+
+procedure TfrmChangePassword.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TfrmChangePassword.btnOKClick(Sender: TObject);
+begin
+  dmNetwork.Send(TChangePasswordPacket.Create(edOldPwd.Text,
+    edNewPwd.Text));
+end;
+
+procedure TfrmChangePassword.edNewPwdChange(Sender: TObject);
+var
+  pwdValid: Boolean;
+begin
+  if edNewPwd.Text <> edNewPwdRepeat.Text then
+  begin
+    pwdValid := False;
+    lblNewPwdRepeat.Font.Color := clRed;
+  end else
+  begin
+    pwdValid := True;
+    lblNewPwdRepeat.Font.Color := clDefault;
+  end;
+
+  btnOK.Enabled := (Length(edNewPwd.Text) > 0) and pwdValid;
+end;
+
+end.
+

Client/UfrmEditAccount.lfm

@@ -1,167 +1,215 @@
-object frmEditAccount: TfrmEditAccount
-  Left = 290
-  Height = 214
-  Top = 171
-  Width = 261
-  ActiveControl = PageControl1
-  BorderIcons = [biSystemMenu]
-  BorderStyle = bsDialog
-  Caption = 'Edit Account'
-  ClientHeight = 214
-  ClientWidth = 261
-  Font.Height = -11
-  OnCreate = FormCreate
-  OnDestroy = FormDestroy
-  OnShow = FormShow
-  ParentFont = False
-  Position = poOwnerFormCenter
-  LCLVersion = '0.9.27'
-  object PageControl1: TPageControl
-    Height = 173
-    Width = 261
-    ActivePage = tsGeneral
-    Align = alClient
-    TabIndex = 0
-    TabOrder = 0
-    object tsGeneral: TTabSheet
-      Caption = 'General'
-      ClientHeight = 148
-      ClientWidth = 259
-      object lblPasswordHint: TLabel
-        Left = 86
-        Height = 28
-        Top = 64
-        Width = 160
-        AutoSize = False
-        Caption = 'Leave empty to leave the password unchanged.'
-        Enabled = False
-        ParentColor = False
-        WordWrap = True
-      end
-      object lblUsername: TLabel
-        Left = 6
-        Height = 14
-        Top = 12
-        Width = 58
-        Caption = 'Username:'
-        ParentColor = False
-      end
-      object lblPassword: TLabel
-        Left = 6
-        Height = 14
-        Top = 44
-        Width = 54
-        Caption = 'Password:'
-        ParentColor = False
-      end
-      object lblAccessLevel: TLabel
-        Left = 6
-        Height = 14
-        Top = 108
-        Width = 63
-        Caption = 'Accesslevel:'
-        ParentColor = False
-      end
-      object edUsername: TEdit
-        Left = 86
-        Height = 23
-        Top = 8
-        Width = 160
-        Color = clBtnFace
-        ReadOnly = True
-        TabOrder = 0
-      end
-      object edPassword: TEdit
-        Left = 86
-        Height = 23
-        Top = 40
-        Width = 160
-        EchoMode = emPassword
-        PasswordChar = '*'
-        TabOrder = 1
-      end
-      object cbAccessLevel: TComboBox
-        Left = 86
-        Height = 25
-        Top = 104
-        Width = 160
-        Items.Strings = (
-          'None'
-          'Viewer'
-          'Normal'
-          'Administrator'
-        )
-        Style = csDropDownList
-        TabOrder = 2
-      end
-    end
-    object tsRegions: TTabSheet
-      Caption = 'Regions'
-      ClientHeight = 148
-      ClientWidth = 259
-      object Label1: TLabel
-        Left = 8
-        Height = 14
-        Top = 8
-        Width = 243
-        Align = alTop
-        BorderSpacing.Left = 8
-        BorderSpacing.Top = 8
-        BorderSpacing.Right = 8
-        BorderSpacing.Bottom = 4
-        Caption = 'Allowed Regions:'
-        ParentColor = False
-      end
-      object cbRegions: TCheckListBox
-        Left = 8
-        Height = 114
-        Top = 26
-        Width = 243
-        Align = alClient
-        BorderSpacing.Left = 8
-        BorderSpacing.Top = 4
-        BorderSpacing.Right = 8
-        BorderSpacing.Bottom = 8
-        ItemHeight = 13
-        TabOrder = 0
-        TopIndex = -1
-      end
-    end
-  end
-  object Panel1: TPanel
-    Left = 8
-    Height = 25
-    Top = 181
-    Width = 245
-    Align = alBottom
-    BorderSpacing.Around = 8
-    BevelOuter = bvNone
-    ClientHeight = 25
-    ClientWidth = 245
-    TabOrder = 1
-    object btnCancel: TButton
-      Left = 170
-      Height = 25
-      Width = 75
-      Align = alRight
-      BorderSpacing.Left = 4
-      BorderSpacing.InnerBorder = 4
-      Cancel = True
-      Caption = 'Cancel'
-      ModalResult = 2
-      TabOrder = 0
-    end
-    object btnOK: TButton
-      Left = 91
-      Height = 25
-      Width = 75
-      Align = alRight
-      BorderSpacing.Right = 4
-      BorderSpacing.InnerBorder = 4
-      Caption = 'OK'
-      Default = True
-      ModalResult = 1
-      TabOrder = 1
-    end
-  end
-end
+object frmEditAccount: TfrmEditAccount
+  Left = 290
+  Height = 335
+  Top = 171
+  Width = 408
+  ActiveControl = PageControl1
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsDialog
+  Caption = 'Edit Account'
+  ClientHeight = 335
+  ClientWidth = 408
+  DesignTimePPI = 120
+  Font.Height = -18
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  Position = poOwnerFormCenter
+  object PageControl1: TPageControl
+    Left = 0
+    Height = 272
+    Top = 0
+    Width = 408
+    ActivePage = tsGeneral
+    Align = alClient
+    TabIndex = 0
+    TabOrder = 0
+    object tsGeneral: TTabSheet
+      Caption = 'General'
+      ClientHeight = 234
+      ClientWidth = 398
+      object lblPasswordHint: TLabel
+        AnchorSideLeft.Control = edPassword
+        AnchorSideTop.Control = edPassword
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = edPassword
+        AnchorSideRight.Side = asrBottom
+        Left = 128
+        Height = 52
+        Top = 102
+        Width = 260
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Around = 2
+        Caption = 'Leave empty to leave the password unchanged.'
+        Color = clDefault
+        Enabled = False
+        ParentColor = False
+        WordWrap = True
+      end
+      object lblUsername: TLabel
+        AnchorSideLeft.Control = tsGeneral
+        AnchorSideTop.Control = edUsername
+        AnchorSideTop.Side = asrCenter
+        Left = 8
+        Height = 26
+        Top = 14
+        Width = 92
+        BorderSpacing.Left = 8
+        Caption = 'Username:'
+        Color = clDefault
+        ParentColor = False
+      end
+      object lblPassword: TLabel
+        AnchorSideLeft.Control = lblUsername
+        AnchorSideTop.Control = edPassword
+        AnchorSideTop.Side = asrCenter
+        Left = 8
+        Height = 26
+        Top = 68
+        Width = 87
+        Caption = 'Password:'
+        Color = clDefault
+        ParentColor = False
+      end
+      object lblAccessLevel: TLabel
+        AnchorSideLeft.Control = lblPassword
+        AnchorSideTop.Control = cbAccessLevel
+        AnchorSideTop.Side = asrCenter
+        Left = 8
+        Height = 26
+        Top = 176
+        Width = 102
+        Caption = 'Accesslevel:'
+        Color = clDefault
+        ParentColor = False
+      end
+      object edUsername: TEdit
+        AnchorSideLeft.Control = lblAccessLevel
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = tsGeneral
+        AnchorSideRight.Control = tsGeneral
+        AnchorSideRight.Side = asrBottom
+        Left = 126
+        Height = 38
+        Top = 8
+        Width = 264
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Left = 16
+        BorderSpacing.Top = 8
+        BorderSpacing.Right = 8
+        Color = clBtnFace
+        ReadOnly = True
+        TabOrder = 0
+      end
+      object edPassword: TEdit
+        AnchorSideLeft.Control = edUsername
+        AnchorSideTop.Control = edUsername
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = edUsername
+        AnchorSideRight.Side = asrBottom
+        Left = 126
+        Height = 38
+        Top = 62
+        Width = 264
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 16
+        EchoMode = emPassword
+        PasswordChar = '*'
+        TabOrder = 1
+      end
+      object cbAccessLevel: TComboBox
+        AnchorSideLeft.Control = edPassword
+        AnchorSideTop.Control = lblPasswordHint
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = edPassword
+        AnchorSideRight.Side = asrBottom
+        Left = 126
+        Height = 38
+        Top = 170
+        Width = 264
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 16
+        ItemHeight = 0
+        Items.Strings = (
+          'None'
+          'Viewer'
+          'Normal'
+          'Administrator'
+        )
+        Style = csDropDownList
+        TabOrder = 2
+      end
+    end
+    object tsRegions: TTabSheet
+      Caption = 'Regions'
+      ClientHeight = 234
+      ClientWidth = 398
+      object Label1: TLabel
+        Left = 12
+        Height = 26
+        Top = 12
+        Width = 374
+        Align = alTop
+        BorderSpacing.Left = 12
+        BorderSpacing.Top = 12
+        BorderSpacing.Right = 12
+        BorderSpacing.Bottom = 6
+        Caption = 'Allowed Regions:'
+        Color = clDefault
+        ParentColor = False
+      end
+      object cbRegions: TCheckListBox
+        Left = 12
+        Height = 178
+        Top = 44
+        Width = 374
+        Align = alClient
+        BorderSpacing.Left = 12
+        BorderSpacing.Top = 6
+        BorderSpacing.Right = 12
+        BorderSpacing.Bottom = 12
+        ItemHeight = 0
+        TabOrder = 0
+        TopIndex = -1
+      end
+    end
+  end
+  object Panel1: TPanel
+    Left = 12
+    Height = 39
+    Top = 284
+    Width = 384
+    Align = alBottom
+    BorderSpacing.Around = 12
+    BevelOuter = bvNone
+    ClientHeight = 39
+    ClientWidth = 384
+    TabOrder = 1
+    object btnCancel: TButton
+      Left = 266
+      Height = 39
+      Top = 0
+      Width = 118
+      Align = alRight
+      BorderSpacing.Left = 6
+      BorderSpacing.InnerBorder = 6
+      Cancel = True
+      Caption = 'Cancel'
+      ModalResult = 2
+      TabOrder = 0
+    end
+    object btnOK: TButton
+      Left = 142
+      Height = 39
+      Top = 0
+      Width = 118
+      Align = alRight
+      BorderSpacing.Right = 6
+      BorderSpacing.InnerBorder = 6
+      Caption = 'OK'
+      Default = True
+      ModalResult = 1
+      TabOrder = 1
+    end
+  end
+end

Client/UfrmEditAccount.pas

@@ -31,7 +31,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  UEnums, ComCtrls, ExtCtrls, CheckLst, UfrmRegionControl, VirtualTrees;
+  UEnums, ComCtrls, ExtCtrls, CheckLst, UfrmRegionControl;
 
 type
 
@@ -72,6 +72,9 @@ var
 
 implementation
 
+uses
+  laz.VirtualTrees;
+
 { TfrmEditAccount }
 
 procedure TfrmEditAccount.FormCreate(Sender: TObject);

Client/UfrmInitialize.lfm

@@ -1,40 +1,38 @@
-object frmInitialize: TfrmInitialize
-  Left = 290
-  Height = 65
-  Top = 171
-  Width = 241
-  BorderIcons = []
-  BorderStyle = bsDialog
-  Caption = 'Please wait ...'
-  ClientHeight = 65
-  ClientWidth = 241
-  Font.Height = -11
-  OnClose = FormClose
-  OnCreate = FormCreate
-  Position = poScreenCenter
-  LCLVersion = '0.9.25'
-  object pnlMain: TPanel
-    Left = 8
-    Height = 50
-    Top = 8
-    Width = 226
-    BevelInner = bvRaised
-    BevelOuter = bvLowered
-    ClientHeight = 50
-    ClientWidth = 226
-    ParentFont = True
-    TabOrder = 0
-    object lblStatus: TLabel
-      Left = 8
-      Height = 32
-      Top = 8
-      Width = 208
-      Alignment = taCenter
-      AutoSize = False
-      Layout = tlCenter
-      ParentColor = False
-      ParentFont = True
-      WordWrap = True
-    end
-  end
-end
+object frmInitialize: TfrmInitialize
+  Left = 290
+  Height = 81
+  Top = 171
+  Width = 301
+  BorderIcons = []
+  BorderStyle = bsDialog
+  Caption = 'Please wait ...'
+  ClientHeight = 81
+  ClientWidth = 301
+  Font.Height = -14
+  OnClose = FormClose
+  OnCreate = FormCreate
+  Position = poScreenCenter
+  object pnlMain: TPanel
+    Left = 10
+    Height = 62
+    Top = 10
+    Width = 282
+    BevelInner = bvRaised
+    BevelOuter = bvLowered
+    ClientHeight = 62
+    ClientWidth = 282
+    TabOrder = 0
+    object lblStatus: TLabel
+      Left = 10
+      Height = 40
+      Top = 10
+      Width = 260
+      Alignment = taCenter
+      AutoSize = False
+      Color = clDefault
+      Layout = tlCenter
+      ParentColor = False
+      WordWrap = True
+    end
+  end
+end

Client/UfrmInitialize.pas

@@ -1,96 +1,96 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2007 Andreas Schneider
- *)
-unit UfrmInitialize;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  StdCtrls, LCLIntf, LCLType, WSForms;
-
-type
-
-  { TfrmInitialize }
-
-  TfrmInitialize = class(TForm)
-    lblStatus: TLabel;
-    pnlMain: TPanel;
-    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
-    procedure FormCreate(Sender: TObject);
-  protected
-    FActiveWindow: HWND;
-    FModal: Boolean;
-  public
-    procedure SetModal;
-    procedure UnsetModal;
-  end; 
-
-var
-  frmInitialize: TfrmInitialize;
-
-implementation
-
-{ TfrmInitialize }
-
-procedure TfrmInitialize.FormClose(Sender: TObject;
-  var CloseAction: TCloseAction);
-begin
-  CloseAction := caNone;
-end;
-
-procedure TfrmInitialize.FormCreate(Sender: TObject);
-begin
-  FModal := False;
-end;
-
-procedure TfrmInitialize.SetModal;
-begin
-  if FModal then Exit;
-  FActiveWindow := GetActiveWindow;
-  TWSCustomFormClass(WidgetSetClass).ShowModal(Self);
-  {FormStyle := fsStayOnTop;
-  Screen.MoveFormToFocusFront(Self);
-  Screen.MoveFormToZFront(Self);}
-  FModal := True;
-end;
-
-procedure TfrmInitialize.UnsetModal;
-begin
-  if not FModal then Exit;
-  TWSCustomFormClass(WidgetSetClass).CloseModal(Self);
-  if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow);
-  FActiveWindow := 0;
-  //FormStyle := fsNormal;
-  FModal := False;
-end;
-
-initialization
-  {$I UfrmInitialize.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2007 Andreas Schneider
+ *)
+unit UfrmInitialize;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  StdCtrls, LCLIntf, LCLType, WSForms;
+
+type
+
+  { TfrmInitialize }
+
+  TfrmInitialize = class(TForm)
+    lblStatus: TLabel;
+    pnlMain: TPanel;
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+  protected
+    FActiveWindow: HWND;
+    FModal: Boolean;
+  public
+    procedure SetModal;
+    procedure UnsetModal;
+  end; 
+
+var
+  frmInitialize: TfrmInitialize;
+
+implementation
+
+{ TfrmInitialize }
+
+procedure TfrmInitialize.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction := caNone;
+end;
+
+procedure TfrmInitialize.FormCreate(Sender: TObject);
+begin
+  FModal := False;
+end;
+
+procedure TfrmInitialize.SetModal;
+begin
+  if FModal then Exit;
+  FActiveWindow := GetActiveWindow;
+  TWSCustomFormClass(WidgetSetClass).ShowModal(Self);
+  {FormStyle := fsStayOnTop;
+  Screen.MoveFormToFocusFront(Self);
+  Screen.MoveFormToZFront(Self);}
+  FModal := True;
+end;
+
+procedure TfrmInitialize.UnsetModal;
+begin
+  if not FModal then Exit;
+  TWSCustomFormClass(WidgetSetClass).CloseModal(Self);
+  if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow);
+  FActiveWindow := 0;
+  //FormStyle := fsNormal;
+  FModal := False;
+end;
+
+initialization
+  {$I UfrmInitialize.lrs}
+
+end.
+

Client/UfrmLogin.pas

@@ -1,192 +1,190 @@
-(*
- * CDDL HEADER START
- *
- * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
- * with the License.
- *
- * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
- * and limitations under the License.
- *
- * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
- *
- * CDDL HEADER END
- *
- *
- *      Portions Copyright 2009 Andreas Schneider
- *)
-unit UfrmLogin;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  ExtCtrls, Spin, EditBtn, Buttons, IniFiles;
-
-type
-
-  { TfrmLogin }
-
-  TfrmLogin = class(TForm)
-    btnOK: TButton;
-    btnCancel: TButton;
-    cbProfile: TComboBox;
-    edData: TDirectoryEdit;
-    edHost: TEdit;
-    edUsername: TEdit;
-    edPassword: TEdit;
-    gbConnection: TGroupBox;
-    gbData: TGroupBox;
-    gbActions: TGroupBox;
-    gbProfiles: TGroupBox;
-    imgHost: TImage;
-    imgUsername: TImage;
-    imgPassword: TImage;
-    lblCopyright: TLabel;
-    lblHost: TLabel;
-    lblUsername: TLabel;
-    lblPassword: TLabel;
-    edPort: TSpinEdit;
-    lblData: TLabel;
-    btnSaveProfile: TSpeedButton;
-    btnDeleteProfile: TSpeedButton;
-    procedure btnCancelClick(Sender: TObject);
-    procedure btnDeleteProfileClick(Sender: TObject);
-    procedure btnOKClick(Sender: TObject);
-    procedure btnSaveProfileClick(Sender: TObject);
-    procedure cbProfileChange(Sender: TObject);
-    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
-    procedure FormCreate(Sender: TObject);
-  protected
-    FProfilePath: string;
-  public
-    { public declarations }
-  end; 
-
-var
-  frmLogin: TfrmLogin;
-
-implementation
-
-uses
-  UdmNetwork;
-  
-{$I version.inc}
-
-{ TfrmLogin }
-
-procedure TfrmLogin.btnCancelClick(Sender: TObject);
-begin
-  Close;
-end;
-
-procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
-begin
-  if cbProfile.ItemIndex > -1 then
-  begin
-    DeleteFile(FProfilePath + cbProfile.Text + '.ini');
-    cbProfile.Items.Delete(cbProfile.ItemIndex);
-  end;
-end;
-
-procedure TfrmLogin.btnOKClick(Sender: TObject);
-var
-  path: string;
-begin
-  path := IncludeTrailingPathDelimiter(edData.Text);
-  if (not FileExists(path + 'art.mul')) or
-     (not FileExists(path + 'artidx.mul')) or
-     (not FileExists(path + 'hues.mul')) or
-     (not FileExists(path + 'tiledata.mul')) or
-     (not FileExists(path + 'animdata.mul')) or
-     (not FileExists(path + 'texmaps.mul')) or
-     (not FileExists(path + 'texidx.mul')) or
-     (not FileExists(path + 'light.mul')) or
-     (not FileExists(path + 'lightidx.mul')) then
-  begin
-    MessageDlg('Incorrect directory', 'The data path you specified does not '
-      + 'seem to be correct.', mtWarning, [mbOK], 0);
-    edData.SetFocus;
-  end else
-    ModalResult := mrOK;
-end;
-
-procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
-var
-  profileName: string;
-  profile: TIniFile;
-begin
-  profileName := cbProfile.Text;
-  if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then
-  begin
-    profile := TIniFile.Create(FProfilePath + profileName + '.ini');
-    profile.WriteString('Connection', 'Host', edHost.Text);
-    profile.WriteInteger('Connection', 'Port', edPort.Value);
-    profile.WriteString('Connection', 'Username', edUsername.Text);
-    profile.WriteString('Data', 'Path', edData.Text);
-    profile.Free;
-    cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
-    if cbProfile.ItemIndex = -1 then
-    begin
-      cbProfile.Items.Add(profileName);
-      cbProfile.ItemIndex := cbProfile.Items.Count - 1;
-    end;
-  end;
-end;
-
-procedure TfrmLogin.cbProfileChange(Sender: TObject);
-var
-  profile: TIniFile;
-begin
-  if cbProfile.ItemIndex > -1 then
-  begin
-    profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini');
-    edHost.Text := profile.ReadString('Connection', 'Host', '');
-    edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
-    edUsername.Text := profile.ReadString('Connection', 'Username', '');
-    edPassword.Text := '';
-    edData.Text := profile.ReadString('Data', 'Path', '');
-    edPassword.SetFocus;
-    profile.Free;
-  end;
-end;
-
-procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
-begin
-  if ModalResult <> mrOK then
-    dmNetwork.CheckClose(Self);
-end;
-
-procedure TfrmLogin.FormCreate(Sender: TObject);
-var
-  searchRec: TSearchRec;
-begin
-  lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s',
-    [ProductVersion, Copyright]);
-
-  FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim;
-  ForceDirectories(FProfilePath);
-  if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then
-  begin
-    repeat
-      cbProfile.Items.Add(ChangeFileExt(searchRec.Name, ''));
-    until FindNext(searchRec) <> 0;
-  end;
-  FindClose(searchRec);
-end;
-
-initialization
-  {$I UfrmLogin.lrs}
-
-end.
-
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UfrmLogin;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ExtCtrls, Spin, EditBtn, Buttons, IniFiles;
+
+type
+
+  { TfrmLogin }
+
+  TfrmLogin = class(TForm)
+    btnOK: TButton;
+    btnCancel: TButton;
+    cbProfile: TComboBox;
+    edData: TDirectoryEdit;
+    edHost: TEdit;
+    edUsername: TEdit;
+    edPassword: TEdit;
+    gbConnection: TGroupBox;
+    gbData: TGroupBox;
+    gbActions: TGroupBox;
+    gbProfiles: TGroupBox;
+    imgHost: TImage;
+    imgUsername: TImage;
+    imgPassword: TImage;
+    lblCopyright: TLabel;
+    lblHost: TLabel;
+    lblUsername: TLabel;
+    lblPassword: TLabel;
+    edPort: TSpinEdit;
+    lblData: TLabel;
+    btnSaveProfile: TSpeedButton;
+    btnDeleteProfile: TSpeedButton;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnDeleteProfileClick(Sender: TObject);
+    procedure btnOKClick(Sender: TObject);
+    procedure btnSaveProfileClick(Sender: TObject);
+    procedure cbProfileChange(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+  protected
+    FProfilePath: string;
+  public
+    { public declarations }
+  end; 
+
+var
+  frmLogin: TfrmLogin;
+
+implementation
+
+uses
+  UdmNetwork, vinfo;
+
+{ TfrmLogin }
+
+procedure TfrmLogin.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
+begin
+  if cbProfile.ItemIndex > -1 then
+  begin
+    DeleteFile(FProfilePath + cbProfile.Text + '.ini');
+    cbProfile.Items.Delete(cbProfile.ItemIndex);
+  end;
+end;
+
+procedure TfrmLogin.btnOKClick(Sender: TObject);
+var
+  path: string;
+begin
+  path := IncludeTrailingPathDelimiter(edData.Text);
+  if (not FileExists(path + 'art.mul')) or
+     (not FileExists(path + 'artidx.mul')) or
+     (not FileExists(path + 'hues.mul')) or
+     (not FileExists(path + 'tiledata.mul')) or
+     (not FileExists(path + 'animdata.mul')) or
+     (not FileExists(path + 'texmaps.mul')) or
+     (not FileExists(path + 'texidx.mul')) or
+     (not FileExists(path + 'light.mul')) or
+     (not FileExists(path + 'lightidx.mul')) then
+  begin
+    MessageDlg('Incorrect directory', 'The data path you specified does not '
+      + 'seem to be correct.', mtWarning, [mbOK], 0);
+    edData.SetFocus;
+  end else
+    ModalResult := mrOK;
+end;
+
+procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
+var
+  profileName: string;
+  profile: TIniFile;
+begin
+  profileName := cbProfile.Text;
+  if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then
+  begin
+    profile := TIniFile.Create(FProfilePath + profileName + '.ini');
+    profile.WriteString('Connection', 'Host', edHost.Text);
+    profile.WriteInteger('Connection', 'Port', edPort.Value);
+    profile.WriteString('Connection', 'Username', edUsername.Text);
+    profile.WriteString('Data', 'Path', edData.Text);
+    profile.Free;
+    cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
+    if cbProfile.ItemIndex = -1 then
+    begin
+      cbProfile.Items.Add(profileName);
+      cbProfile.ItemIndex := cbProfile.Items.Count - 1;
+    end;
+  end;
+end;
+
+procedure TfrmLogin.cbProfileChange(Sender: TObject);
+var
+  profile: TIniFile;
+begin
+  if cbProfile.ItemIndex > -1 then
+  begin
+    profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini');
+    edHost.Text := profile.ReadString('Connection', 'Host', '');
+    edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
+    edUsername.Text := profile.ReadString('Connection', 'Username', '');
+    edPassword.Text := '';
+    edData.Text := profile.ReadString('Data', 'Path', '');
+    edPassword.SetFocus;
+    profile.Free;
+  end;
+end;
+
+procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  if ModalResult <> mrOK then
+    dmNetwork.CheckClose(Self);
+end;
+
+procedure TfrmLogin.FormCreate(Sender: TObject);
+var
+  searchRec: TSearchRec;
+begin
+  lblCopyright.Caption := Format('UO CentrED Client Version %s %s',
+    [VersionInfo.GetProductVersionString, VersionInfo.GetCopyright]);
+
+  FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim;
+  ForceDirectories(FProfilePath);
+  if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then
+  begin
+    repeat
+      cbProfile.Items.Add(ChangeFileExt(searchRec.Name, ''));
+    until FindNext(searchRec) <> 0;
+  end;
+  FindClose(searchRec);
+end;
+
+initialization
+  {$I UfrmLogin.lrs}
+
+end.
+

Client/UfrmRadar.lfm

@@ -1,59 +1,63 @@
 object frmRadarMap: TfrmRadarMap
   Left = 290
-  Height = 360
+  Height = 562
   Top = 171
-  Width = 479
+  Width = 749
   HorzScrollBar.Page = 478
   VertScrollBar.Page = 359
   ActiveControl = sbMain
   Caption = 'Radar Map (1:8)'
-  ClientHeight = 360
-  ClientWidth = 479
+  ClientHeight = 562
+  ClientWidth = 749
+  DesignTimePPI = 120
   OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnResize = FormResize
   Position = poOwnerFormCenter
   ShowInTaskBar = stAlways
-  LCLVersion = '0.9.29'
+  LCLVersion = '2.3.0.0'
   object pnlBottom: TPanel
     Left = 0
-    Height = 21
-    Top = 339
-    Width = 479
+    Height = 32
+    Top = 418
+    Width = 599
     Align = alBottom
     BevelOuter = bvNone
-    ClientHeight = 21
-    ClientWidth = 479
+    ClientHeight = 32
+    ClientWidth = 599
     TabOrder = 0
     object lblPosition: TLabel
-      Left = 8
-      Height = 21
+      Left = 10
+      Height = 26
       Top = 0
-      Width = 41
+      Width = 1
       Align = alLeft
-      BorderSpacing.Left = 8
+      BorderSpacing.Left = 12
+      Color = clDefault
       Layout = tlCenter
       ParentColor = False
     end
   end
   object sbMain: TScrollBox
     Left = 0
-    Height = 339
+    Height = 424
     Top = 0
-    Width = 479
+    Width = 599
+    HorzScrollBar.Page = 365
+    VertScrollBar.Page = 252
     Align = alClient
-    ClientHeight = 335
-    ClientWidth = 475
+    ClientHeight = 422
+    ClientWidth = 597
     TabOrder = 1
     object pbRadar: TPaintBox
       Left = 0
-      Height = 202
+      Height = 315
       Top = 0
-      Width = 292
+      Width = 456
       OnMouseDown = pbRadarMouseDown
-      OnMouseMove = pbRadarMouseMove
       OnMouseLeave = pbRadarMouseLeave
+      OnMouseMove = pbRadarMouseMove
       OnPaint = pbRadarPaint
     end
   end

Client/UfrmRadar.pas

@@ -113,7 +113,7 @@ begin
   SetLength(radarMap, FRadar.Width * FRadar.Height);
   for x := 0 to FRadar.Width - 1 do
     for y := 0 to FRadar.Height - 1 do
-      radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointers[x, y])^);
+      radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointer[x, y])^);
 
   radarMapFile := TFileStream.Create(GetAppConfigDir(False) + 'RadarMap.cache',
     fmCreate);
@@ -213,7 +213,7 @@ begin
       begin
         x := ABuffer.ReadWord;
         y := ABuffer.ReadWord;
-        PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ABuffer.ReadWord);
+        PInteger(FRadar.PixelPointer[x, y])^ := DecodeUOColor(ABuffer.ReadWord);
         RepaintRadar;
       end;
   end;
@@ -225,7 +225,7 @@ var
 begin
   for x := 0 to FRadar.Width - 1 do
     for y := 0 to FRadar.Height - 1 do
-      PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ARadarMap[x * FRadar.Height + y]);
+      PInteger(FRadar.PixelPointer[x, y])^ := DecodeUOColor(ARadarMap[x * FRadar.Height + y]);
   RepaintRadar;
 end;
 

Dockerfile.builder

@@ -0,0 +1,36 @@
+FROM ubuntu:jammy
+
+RUN apt update && \
+	apt install -y libgtk2.0-dev libgl-dev binutils-mingw-w64-i686 git wget zip && \
+	rm -rf /var/lib/apt/lists/* && \
+	ln -s /usr/bin/i686-w64-mingw32-windres /usr/bin/i386-win32-windres && \
+	ln -s /usr/bin/i686-w64-mingw32-windres /usr/bin/windres
+
+RUN cd /root && \
+	export FPCVERSION=3.2.2 && \
+	export LAZVERSION=2.2.4 && \
+	wget --content-disposition https://sourceforge.net/projects/freepascal/files/Linux/$FPCVERSION/fpc-$FPCVERSION.x86_64-linux.tar/download && \
+	wget --content-disposition https://sourceforge.net/projects/freepascal/files/Source/$FPCVERSION/fpc-$FPCVERSION.source.tar.gz/download && \
+	tar xf fpc-$FPCVERSION.x86_64-linux.tar && \
+	cd fpc-$FPCVERSION.x86_64-linux && \
+	echo "/usr" | ./install.sh && \
+	cd .. && \
+	tar xf fpc-$FPCVERSION.source.tar.gz && \
+	cd fpc-$FPCVERSION && \
+	make crossinstall INSTALL_PREFIX=/usr OS_TARGET=win32 CPU_TARGET=i386 && \
+	make clean && \
+	ln -s /usr/lib/fpc/$FPCVERSION/ppcross386 /usr/bin/ppcross386 && \
+	cd .. && \
+	wget --content-disposition https://sourceforge.net/projects/lazarus/files/Lazarus%20Zip%20_%20GZip/Lazarus%20$LAZVERSION/lazarus-$LAZVERSION-0.tar.gz/download && \
+	tar xf lazarus-$LAZVERSION-0.tar.gz && \
+	cd lazarus && \
+	make lazbuild && \
+	cd /root && \
+	rm -rf *.tar.gz fpc-$FPCVERSION*
+
+RUN cd /root && \
+	git clone --depth 1 https://github.com/blikblum/multilog && \
+	git clone --depth 1 https://github.com/almindor/lnet && \
+	~/lazarus/lazbuild --lazarusdir=~/lazarus --add-package-link ~/multilog/multiloglaz.lpk && \
+	~/lazarus/lazbuild --lazarusdir=~/lazarus --add-package-link ~/lnet/lazaruspackage/lnetbase.lpk && \
+	~/lazarus/lazbuild --lazarusdir=~/lazarus --add-package-link ~/lnet/lazaruspackage/lnetvisual.lpk

Imaging/ImagingColors.pas

@@ -1,245 +1,230 @@
-{
-  $Id: ImagingColors.pas 173 2009-09-04 17:05:52Z galfar $
-  Vampyre Imaging Library
-  by Marek Mauder 
-  http://imaginglib.sourceforge.net
-
-  The contents of this file are used with permission, subject to the Mozilla
-  Public License Version 1.1 (the "License"); you may not use this file except
-  in compliance with the License. You may obtain a copy of the License at
-  http://www.mozilla.org/MPL/MPL-1.1.html
-
-  Software distributed under the License is distributed on an "AS IS" basis,
-  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
-  the specific language governing rights and limitations under the License.
-
-  Alternatively, the contents of this file may be used under the terms of the
-  GNU Lesser General Public License (the  "LGPL License"), in which case the
-  provisions of the LGPL License are applicable instead of those above.
-  If you wish to allow use of your version of this file only under the terms
-  of the LGPL License and not to allow others to use your version of this file
-  under the MPL, indicate your decision by deleting  the provisions above and
-  replace  them with the notice and other provisions required by the LGPL
-  License.  If you do not delete the provisions above, a recipient may use
-  your version of this file under either the MPL or the LGPL License.
-
-  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
-}
-
-{ This unit contains functions for manipulating and converting color values.}
-unit ImagingColors;
-
-interface
-
-{$I ImagingOptions.inc}
-
-uses
-  SysUtils, ImagingTypes, ImagingUtility;
-
-{ Converts RGB color to YUV.}
-procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
-{ Converts YIV to RGB color.}
-procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
-
-{ Converts RGB color to YCbCr as used in JPEG.}
-procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
-{ Converts YCbCr as used in JPEG to RGB color.}
-procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
-{ Converts RGB color to YCbCr as used in JPEG.}
-procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
-{ Converts YCbCr as used in JPEG to RGB color.}
-procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
-
-{ Converts RGB color to CMY.}
-procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
-{ Converts CMY to RGB color.}
-procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
-{ Converts RGB color to CMY.}
-procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
-{ Converts CMY to RGB color.}
-procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
-
-{ Converts RGB color to CMYK.}
-procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
-{ Converts CMYK to RGB color.}
-procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
-{ Converts RGB color to CMYK.}
-procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
-{ Converts CMYK to RGB color.}
-procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
-
-{ Converts RGB color to YCoCg.}
-procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
-{ Converts YCoCg to RGB color.}
-procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
-
-
-implementation
-
-procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
-begin
-  Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
-  V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
-  U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
-end;
-
-procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
-var
-  CY, CU, CV: LongInt;
-begin
-  CY := Y - 16;
-  CU := U - 128;
-  CV := V - 128;
-  R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
-  G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
-  B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
-end;
-
-procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
-begin
-  Y  := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
-  Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 128));
-  Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 128));
-end;
-
-procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
-begin
-  R := ClampToByte(Round(Y                        + 1.40200 * (Cr - 128)));
-  G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
-  B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
-end;
-
-procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
-begin
-  Y  := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
-  Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 32768));
-  Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 32768));
-end;
-
-procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
-begin
-  R := ClampToWord(Round(Y                          + 1.40200 * (Cr - 32768)));
-  G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
-  B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
-end;
-
-procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
-begin
-  C := 255 - R;
-  M := 255 - G;
-  Y := 255 - B;
-end;
-
-procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
-begin
-  R := 255 - C;
-  G := 255 - M;
-  B := 255 - Y;
-end;
-
-procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
-begin
-  C := 65535 - R;
-  M := 65535 - G;
-  Y := 65535 - B;
-end;
-
-procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
-begin
-  R := 65535 - C;
-  G := 65535 - M;
-  B := 65535 - Y;
-end;
-
-procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
-begin
-  RGBToCMY(R, G, B, C, M, Y);
-  K := Min(C, Min(M, Y));
-  if K = 255 then
-  begin
-    C := 0;
-    M := 0;
-    Y := 0;
-  end
-  else
-  begin
-    C := ClampToByte(Round((C - K) / (255 - K) * 255));
-    M := ClampToByte(Round((M - K) / (255 - K) * 255));
-    Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
-  end;
-end;
-
-procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
-begin
-   R := (255 - (C - MulDiv(C, K, 255) + K));
-   G := (255 - (M - MulDiv(M, K, 255) + K));
-   B := (255 - (Y - MulDiv(Y, K, 255) + K));
-end;
-
-procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
-begin
-  RGBToCMY16(R, G, B, C, M, Y);
-  K := Min(C, Min(M, Y));
-  if K = 65535 then
-  begin
-    C := 0;
-    M := 0;
-    Y := 0;
-  end
-  else
-  begin
-    C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
-    M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
-    Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
-  end;
-end;
-
-procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
-begin
-  R := 65535 - (C - MulDiv(C, K, 65535) + K);
-  G := 65535 - (M - MulDiv(M, K, 65535) + K);
-  B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
-end;
-
-procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
-begin
-  // C and Delphi's SHR behaviour differs for negative numbers, use div instead.
-  Y  := ClampToByte(( R +     G shl 1 + B       + 2) div 4);
-  Co := ClampToByte(( R shl 1         - B shl 1 + 2) div 4 + 128);
-  Cg := ClampToByte((-R +     G shl 1 - B       + 2) div 4 + 128);
-end;
-
-procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
-var
-  CoInt, CgInt: Integer;
-begin
-  CoInt := Co - 128;
-  CgInt := Cg - 128;
-  R := ClampToByte(Y + CoInt - CgInt);
-  G := ClampToByte(Y + CgInt);
-  B := ClampToByte(Y - CoInt - CgInt);
-end;
-
-{
-  File Notes:
-
-  -- TODOS ----------------------------------------------------
-    - nothing now
-
-  -- 0.26.3 Changes/Bug Fixes ---------------------------------
-    - Added RGB<>YCoCg conversion functions.
-    - Fixed RGB>>CMYK conversions.
-
-  -- 0.23 Changes/Bug Fixes -----------------------------------
-    - Added RGB<>CMY(K) converion functions for 16 bit channels
-      (needed by PSD loading code).
-
-  -- 0.21 Changes/Bug Fixes -----------------------------------
-    - Added some color space conversion functions and LUTs
-      (RGB/YUV/YCrCb/CMY/CMYK).
-
-  -- 0.17 Changes/Bug Fixes -----------------------------------
-    - unit created (empty!)
-}
-
-end.
+{
+  Vampyre Imaging Library
+  by Marek Mauder
+  https://github.com/galfar/imaginglib
+  https://imaginglib.sourceforge.io
+  - - - - -
+  This Source Code Form is subject to the terms of the Mozilla Public
+  License, v. 2.0. If a copy of the MPL was not distributed with this
+  file, You can obtain one at https://mozilla.org/MPL/2.0.
+} 
+
+{ This unit contains functions for manipulating and converting color values.}
+unit ImagingColors;
+
+interface
+
+{$I ImagingOptions.inc}
+
+uses
+  SysUtils, ImagingTypes, ImagingUtility;
+
+{ Converts RGB color to YUV.}
+procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
+{ Converts YIV to RGB color.}
+procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
+
+{ Converts RGB color to YCbCr as used in JPEG.}
+procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
+{ Converts YCbCr as used in JPEG to RGB color.}
+procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
+{ Converts RGB color to YCbCr as used in JPEG.}
+procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
+{ Converts YCbCr as used in JPEG to RGB color.}
+procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
+
+{ Converts RGB color to CMY.}
+procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
+{ Converts CMY to RGB color.}
+procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
+{ Converts RGB color to CMY.}
+procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
+{ Converts CMY to RGB color.}
+procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
+
+{ Converts RGB color to CMYK.}
+procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
+{ Converts CMYK to RGB color.}
+procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
+{ Converts RGB color to CMYK.}
+procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
+{ Converts CMYK to RGB color.}
+procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
+
+{ Converts RGB color to YCoCg.}
+procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
+{ Converts YCoCg to RGB color.}
+procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
+
+//procedure RGBToHSL(R, G, B: Byte; var H, S, L: Byte);
+//procedure HSLToRGB(H, S, L: Byte; var R, G, B: Byte);
+
+implementation
+
+procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
+begin
+  Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
+  V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
+  U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
+end;
+
+procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
+var
+  CY, CU, CV: LongInt;
+begin
+  CY := Y - 16;
+  CU := U - 128;
+  CV := V - 128;
+  R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
+  G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
+  B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
+end;
+
+procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
+begin
+  Y  := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
+  Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 128));
+  Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 128));
+end;
+
+procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
+begin
+  R := ClampToByte(Round(Y                        + 1.40200 * (Cr - 128)));
+  G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
+  B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
+end;
+
+procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
+begin
+  Y  := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
+  Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 32768));
+  Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 32768));
+end;
+
+procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
+begin
+  R := ClampToWord(Round(Y                          + 1.40200 * (Cr - 32768)));
+  G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
+  B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
+end;
+
+procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
+begin
+  C := 255 - R;
+  M := 255 - G;
+  Y := 255 - B;
+end;
+
+procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
+begin
+  R := 255 - C;
+  G := 255 - M;
+  B := 255 - Y;
+end;
+
+procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
+begin
+  C := 65535 - R;
+  M := 65535 - G;
+  Y := 65535 - B;
+end;
+
+procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
+begin
+  R := 65535 - C;
+  G := 65535 - M;
+  B := 65535 - Y;
+end;
+
+procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
+begin
+  RGBToCMY(R, G, B, C, M, Y);
+  K := Min(C, Min(M, Y));
+  if K = 255 then
+  begin
+    C := 0;
+    M := 0;
+    Y := 0;
+  end
+  else
+  begin
+    C := ClampToByte(Round((C - K) / (255 - K) * 255));
+    M := ClampToByte(Round((M - K) / (255 - K) * 255));
+    Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
+  end;
+end;
+
+procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
+begin
+   R := (255 - (C - MulDiv(C, K, 255) + K));
+   G := (255 - (M - MulDiv(M, K, 255) + K));
+   B := (255 - (Y - MulDiv(Y, K, 255) + K));
+end;
+
+procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
+begin
+  RGBToCMY16(R, G, B, C, M, Y);
+  K := Min(C, Min(M, Y));
+  if K = 65535 then
+  begin
+    C := 0;
+    M := 0;
+    Y := 0;
+  end
+  else
+  begin
+    C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
+    M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
+    Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
+  end;
+end;
+
+procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
+begin
+  R := 65535 - (C - MulDiv(C, K, 65535) + K);
+  G := 65535 - (M - MulDiv(M, K, 65535) + K);
+  B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
+end;
+
+procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
+begin
+  // C and Delphi's SHR behaviour differs for negative numbers, use div instead.
+  Y  := ClampToByte(( R +     G shl 1 + B       + 2) div 4);
+  Co := ClampToByte(( R shl 1         - B shl 1 + 2) div 4 + 128);
+  Cg := ClampToByte((-R +     G shl 1 - B       + 2) div 4 + 128);
+end;
+
+procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
+var
+  CoInt, CgInt: Integer;
+begin
+  CoInt := Co - 128;
+  CgInt := Cg - 128;
+  R := ClampToByte(Y + CoInt - CgInt);
+  G := ClampToByte(Y + CgInt);
+  B := ClampToByte(Y - CoInt - CgInt);
+end;
+
+{
+  File Notes:
+
+  -- TODOS ----------------------------------------------------
+    - nothing now
+
+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Added RGB<>YCoCg conversion functions.
+    - Fixed RGB>>CMYK conversions.
+
+  -- 0.23 Changes/Bug Fixes -----------------------------------
+    - Added RGB<>CMY(K) conversion functions for 16 bit channels
+      (needed by PSD loading code).
+
+  -- 0.21 Changes/Bug Fixes -----------------------------------
+    - Added some color space conversion functions and LUTs
+      (RGB/YUV/YCrCb/CMY/CMYK).
+
+  -- 0.17 Changes/Bug Fixes -----------------------------------
+    - unit created (empty!)
+}
+
+end.

Imaging/ImagingExport.pas

@@ -1,891 +0,0 @@
-{
-  $Id: ImagingExport.pas 173 2009-09-04 17:05:52Z galfar $
-  Vampyre Imaging Library
-  by Marek Mauder
-  http://imaginglib.sourceforge.net
-
-  The contents of this file are used with permission, subject to the Mozilla
-  Public License Version 1.1 (the "License"); you may not use this file except
-  in compliance with the License. You may obtain a copy of the License at
-  http://www.mozilla.org/MPL/MPL-1.1.html
-
-  Software distributed under the License is distributed on an "AS IS" basis,
-  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
-  the specific language governing rights and limitations under the License.
-
-  Alternatively, the contents of this file may be used under the terms of the
-  GNU Lesser General Public License (the  "LGPL License"), in which case the
-  provisions of the LGPL License are applicable instead of those above.
-  If you wish to allow use of your version of this file only under the terms
-  of the LGPL License and not to allow others to use your version of this file
-  under the MPL, indicate your decision by deleting  the provisions above and
-  replace  them with the notice and other provisions required by the LGPL
-  License.  If you do not delete the provisions above, a recipient may use
-  your version of this file under either the MPL or the LGPL License.
-
-  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
-}
-
-{ This function contains functions exported from Imaging dynamic link library.
-  All string are exported as PChars and all var parameters are exported
-  as pointers. All posible exceptions getting out of dll are catched.}
-unit ImagingExport;
-
-{$I ImagingOptions.inc}
-
-interface
-
-uses
-  ImagingTypes, 
-  Imaging;
-
-{ Returns version of Imaging library. }
-procedure ImGetVersion(var Major, Minor, Patch: LongInt); cdecl;
-{ Look at InitImage for details.}
-procedure ImInitImage(var Image: TImageData); cdecl;
-{ Look at NewImage for details.}
-function ImNewImage(Width, Height: LongInt; Format: TImageFormat;
-  var Image: TImageData): Boolean; cdecl;
-{ Look at TestImage for details.}
-function ImTestImage(var Image: TImageData): Boolean; cdecl;
-{ Look at FreeImage for details.}
-function ImFreeImage(var Image: TImageData): Boolean; cdecl;
-{ Look at DetermineFileFormat for details. Ext should have enough space for
-  result file extension.}
-function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; cdecl;
-{ Look at DetermineMemoryFormat for details. Ext should have enough space for
-  result file extension.}
-function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; cdecl;
-{ Look at IsFileFormatSupported for details.}
-function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; cdecl;
-{ Look at EnumFileFormats for details.}
-function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
-  var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl;
-
-{ Inits image list.}
-function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; cdecl;
-{ Returns size of image list.}
-function ImGetImageListSize(ImageList: TImageDataList): LongInt; cdecl;
-{ Returns image list's element at given index. Output image is not cloned it's
-  Bits point to Bits in list => do not free OutImage.}
-function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt;
-  var OutImage: TImageData): Boolean; cdecl;
-{ Sets size of image list.}
-function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): Boolean; cdecl;
-{ Sets image list element at given index. Input image is not cloned - image in
-  list will point to InImage's Bits.}
-function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt;
-  const InImage: TImageData): Boolean; cdecl;
-{ Returns True if all images in list pass ImTestImage test. }
-function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl;
-{ Frees image list and all images in it.}
-function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl;
-
-{ Look at LoadImageFromFile for details.}
-function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; cdecl;
-{ Look at LoadImageFromMemory for details.}
-function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl;
-{ Look at LoadMultiImageFromFile for details.}
-function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): Boolean; cdecl;
-{ Look at LoadMultiImageFromMemory for details.}
-function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
-  var ImageList: TImageDataList): Boolean; cdecl;
-
-{ Look at SaveImageToFile for details.}
-function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; cdecl;
-{ Look at SaveImageToMemory for details.}
-function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
-  const Image: TImageData): Boolean; cdecl;
-{ Look at SaveMultiImageToFile for details.}
-function ImSaveMultiImageToFile(FileName: PAnsiChar; ImageList: TImageDataList): Boolean; cdecl;
-{ Look at SaveMultiImageToMemory for details.}
-function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
-  ImageList: TImageDataList): Boolean; cdecl;
-
-{ Look at CloneImage for details.}
-function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; cdecl;
-{ Look at ConvertImage for details.}
-function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; cdecl;
-{ Look at FlipImage for details.}
-function ImFlipImage(var Image: TImageData): Boolean; cdecl;
-{ Look at MirrorImage for details.}
-function ImMirrorImage(var Image: TImageData): Boolean; cdecl;
-{ Look at ResizeImage for details.}
-function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;
-  Filter: TResizeFilter): Boolean; cdecl;
-{ Look at SwapChannels for details.}
-function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; cdecl;
-{ Look at ReduceColors for details.}
-function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; cdecl;
-{ Look at GenerateMipMaps for details.}
-function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt;
-  var MipMaps: TImageDataList): Boolean; cdecl;
-{ Look at MapImageToPalette for details.}
-function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32;
-  Entries: LongInt): Boolean; cdecl;
-{ Look at SplitImage for details.}
-function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
-  ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;
-  PreserveSize: Boolean; Fill: Pointer): Boolean; cdecl;
-{ Look at MakePaletteForImages for details.}
-function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
-  MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl;
-{ Look at RotateImage for details.}
-function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; cdecl;
-
-{ Look at CopyRect for details.}
-function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
-  var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl;
-{ Look at FillRect for details.}
-function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt;
-  Fill: Pointer): Boolean; cdecl;
-{ Look at ReplaceColor for details.}
-function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;
-  OldPixel, NewPixel: Pointer): Boolean; cdecl;
-{ Look at StretchRect for details.}
-function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
-  SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
-  DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl;
-{ Look at GetPixelDirect for details.}
-procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl;
-{ Look at SetPixelDirect for details.}
-procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl;
-{ Look at GetPixel32 for details.}
-function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl;
-{ Look at SetPixel32 for details.}
-procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); cdecl;
-{ Look at GetPixelFP for details.}
-function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl;
-{ Look at SetPixelFP for details.}
-procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); cdecl;
-
-{ Look at NewPalette for details.}
-function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean; cdecl;
-{ Look at FreePalette for details.}
-function ImFreePalette(var Pal: PPalette32): Boolean; cdecl;
-{ Look at CopyPalette for details.}
-function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; cdecl;
-{ Look at FindColor for details.}
-function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; cdecl;
-{ Look at FillGrayscalePalette for details.}
-function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean; cdecl;
-{ Look at FillCustomPalette for details.}
-function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,
-  BBits: Byte; Alpha: Byte): Boolean; cdecl;
-{ Look at SwapChannelsOfPalette for details.}
-function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,
-  DstChannel: LongInt): Boolean; cdecl;
-
-{ Look at SetOption for details.}
-function ImSetOption(OptionId, Value: LongInt): Boolean; cdecl;
-{ Look at GetOption for details.}
-function ImGetOption(OptionId: LongInt): LongInt; cdecl;
-{ Look at PushOptions for details.}
-function ImPushOptions: Boolean; cdecl;
-{ Look at PopOptions for details.}
-function ImPopOptions: Boolean; cdecl;
-
-{ Look at GetImageFormatInfo for details.}
-function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; cdecl;
-{ Look at GetPixelsSize for details.}
-function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; cdecl;
-
-{ Look at SetUserFileIO for details.}
-procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:
-  TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc;
-  TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); cdecl;
-{ Look at ResetFileIO for details.}
-procedure ImResetFileIO; cdecl;
-
-{ These are only for documentation generation reasons.}
-{ Loads Imaging functions from dll/so library.}
-function ImLoadLibrary: Boolean;
-{ Frees Imaging functions loaded from dll/so and releases library.}
-function ImFreeLibrary: Boolean;
-
-implementation
-
-uses
-  SysUtils,
-  ImagingUtility;
-
-function ImLoadLibrary: Boolean; begin Result := True; end;
-function ImFreeLibrary: Boolean; begin Result := True; end;
-
-type
-  TInternalList = record
-    List: TDynImageDataArray;
-  end;
-  PInternalList = ^TInternalList;
-
-procedure ImGetVersion(var Major, Minor, Patch: LongInt);
-begin
-  Major := ImagingVersionMajor;
-  Minor := ImagingVersionMinor;
-  Patch := ImagingVersionPatch;
-end;
-
-procedure ImInitImage(var Image: TImageData);
-begin
-  try
-    Imaging.InitImage(Image);
-  except
-  end;
-end;
-
-function ImNewImage(Width, Height: LongInt; Format: TImageFormat;
-  var Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.NewImage(Width, Height, Format, Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImTestImage(var Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.TestImage(Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImFreeImage(var Image: TImageData): Boolean;
-begin
-  try
-    Imaging.FreeImage(Image);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean;
-var
-  S: string;
-begin
-  try
-    S := Imaging.DetermineFileFormat(FileName);
-    Result := S <> '';
-    StrCopy(Ext, PAnsiChar(AnsiString(S)));
-  except
-    Result := False;
-  end;
-end;
-
-function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean;
-var
-  S: string;
-begin
-  try
-    S := Imaging.DetermineMemoryFormat(Data, Size);
-    Result := S <> '';
-    StrCopy(Ext, PAnsiChar(AnsiString(S)));
-  except
-    Result := False;
-  end;
-end;
-
-function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean;
-begin
-  try
-    Result := Imaging.IsFileFormatSupported(FileName);
-  except
-    Result := False;
-  end;
-end;
-
-function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
-  var CanSave, IsMultiImageFormat: Boolean): Boolean;
-var
-  StrName, StrDefaultExt, StrMasks: string;
-begin
-  try
-    Result := Imaging.EnumFileFormats(Index, StrName, StrDefaultExt, StrMasks, CanSave,
-      IsMultiImageFormat);
-    StrCopy(Name, PAnsiChar(AnsiString(StrName)));
-    StrCopy(DefaultExt, PAnsiChar(AnsiString(StrDefaultExt)));
-    StrCopy(Masks, PAnsiChar(AnsiString(StrMasks)));
-  except
-    Result := False;
-  end;
-end;
-
-function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean;
-var
-  Int: PInternalList;
-begin
-  try
-    try
-      ImFreeImageList(ImageList);
-    except
-    end;
-    New(Int);
-    SetLength(Int.List, Size);
-    ImageList := TImageDataList(Int);
-    Result := True;
-  except
-    Result := False;
-    ImageList := nil;
-  end;
-end;
-
-function ImGetImageListSize(ImageList: TImageDataList): LongInt;
-begin
-  try
-    Result := Length(PInternalList(ImageList).List);
-  except
-    Result := -1;
-  end;
-end;
-
-function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt;
-  var OutImage: TImageData): Boolean;
-begin
-  try
-    Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1);
-    ImCloneImage(PInternalList(ImageList).List[Index], OutImage);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt):
-  Boolean;
-var
-  I, OldSize: LongInt;
-begin
-  try
-    OldSize := Length(PInternalList(ImageList).List);
-    if NewSize < OldSize then
-      for I := NewSize to OldSize - 1 do
-        Imaging.FreeImage(PInternalList(ImageList).List[I]);
-    SetLength(PInternalList(ImageList).List, NewSize);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt;
-  const InImage: TImageData): Boolean;
-begin
-  try
-    Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1);
-    ImCloneImage(InImage, PInternalList(ImageList).List[Index]);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImTestImagesInList(ImageList: TImageDataList): Boolean;
-var
-  I: LongInt;
-  Arr: TDynImageDataArray;
-begin
-  Arr := nil;
-  try
-    Arr := PInternalList(ImageList).List;
-    Result := True;
-    for I := 0 to Length(Arr) - 1 do
-    begin
-      Result := Result and Imaging.TestImage(Arr[I]);
-      if not Result then Break;
-    end;
-  except
-    Result := False;
-  end;
-end;
-
-function ImFreeImageList(var ImageList: TImageDataList): Boolean;
-var
-  Int: PInternalList;
-begin
-  try
-    if ImageList <> nil then
-    begin
-      Int := PInternalList(ImageList);
-      FreeImagesInArray(Int.List);
-      Dispose(Int);
-      ImageList := nil;
-    end;
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.LoadImageFromFile(FileName, Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.LoadImageFromMemory(Data, Size, Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList):
-  Boolean;
-begin
-  try
-    ImInitImageList(0, ImageList);
-    Result := Imaging.LoadMultiImageFromFile(FileName,
-      PInternalList(ImageList).List);
-  except
-    Result := False;
-  end;
-end;
-
-function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
-  var ImageList: TImageDataList): Boolean;
-begin
-  try
-    ImInitImageList(0, ImageList);
-    Result := Imaging.LoadMultiImageFromMemory(Data, Size, PInternalList(ImageList).List);
-  except
-    Result := False;
-  end;
-end;
-
-function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.SaveImageToFile(FileName, Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
-  const Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.SaveImageToMemory(Ext, Data, Size, Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImSaveMultiImageToFile(FileName: PAnsiChar;
-  ImageList: TImageDataList): Boolean;
-begin
-  try
-    Result := Imaging.SaveMultiImageToFile(FileName,
-      PInternalList(ImageList).List);
-  except
-    Result := False;
-  end;
-end;
-
-function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
-  ImageList: TImageDataList): Boolean;
-begin
-  try
-    Result := Imaging.SaveMultiImageToMemory(Ext, Data, Size^,
-      PInternalList(ImageList).List);
-  except
-    Result := False;
-  end;
-end;
-
-function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.CloneImage(Image, Clone);
-  except
-    Result := False;
-  end;
-end;
-
-function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean;
-begin
-  try
-    Result := Imaging.ConvertImage(Image, DestFormat);
-  except
-    Result := False;
-  end;
-end;
-
-function ImFlipImage(var Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.FlipImage(Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImMirrorImage(var Image: TImageData): Boolean;
-begin
-  try
-    Result := Imaging.MirrorImage(Image);
-  except
-    Result := False;
-  end;
-end;
-
-function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;
-  Filter: TResizeFilter): Boolean;
-begin
-  try
-    Result := Imaging.ResizeImage(Image, NewWidth, NewHeight, Filter);
-  except
-    Result := False;
-  end;
-end;
-
-function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt):
-  Boolean;
-begin
-  try
-    Result := Imaging.SwapChannels(Image, SrcChannel, DstChannel);
-  except
-    Result := False;
-  end;
-end;
-
-function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean;
-begin
-  try
-    Result := Imaging.ReduceColors(Image, MaxColors);
-  except
-    Result := False;
-  end;
-end;
-
-function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt;
-  var MipMaps: TImageDataList): Boolean;
-begin
-  try
-    ImInitImageList(0, MipMaps);
-    Result := Imaging.GenerateMipMaps(Image, Levels,
-      PInternalList(MipMaps).List);
-  except
-    Result := False;
-  end;
-end;
-
-function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32;
-  Entries: LongInt): Boolean;
-begin
-  try
-    Result := Imaging.MapImageToPalette(Image, Pal, Entries);
-  except
-    Result := False;
-  end;
-end;
-
-function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
-  ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;
-  PreserveSize: Boolean; Fill: Pointer): Boolean;
-begin
-  try
-    ImInitImageList(0, Chunks);
-    Result := Imaging.SplitImage(Image, PInternalList(Chunks).List,
-      ChunkWidth, ChunkHeight, XChunks, YChunks, PreserveSize, Fill);
-  except
-    Result := False;
-  end;
-end;
-
-function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
-  MaxColors: LongInt; ConvertImages: Boolean): Boolean;
-begin
-  try
-    Result := Imaging.MakePaletteForImages(PInternalList(Images).List,
-      Pal, MaxColors, ConvertImages);
-  except
-    Result := False;
-  end;
-end;
-
-function ImRotateImage(var Image: TImageData; Angle: Single): Boolean;
-begin
-  try
-    Result := Imaging.RotateImage(Image, Angle);
-  except
-    Result := False;
-  end;
-end;
-
-function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
-  var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl;
-begin
-  try
-    Result := Imaging.CopyRect(SrcImage, SrcX, SrcY, Width, Height,
-      DstImage, DstX, DstY);
-  except
-    Result := False;
-  end;
-end;
-
-function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt;
-  Fill: Pointer): Boolean;
-begin
-  try
-    Result := Imaging.FillRect(Image, X, Y, Width, Height, Fill);
-  except
-    Result := False;
-  end;
-end;
-
-function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;
-  OldPixel, NewPixel: Pointer): Boolean;
-begin
-  try
-    Result := Imaging.ReplaceColor(Image, X, Y, Width, Height, OldPixel, NewPixel);
-  except
-    Result := False;
-  end;
-end;
-
-function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
-  SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
-  DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl;
-begin
-  try
-    Result := Imaging.StretchRect(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight,
-      DstImage, DstX, DstY, DstWidth, DstHeight, Filter);
-  except
-    Result := False;
-  end;
-end;
-
-procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);
-begin
-  try
-    Imaging.GetPixelDirect(Image, X, Y, Pixel);
-  except
-  end;
-end;
-
-procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);
-begin
-  try
-    Imaging.SetPixelDirect(Image, X, Y, Pixel);
-  except
-  end;
-end;
-
-function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl;
-begin
-  try
-    Result := Imaging.GetPixel32(Image, X, Y);
-  except
-    Result.Color := 0;
-  end;
-end;
-
-procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec);
-begin
-  try
-    Imaging.SetPixel32(Image, X, Y, Color);
-  except
-  end;
-end;
-
-function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl;
-begin
-  try
-    Result := Imaging.GetPixelFP(Image, X, Y);
-  except
-    FillChar(Result, SizeOf(Result), 0);
-  end;
-end;
-
-procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec);
-begin
-  try
-    Imaging.SetPixelFP(Image, X, Y, Color);
-  except
-  end;
-end;
-
-function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean;
-begin
-  try
-    Imaging.NewPalette(Entries, Pal);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImFreePalette(var Pal: PPalette32): Boolean;
-begin
-  try
-    Imaging.FreePalette(Pal);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean;
-begin
-  try
-    Imaging.CopyPalette(SrcPal, DstPal, SrcIdx, DstIdx, Count);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt;
-begin
-  try
-    Result := Imaging.FindColor(Pal, Entries, Color);
-  except
-    Result := 0;
-  end;
-end;
-
-function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean;
-begin
-  try
-    Imaging.FillGrayscalePalette(Pal, Entries);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,
-  BBits: Byte; Alpha: Byte): Boolean;
-begin
-  try
-    Imaging.FillCustomPalette(Pal, Entries, RBits, GBits, BBits, Alpha);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,
-  DstChannel: LongInt): Boolean;
-begin
-  try
-    Imaging.SwapChannelsOfPalette(Pal, Entries, SrcChannel, DstChannel);
-    Result := True;
-  except
-    Result := False;
-  end;
-end;
-
-function ImSetOption(OptionId, Value: LongInt): Boolean;
-begin
-  try
-    Result := Imaging.SetOption(OptionId, Value);
-  except
-    Result := False;
-  end;
-end;
-
-function ImGetOption(OptionId: LongInt): LongInt;
-begin
-  try
-    Result := GetOption(OptionId);
-  except
-    Result := InvalidOption;
-  end;
-end;
-
-function ImPushOptions: Boolean;
-begin
-  try
-    Result := Imaging.PushOptions;
-  except
-    Result := False;
-  end;
-end;
-
-function ImPopOptions: Boolean;
-begin
-  try
-    Result := Imaging.PopOptions;
-  except
-    Result := False;
-  end;
-end;
-
-function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
-begin
-  try
-    Result := Imaging.GetImageFormatInfo(Format, Info);
-  except
-    Result := False;
-  end;
-end;
-
-function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
-begin
-  try
-    Result := Imaging.GetPixelsSize(Format, Width, Height);
-  except
-    Result := 0;
-  end;
-end;
-
-procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:
-  TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc;
-  TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc);
-begin
-  try
-    Imaging.SetUserFileIO(OpenReadProc, OpenWriteProc, CloseProc, EofProc,
-      SeekProc, TellProc, ReadProc, WriteProc);
-  except
-  end;
-end;
-
-procedure ImResetFileIO;
-begin
-  try
-    Imaging.ResetFileIO;
-  except
-  end;
-end;
-
-{
-  Changes/Bug Fixes:
-
-  -- TODOS ----------------------------------------------------
-    - nothing now 
-
-  -- 0.26.3 ---------------------------------------------------
-    - changed PChars to PAnsiChars and some more D2009 friendly
-      casts.
-
-  -- 0.19 -----------------------------------------------------
-    - updated to reflect changes in low level interface (added pixel set/get, ...)
-    - changed ImInitImage to procedure to reflect change in Imaging.pas
-    - added ImIsFileFormatSupported
-
-  -- 0.15 -----------------------------------------------------
-    - behaviour of ImGetImageListElement and ImSetImageListElement
-      has changed - list items are now cloned rather than referenced,
-      because of this ImFreeImageListKeepImages was no longer needed
-      and was removed
-    - many function headers were changed - mainly pointers were
-      replaced with var and const parameters
-
-  -- 0.13 -----------------------------------------------------
-    - added TestImagesInList function and new 0.13 functions
-    - images were not freed when image list was resized in ImSetImageListSize
-    - ImSaveMultiImageTo* recreated the input image list with size = 0
-
-}
-end.
-

Imaging/ImagingOptions.inc

@@ -1,201 +1,228 @@
-{ $Id: ImagingOptions.inc 174 2009-09-08 09:37:59Z galfar $ }
-
-{
-  User Options
-  Following defines and options can be changed by user.
-}
-
-{ Source options }
-
-{$DEFINE USE_INLINE}          // Use function inlining for some functions
-                              // works in Free Pascal and Delphi 9+.
-{.$DEFINE USE_ASM}             // Ff defined, assembler versions of some
-                              // functions will be used (only for x86).
-
-                              // Debug options: If none of these two are defined
-                              // your project settings are used.
-{ $DEFINE IMAGING_DEBUG}      // If defined, debug info, range/IO/overflow
-                              // checking, stack frames, assertions, and
-                              // other debugging options will be turned on.
-{$DEFINE IMAGING_RELEASE}    // If defined, all debug info is off.
-
-
-
-(* File format support linking options.
-  Define formats which you don't want to be registred automatically.
-  Default: all formats are registered = no symbols defined.
-  Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
-*)
-
-{$DEFINE DONT_LINK_JPEG}        // link support for Jpeg images
-{.$DEFINE DONT_LINK_PNG}         // link support for PNG images
-{.$DEFINE DONT_LINK_TARGA}       // link support for Targa images
-{.$DEFINE DONT_LINK_BITMAP}      // link support for Windows Bitmap images
-{$DEFINE DONT_LINK_DDS}         // link support for DDS images
-{$DEFINE DONT_LINK_GIF}         // link support for GIF images
-{$DEFINE DONT_LINK_MNG}         // link support for MNG images
-{$DEFINE DONT_LINK_JNG}         // link support for JNG images
-{$DEFINE DONT_LINK_PNM}         // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
-
-{$DEFINE DONT_LINK_EXTRAS}  // link support for file formats defined in
-                             // Extras package. Exactly which formats will be
-                             // registered depends on settings in
-                             // ImagingExtras.pas unit.
-
-{ Component set used in ImagignComponents.pas unit. You usually don't need
-  to be concerned with this - proper component library is selected automatically
-  according to your compiler. }
-
-{ $DEFINE COMPONENT_SET_VCL}   // use Delphi VCL
-{$DEFINE COMPONENT_SET_LCL}  // use Lazarus LCL (set automatically when compiling with FPC)
-
-{
-  Auto Options
-  Following options and defines are set automatically and some
-  are required for Imaging to compile successfully. Do not change
-  anything here if you don't know what you are doing.
-}
-
-{ Compiler options }
-
-{$ALIGN ON}               // Field alignment: 8 Bytes (in D6+)
-{$BOOLEVAL OFF}           // Boolean eval: off
-{$EXTENDEDSYNTAX ON}      // Extended syntax: on
-{$LONGSTRINGS ON}         // string = AnsiString: on
-{$MINENUMSIZE 4}          // Min enum size: 4 B
-{$TYPEDADDRESS OFF}       // Typed pointers: off
-{$WRITEABLECONST OFF}     // Writeable constants: off
-
-{$IFNDEF FPC}
-  {$DEFINE DCC}           // if not using FPC then DCC compiler is used (Delphi/Kylix)
-                          // others are not supported
-{$ENDIF}
-
-{$IFDEF DCC}
-  {$IFDEF LINUX}
-    {$DEFINE KYLIX}       // using Kylix
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF DCC}
-  {$IFNDEF KYLIX}
-    {$DEFINE DELPHI}      // using Delphi
-  {$ENDIF}
-{$ENDIF}
-
-{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
-  {$IFDEF RELEASE}
-    {$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
-                   // DEBUG/RELEASE mode in project options and RELEASE
-                   // is currently set we undef DEBUG mode
-  {$ENDIF}
-{$IFEND}
-
-{$IF Defined(IMAGING_DEBUG)}
-  {$ASSERTIONS ON}
-  {$DEBUGINFO ON}
-  {$RANGECHECKS ON}
-  {$IOCHECKS ON}
-  {$OVERFLOWCHECKS ON}
-  {$IFDEF DCC}
-    {$OPTIMIZATION OFF}
-    {$STACKFRAMES ON}
-    {$LOCALSYMBOLS ON}
-    {$DEFINE MEMCHECK}
-  {$ENDIF}
-  {$IFDEF FPC}
-    {$S+}
-    {$CHECKPOINTER ON}
-  {$ENDIF}
-{$ELSEIF Defined(IMAGING_RELEASE)}
-  {$ASSERTIONS OFF}
-  {$DEBUGINFO OFF}
-  {$RANGECHECKS OFF}
-  {$IOCHECKS OFF}
-  {$OVERFLOWCHECKS OFF}
-  {$IFDEF DCC}
-    {$OPTIMIZATION ON}
-    {$STACKFRAMES OFF}
-    {$LOCALSYMBOLS OFF}
-  {$ENDIF}
-  {$IFDEF FPC}
-    {$S-}
-  {$ENDIF}
-{$IFEND}
-
-
-{ Compiler capabilities }
-
-// Define if compiler supports inlining of functions and procedures
-// Note that FPC inline support crashed in older versions (1.9.8)
-{$IF (Defined(DCC) and (CompilerVersion >= 17)) or (Defined(FPC) and Defined(CPU86))}
-  {$DEFINE HAS_INLINE}
-{$IFEND}
-
-// Define if compiler supports advanced records with methods
-{$IF (Defined(DCC) and (CompilerVersion >= 18)) }
-  {$DEFINE HAS_ADVANCED_RECORDS}
-{$IFEND}
-
-// Define if compiler supports operator overloading
-// (unfortunately Delphi and FPC operator overloaing is not compatible)
-{$IF (Defined(DCC) and (CompilerVersion >= 18)) or Defined(FPC)}
-  {$DEFINE HAS_OPERATOR_OVERLOADING}
-{$IFEND}
-
-{ Imaging options check}
-
-{$IFNDEF HAS_INLINE}
-  {$UNDEF USE_INLINE}
-{$ENDIF}
-
-{$IFDEF FPC}
-  {$IFNDEF CPU86}
-    {$UNDEF USE_ASM}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF FPC}
-  {$DEFINE COMPONENT_SET_LCL}
-  {$UNDEF COMPONENT_SET_VCL}
-{$ENDIF}
-
-{$IFDEF DELPHI}
-  {$UNDEF COMPONENT_SET_LCL}
-  {$DEFINE COMPONENT_SET_VCL}
-{$ENDIF}
-
-{ Platform options }
-
-{$IFDEF WIN32}
-  {$DEFINE MSWINDOWS}
-{$ENDIF}
-
-{$IFDEF DPMI}
-  {$DEFINE MSDOS}
-{$ENDIF}
-
-{$IFDEF LINUX}
-  {$DEFINE UNIX}
-{$ENDIF}
-
-{ More compiler options }
-
-{$IFDEF FPC}               // Free Pascal options - some options set above (like min enum size)
-                           // are reset to defaults by setting {$MODE} so they are
-                           // redeclared here 
-  {$MODE DELPHI}           // compatible with delphi
-  {$GOTO ON}               // alow goto
-  {$PACKRECORDS 8}         // same as ALING 8 for Delphi
-  {$PACKENUM 4}            // Min enum size: 4 B
-  {$CALLING REGISTER}      // default calling convention is register
-  {$IFDEF CPU86}
-    {$ASMMODE INTEL}       // intel assembler mode
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF HAS_INLINE}        
-  {$INLINE ON}             // turns inlining on for compilers that support it
-{$ENDIF}
-
-
+{
+  User Options
+  Following defines and options can be changed by user.
+}
+
+{ Source options }
+
+{$DEFINE USE_INLINE}          // Use function inlining for some functions
+                              // works in Free Pascal and Delphi 9+.
+{$DEFINE USE_ASM}             // If defined, assembler versions of some
+                              // functions will be used (only for x86).
+
+                              // Debug options: If none of these two are defined
+                              // your project settings are used.
+{.$DEFINE IMAGING_DEBUG}      // If defined, debug info, range/IO/overflow
+                              // checking, stack frames, assertions, and
+                              // other debugging options will be turned on.
+{$DEFINE IMAGING_RELEASE}    // If defined, all debug info is off.
+
+{$DEFINE OPENGL_NO_EXT_HEADERS}
+
+
+
+(* File format support linking options.
+  Define formats which you don't want to be registered automatically (by adding
+  Imaging.pas unit to your uses clause).
+  Default: most formats are registered = no symbols defined.
+  Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
+*)
+
+{$DEFINE DONT_LINK_JPEG}        // link support for Jpeg images
+{.$DEFINE DONT_LINK_PNG}         // link support for PNG images
+{.$DEFINE DONT_LINK_TARGA}       // link support for Targa images
+{.$DEFINE DONT_LINK_BITMAP}      // link support for Windows Bitmap images
+{$DEFINE DONT_LINK_DDS}         // link support for DDS images
+{$DEFINE DONT_LINK_GIF}         // link support for GIF images
+{$DEFINE DONT_LINK_MNG}         // link support for MNG images
+{$DEFINE DONT_LINK_JNG}         // link support for JNG images
+{$DEFINE DONT_LINK_PNM}         // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
+{$DEFINE DONT_LINK_RADHDR}      // link support for Radiance HDR/RGBE file format
+
+{$DEFINE DONT_LINK_EXTRAS}  // link support for file formats defined in
+                             // Extensions package. Exactly which formats will be
+                             // registered depends on settings in
+                             // ImagingExtFileFormats.pas unit.
+
+{.$DEFINE DONT_LINK_FILE_FORMATS} // no auto link support of any file format
+
+{
+  Auto Options
+  Following options and defines are set automatically and some
+  are required for Imaging to compile successfully. Do not change
+  anything here if you don't know what you are doing.
+}
+
+{ Compiler options }
+
+{$ALIGN ON}               // Field alignment: 8 Bytes (in D6+)
+{$BOOLEVAL OFF}           // Boolean eval: off
+{$EXTENDEDSYNTAX ON}      // Extended syntax: on
+{$LONGSTRINGS ON}         // string = AnsiString: on
+{$MINENUMSIZE 1}          // Min enum size: 1 B
+{$TYPEDADDRESS OFF}       // Typed pointers: off
+{$WRITEABLECONST OFF}     // Writeable constants: off
+
+{$IFNDEF FPC}
+  {$DEFINE DCC}           // if not using FPC then DCC compiler is used (Delphi/BCB)
+                          // others are not supported
+{$ENDIF}
+
+{$IFDEF DCC}
+  {$DEFINE DELPHI}
+  {$IF (Defined(DCC) and (CompilerVersion >= 25.0))}
+    {$LEGACYIFEND ON}
+  {$IFEND}  
+{$ENDIF}
+
+{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
+  {$IFDEF RELEASE}
+    {$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
+                   // DEBUG/RELEASE mode in project options and RELEASE
+                   // is currently set we undef DEBUG mode
+  {$ENDIF}
+{$IFEND}
+
+{$IF Defined(IMAGING_DEBUG)}
+  {$ASSERTIONS ON}
+  {$DEBUGINFO ON}
+  {$RANGECHECKS ON}
+  {$IOCHECKS ON}
+  {$OVERFLOWCHECKS ON}
+  {$IFDEF DCC}
+    {$OPTIMIZATION OFF}
+    {$STACKFRAMES ON}
+    {$LOCALSYMBOLS ON}
+    {$DEFINE MEMCHECK}
+  {$ENDIF}
+  {$IFDEF FPC}
+    {$S+}
+    {$CHECKPOINTER ON}
+  {$ENDIF}
+{$ELSEIF Defined(IMAGING_RELEASE)}
+  {$ASSERTIONS OFF}
+  {$DEBUGINFO OFF}
+  {$RANGECHECKS OFF}
+  {$IOCHECKS OFF}
+  {$OVERFLOWCHECKS OFF}
+  {$IFDEF DCC}
+    {$OPTIMIZATION ON}
+    {$STACKFRAMES OFF}
+    {$LOCALSYMBOLS OFF}
+  {$ENDIF}
+  {$IFDEF FPC}
+    {$S-}
+  {$ENDIF}
+{$IFEND}
+
+{$IF Defined(CPU86) and not Defined(CPUX86)}
+  {$DEFINE CPUX86} // Compatibility with Delphi
+{$IFEND}
+
+{$IF Defined(CPUX86_64) and not Defined(CPUX64)}
+  {$DEFINE CPUX64} // Compatibility with Delphi
+{$IFEND}
+
+{$IF Defined(DARWIN) and not Defined(MACOS)}
+  {$DEFINE MACOS} // Compatibility with Delphi
+{$IFEND}
+{$IF Defined(MACOS)}
+  {$DEFINE MACOSX}
+{$IFEND}
+
+{$IF Defined(DCC) and (CompilerVersion < 23)}   // < XE2
+  {$DEFINE CPUX86} // Compatibility with older Delphi
+{$IFEND}
+
+{$IF Defined(WIN32) or Defined(WIN64)}
+  {$DEFINE MSWINDOWS} // Compatibility with Delphi
+{$IFEND}
+
+{$IF Defined(UNIX) and not Defined(POSIX)}
+  {$DEFINE POSIX} // Compatibility with Delphi
+{$IFEND}
+
+{ Compiler capabilities }
+
+// Define if compiler supports inlining of functions and procedures
+{$IF (Defined(DCC) and (CompilerVersion >= 17)) or Defined(FPC)}
+  {$DEFINE HAS_INLINE}
+{$IFEND}
+
+// Define if compiler supports advanced records with methods
+{$IF (Defined(DCC) and (CompilerVersion >= 18)) or
+  (Defined(FPC) and (FPC_FULLVERSION >= 20600))}
+  {$DEFINE HAS_ADVANCED_RECORDS}
+{$IFEND}
+
+// Define if compiler supports operator overloading
+// (unfortunately Delphi and FPC operator overloading is not compatible).
+// FPC supports Delphi compatible operator overloads since 2.6.0
+{$IF (Defined(DCC) and (CompilerVersion >= 18)) or
+  (Defined(FPC) and (FPC_FULLVERSION >= 20600))}
+  {$DEFINE HAS_OPERATOR_OVERLOADING}
+{$IFEND}
+
+// Anonymous methods
+{$IF Defined(DCC) and (CompilerVersion >= 20) }
+  {$DEFINE HAS_ANON_METHODS}
+{$IFEND}
+
+// Generic types (Delphi and FPC implementations incompatible).
+// Update: FPC supports Delphi compatible generics since 2.6.0
+{$IF (Defined(DCC) and (CompilerVersion >= 20)) or
+  (Defined(FPC) and (FPC_FULLVERSION >= 20600))}
+  {$DEFINE HAS_GENERICS}
+{$IFEND}
+
+{ Compiler pecularities }
+
+// Delphi 64bit POSIX targets
+{$IF Defined(DCC) and (SizeOf(Integer) <> SizeOf(LongInt))}
+  {$DEFINE LONGINT_IS_NOT_INTEGER}
+{$IFEND}
+
+// They used to force IFEND, now they warn about it
+{$IF Defined(DCC) and (CompilerVersion >= 33)}
+  {$LEGACYIFEND ON}
+{$IFEND}
+
+{ Imaging options check}
+
+{$IFNDEF HAS_INLINE}
+  {$UNDEF USE_INLINE}
+{$ENDIF}
+
+{$IF not Defined(CPUX86)}
+  {$UNDEF USE_ASM}
+{$IFEND}
+
+{$IFDEF FPC}
+  {$DEFINE COMPONENT_SET_LCL}
+  {$UNDEF COMPONENT_SET_VCL}
+{$ENDIF}
+
+{$IFDEF DELPHI}
+  {$UNDEF COMPONENT_SET_LCL}
+  {$DEFINE COMPONENT_SET_VCL}
+{$ENDIF}
+
+{ More compiler options }
+
+{$IFDEF FPC}               // Free Pascal options - some options set above (like min enum size)
+                           // are reset to defaults by setting {$MODE} so they are
+                           // redeclared here
+  {$MODE DELPHI}           // compatible with delphi
+  {$GOTO ON}               // alow goto
+  {$PACKRECORDS 8}         // same as ALING 8 for Delphi
+  {$PACKENUM 4}            // Min enum size: 4 B
+  {$IFDEF CPU86}
+    {$ASMMODE INTEL}       // intel assembler mode
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF HAS_INLINE}
+  {$INLINE ON}             // turns inlining on for compilers that support it
+{$ENDIF}
+
+

Imaging/ImagingRadiance.pas

@@ -0,0 +1,480 @@
+{
+  Vampyre Imaging Library
+  by Marek Mauder
+  https://github.com/galfar/imaginglib
+  https://imaginglib.sourceforge.io
+  - - - - -
+  This Source Code Form is subject to the terms of the Mozilla Public
+  License, v. 2.0. If a copy of the MPL was not distributed with this
+  file, You can obtain one at https://mozilla.org/MPL/2.0.
+} 
+
+{ This unit contains image format loader/saver for Radiance HDR/RGBE images.}
+unit ImagingRadiance;
+
+{$I ImagingOptions.inc}
+
+interface
+
+uses
+  SysUtils, Classes, Imaging, ImagingTypes, ImagingUtility;
+
+type
+  { Radiance is a suite of tools for performing lighting simulation. It's
+    development started in 1985 and it pioneered the concept of
+    high dynamic range imaging. Radiance defined an image format for storing
+    HDR images, now described as RGBE image format. Since it was the first
+    HDR image format, this format is supported by many other software packages.
+
+    Radiance image file consists of three sections: a header, resolution string,
+    followed by the pixel data. Each pixel is stored as 4 bytes, one byte
+    mantissa for each r, g, b and a shared one byte exponent.
+    The pixel data may be stored uncompressed or using run length encoding.
+
+    Imaging translates RGBE pixels to original float values and stores them
+    in ifR32G32B32F data format. It can read both compressed and uncompressed
+    files, and saves files as compressed.}
+  THdrFileFormat = class(TImageFileFormat)
+  protected
+    procedure Define; override;
+    function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
+      OnlyFirstLevel: Boolean): Boolean; override;
+    function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
+      Index: LongInt): Boolean; override;
+    procedure ConvertToSupported(var Image: TImageData;
+      const Info: TImageFormatInfo); override;
+  public
+    function TestFormat(Handle: TImagingHandle): Boolean; override;
+  end;
+
+implementation
+
+uses
+  Math, ImagingIO;
+
+const
+  SHdrFormatName = 'Radiance HDR/RGBE';
+  SHdrMasks      = '*.hdr';
+  HdrSupportedFormats: TImageFormats = [ifR32G32B32F];
+
+type
+  TSignature = array[0..9] of AnsiChar;
+  THdrFormat = (hfRgb, hfXyz);
+
+  THdrHeader = record
+    Format: THdrFormat;
+    Width: Integer;
+    Height: Integer;
+  end;
+
+  TRgbe = packed record
+    R, G, B, E: Byte;
+  end;
+  TDynRgbeArray = array of TRgbe;
+
+const
+  RadianceSignature: TSignature = '#?RADIANCE';
+  RgbeSignature: TSignature = '#?RGBE';
+  SFmtRgbeRle = '32-bit_rle_rgbe';
+  SFmtXyzeRle = '32-bit_rle_xyze';
+
+resourcestring
+  SErrorBadHeader = 'Bad HDR/RGBE header format.';
+  SWrongScanLineWidth = 'Wrong scanline width.';
+  SXyzNotSupported = 'XYZ color space not supported.';
+
+{ THdrFileFormat }
+
+procedure THdrFileFormat.Define;
+begin
+  inherited;
+  FName := SHdrFormatName;
+  FFeatures := [ffLoad, ffSave];
+  FSupportedFormats := HdrSupportedFormats;
+
+  AddMasks(SHdrMasks);
+end;
+
+function THdrFileFormat.LoadData(Handle: TImagingHandle;
+  var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
+var
+  Header: THdrHeader;
+  IO: TIOFunctions;
+
+  function ReadHeader: Boolean;
+  const
+    CommentIds: TAnsiCharSet = ['#', '!'];
+  var
+    Line: AnsiString;
+    HasResolution: Boolean;
+    Count, Idx: Integer;
+    ValStr, NativeLine: string;
+    ValFloat: Double;
+  begin
+    Result := False;
+    HasResolution := False;
+    Count := 0;
+
+    repeat
+      if not ReadLine(IO, Handle, Line) then
+        Exit;
+
+      Inc(Count);
+      if Count > 16 then // Too long header for HDR
+        Exit;
+
+      if Length(Line) = 0 then
+        Continue;
+      if Line[1] in CommentIds then
+        Continue;
+
+      NativeLine := string(Line);
+
+      if StrMaskMatch(NativeLine, 'Format=*') then
+      begin
+        // Data format parsing
+        ValStr := Copy(NativeLine, 8, MaxInt);
+        if ValStr = SFmtRgbeRle then
+          Header.Format := hfRgb
+        else if ValStr = SFmtXyzeRle then
+          Header.Format := hfXyz
+        else
+          Exit;
+      end;
+
+      if StrMaskMatch(NativeLine, 'Gamma=*') then
+      begin
+        ValStr := Copy(NativeLine, 7, MaxInt);
+        if TryStrToFloat(ValStr, ValFloat, GetFormatSettingsForFloats) then
+          FMetadata.SetMetaItem(SMetaGamma, ValFloat);
+      end;
+
+      if StrMaskMatch(NativeLine, 'Exposure=*') then
+      begin
+        ValStr := Copy(NativeLine, 10, MaxInt);
+        if TryStrToFloat(ValStr, ValFloat, GetFormatSettingsForFloats) then
+          FMetadata.SetMetaItem(SMetaExposure, ValFloat);
+      end;
+
+      if StrMaskMatch(NativeLine, '?Y * ?X *') then
+      begin
+        Idx := Pos('X', NativeLine);
+        ValStr := SubString(NativeLine, 4, Idx - 2);
+        if not TryStrToInt(ValStr, Header.Height) then
+          Exit;
+        ValStr := Copy(NativeLine, Idx + 2, MaxInt);
+        if not TryStrToInt(ValStr, Header.Width) then
+          Exit;
+
+        if (NativeLine[1] = '-') then
+          Header.Height := -Header.Height;
+        if (NativeLine[Idx - 1] = '-') then
+          Header.Width := -Header.Width;
+
+        HasResolution := True;
+      end;
+
+    until HasResolution;
+    Result := True;
+  end;
+
+  procedure DecodeRgbe(const Src: TRgbe; Dest: PColor96FPRec); {$IFDEF USE_INLINE}inline;{$ENDIF}
+  var
+    Mult: Single;
+  begin
+    if Src.E > 0 then
+    begin
+      Mult := Math.Ldexp(1, Src.E - 128);
+      Dest.R := Src.R / 255 * Mult;
+      Dest.G := Src.G / 255 * Mult;
+      Dest.B := Src.B / 255 * Mult;
+    end
+    else
+    begin
+      Dest.R := 0;
+      Dest.G := 0;
+      Dest.B := 0;
+    end;
+  end;
+
+  procedure ReadCompressedLine(Width, Y: Integer; var DestBuffer: TDynRgbeArray);
+  var
+    Pos: Integer;
+    I, X, Count: Integer;
+    Code, Value: Byte;
+    LineBuff: TDynByteArray;
+    Rgbe: TRgbe;
+    Ptr: PByte;
+  begin
+    SetLength(LineBuff, Width);
+    IO.Read(Handle, @Rgbe, SizeOf(Rgbe));
+
+    if ((Rgbe.B shl 8) or Rgbe.E) <> Width  then
+      RaiseImaging(SWrongScanLineWidth);
+
+    for I := 0 to 3 do
+    begin
+      Pos := 0;
+      while Pos < Width do
+      begin
+        IO.Read(Handle, @Code, SizeOf(Byte));
+        if Code > 128 then
+        begin
+          Count := Code - 128;
+          IO.Read(Handle, @Value, SizeOf(Byte));
+          FillMemoryByte(@LineBuff[Pos], Count, Value);
+        end
+        else
+        begin
+          Count := Code;
+          IO.Read(Handle, @LineBuff[Pos], Count * SizeOf(Byte));
+        end;
+        Inc(Pos, Count);
+      end;
+
+      Ptr := @PByteArray(@DestBuffer[0])[I];
+      for X := 0 to Width - 1 do
+      begin
+        Ptr^ := LineBuff[X];
+        Inc(Ptr, 4);
+      end;
+    end;
+  end;
+
+  procedure ReadPixels(var Image: TImageData);
+  var
+    Y, X, SrcLineLen: Integer;
+    Dest: PColor96FPRec;
+    Compressed: Boolean;
+    Rgbe: TRgbe;
+    Buffer: TDynRgbeArray;
+  begin
+    Dest := Image.Bits;
+    Compressed := not ((Image.Width < 8) or (Image.Width > $7FFFF));
+    SrcLineLen := Image.Width * SizeOf(TRgbe);
+
+    IO.Read(Handle, @Rgbe, SizeOf(Rgbe));
+    IO.Seek(Handle, -SizeOf(Rgbe), smFromCurrent);
+
+    if (Rgbe.R <> 2) or (Rgbe.G <> 2) or ((Rgbe.B and 128) > 0) then
+      Compressed := False;
+
+    SetLength(Buffer, Image.Width);
+
+    for Y := 0 to Image.Height - 1 do
+    begin
+      if Compressed then
+        ReadCompressedLine(Image.Width, Y, Buffer)
+      else
+        IO.Read(Handle, @Buffer[0], SrcLineLen);
+
+      for X := 0 to Image.Width - 1 do
+      begin
+        DecodeRgbe(Buffer[X], Dest);
+        Inc(Dest);
+      end;
+    end;
+  end;
+
+begin
+  IO := GetIO;
+  SetLength(Images, 1);
+
+  // Read header, allocate new image and, then read and convert the pixels
+  if not ReadHeader then
+    RaiseImaging(SErrorBadHeader);
+  if (Header.Format = hfXyz) then
+    RaiseImaging(SXyzNotSupported);
+
+  NewImage(Abs(Header.Width), Abs(Header.Height), ifR32G32B32F, Images[0]);
+  ReadPixels(Images[0]);
+
+  // Flip/mirror the image as needed (height < 0 is default top-down)
+  if Header.Width < 0 then
+    MirrorImage(Images[0]);
+  if Header.Height > 0 then
+    FlipImage(Images[0]);
+
+  Result := True;
+end;
+
+function THdrFileFormat.SaveData(Handle: TImagingHandle;
+  const Images: TDynImageDataArray; Index: LongInt): Boolean;
+const
+  LineEnd = #$0A;
+  SPrgComment = '#Made with Vampyre Imaging Library';
+  SSizeFmt = '-Y %d +X %d';
+var
+  ImageToSave: TImageData;
+  MustBeFreed: Boolean;
+  IO: TIOFunctions;
+
+  procedure SaveHeader;
+  begin
+    WriteLine(IO, Handle, RadianceSignature, LineEnd);
+    WriteLine(IO, Handle, SPrgComment, LineEnd);
+    WriteLine(IO, Handle, 'FORMAT=' + SFmtRgbeRle, LineEnd + LineEnd);
+    WriteLine(IO, Handle, AnsiString(Format(SSizeFmt, [ImageToSave.Height, ImageToSave.Width])), LineEnd);
+  end;
+
+  procedure EncodeRgbe(const Src: TColor96FPRec; var DestR, DestG, DestB, DestE: Byte); {$IFDEF USE_INLINE}inline;{$ENDIF}
+  var
+    V, M: {$IFDEF FPC}Float{$ELSE}Extended{$ENDIF};
+    E: Integer;
+  begin
+    V := Src.R;
+    if (Src.G > V) then
+      V := Src.G;
+    if (Src.B > V) then
+      V := Src.B;
+
+    if V < 1e-32 then
+    begin
+      DestR := 0;
+      DestG := 0;
+      DestB := 0;
+      DestE := 0;
+    end
+    else
+    begin
+      Frexp(V, M, E);
+      V := M * 256.0 / V;
+      DestR := ClampToByte(Round(Src.R * V));
+      DestG := ClampToByte(Round(Src.G * V));
+      DestB := ClampToByte(Round(Src.B * V));
+      DestE := ClampToByte(E + 128);
+    end;
+  end;
+
+  procedure WriteRleLine(const Line: array of Byte; Width: Integer);
+  const
+    MinRunLength = 4;
+  var
+    Cur, BeginRun, RunCount, OldRunCount, NonRunCount: Integer;
+    Buf: array[0..1] of Byte;
+  begin
+    Cur := 0;
+    while Cur < Width do
+    begin
+      BeginRun := Cur;
+      RunCount := 0;
+      OldRunCount := 0;
+      while (RunCount < MinRunLength) and (BeginRun < Width) do
+      begin
+        Inc(BeginRun, RunCount);
+        OldRunCount := RunCount;
+        RunCount := 1;
+        while (BeginRun + RunCount < Width) and (RunCount < 127) and (Line[BeginRun] = Line[BeginRun + RunCount]) do
+          Inc(RunCount);
+      end;
+      if (OldRunCount > 1) and (OldRunCount = BeginRun - Cur) then
+      begin
+        Buf[0] := 128 + OldRunCount;
+        Buf[1] := Line[Cur];
+        IO.Write(Handle, @Buf, 2);
+        Cur := BeginRun;
+      end;
+      while Cur < BeginRun do
+      begin
+        NonRunCount := Min(128, BeginRun - Cur);
+        Buf[0] := NonRunCount;
+        IO.Write(Handle, @Buf, 1);
+        IO.Write(Handle, @Line[Cur], NonRunCount);
+        Inc(Cur, NonRunCount);
+      end;
+      if RunCount >= MinRunLength then
+      begin
+        Buf[0] := 128 + RunCount;
+        Buf[1] := Line[BeginRun];
+        IO.Write(Handle, @Buf, 2);
+        Inc(Cur, RunCount);
+      end;
+    end;
+  end;
+
+  procedure SavePixels;
+  var
+    Y, X, I, Width: Integer;
+    SrcPtr: PColor96FPRecArray;
+    Components: array of array of Byte;
+    StartLine: array[0..3] of Byte;
+  begin
+    Width := ImageToSave.Width;
+    // Save using RLE, each component is compressed separately
+    SetLength(Components, 4, Width);
+
+    for Y := 0 to ImageToSave.Height - 1 do
+    begin
+      SrcPtr := @PColor96FPRecArray(ImageToSave.Bits)[ImageToSave.Width * Y];
+
+      // Identify line as using "new" RLE scheme (separate components)
+      StartLine[0] := 2;
+      StartLine[1] := 2;
+      StartLine[2] := Width shr 8;
+      StartLine[3] := Width and $FF;
+      IO.Write(Handle, @StartLine, SizeOf(StartLine));
+
+      for X := 0 to Width - 1 do
+      begin
+        EncodeRgbe(SrcPtr[X], Components[0, X], Components[1, X],
+          Components[2, X], Components[3, X]);
+      end;
+
+      for I := 0 to 3 do
+        WriteRleLine(Components[I], Width);
+    end;
+  end;
+
+begin
+  Result := False;
+  IO := GetIO;
+  // Makes image to save compatible with Jpeg saving capabilities
+  if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
+  with ImageToSave do
+  try
+    // Save header
+    SaveHeader;
+    // Save uncompressed pixels
+    SavePixels;
+    Result := True;
+  finally
+    if MustBeFreed then
+      FreeImage(ImageToSave);
+  end;
+end;
+
+procedure THdrFileFormat.ConvertToSupported(var Image: TImageData;
+  const Info: TImageFormatInfo);
+begin
+  ConvertImage(Image, ifR32G32B32F);
+end;
+
+function THdrFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
+var
+  FileSig: TSignature;
+  ReadCount: Integer;
+begin
+  Result := False;
+  if Handle <> nil then
+  begin
+    ReadCount := GetIO.Read(Handle, @FileSig, SizeOf(FileSig));
+    GetIO.Seek(Handle, -ReadCount, smFromCurrent);
+    Result := (ReadCount = SizeOf(FileSig)) and
+      ((FileSig = RadianceSignature) or CompareMem(@FileSig, @RgbeSignature, 6));
+  end;
+end;
+
+initialization
+  RegisterImageFileFormat(THdrFileFormat);
+
+{
+  File Notes:
+
+  -- 0.77.1 ---------------------------------------------------
+    - Added RLE compression to saving.
+    - Added image saving.
+    - Unit created with initial stuff (loading only).
+
+}
+
+end.

Imaging/JpegLib/imjcapimin.pas

@@ -1,5 +1,5 @@
 unit imjcapimin;
-{$N+}
+
 {  This file contains application interface code for the compression half
   of the JPEG library.  These are the "minimum" API routines that may be
   needed in either the normal full-compression case or the transcoding-only
@@ -157,15 +157,14 @@ begin
 
   { For debugging purposes, we zero the whole master structure.
     But the application has already set the err pointer, and may have set
-    client_data, so we have to save and restore those fields.
-    Note: if application hasn't set client_data, tools like Purify may
-    complain here. }
+    client_data, so we have to save and restore those fields. }
 
   err := cinfo^.err;
-  client_data := cinfo^.client_data; { ignore Purify complaint here }
+  client_data := cinfo^.client_data;
   MEMZERO(cinfo, SIZEOF(jpeg_compress_struct));
   cinfo^.err := err;
   cinfo^.is_decompressor := FALSE;
+  cinfo^.client_data := client_data;
 
   { Initialize a memory manager instance for this object }
   jinit_memory_mgr(j_common_ptr(cinfo));
@@ -279,15 +278,15 @@ begin
     begin
       if (cinfo^.progress <> NIL) then
       begin
-	cinfo^.progress^.pass_counter := long (iMCU_row);
-	cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows);
-	cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
+      	cinfo^.progress^.pass_counter := long (iMCU_row);
+      	cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows);
+      	cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
       end;
       { We bypass the main controller and invoke coef controller directly;
         all work is being done from the coefficient buffer. }
 
       if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then
-	ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
+      	ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
     end;
     cinfo^.master^.finish_pass (cinfo);
   end;

Imaging/JpegLib/imjccolor.pas

@@ -24,8 +24,7 @@ implementation
 
 { Private subobject }
 type
-  jTInt32 = 0..Pred(MaxInt div SizeOf(INT32));
-  INT32_FIELD = array[jTInt32] of INT32;
+  INT32_FIELD = array[0..MaxInt div SizeOf(INT32) - 1] of INT32;
   INT32_FIELD_PTR = ^INT32_FIELD;
 
 type
@@ -94,14 +93,14 @@ const
 {METHODDEF}
 procedure rgb_ycc_start (cinfo : j_compress_ptr);  
 const
-  FIX_0_29900 = INT32(Round (0.29900 * (1 shl SCALEBITS)) );
-  FIX_0_58700 = INT32(Round (0.58700 * (1 shl SCALEBITS)) );
-  FIX_0_11400 = INT32(Round (0.11400 * (1 shl SCALEBITS)) );
-  FIX_0_16874 = INT32(Round (0.16874 * (1 shl SCALEBITS)) );
-  FIX_0_33126 = INT32(Round (0.33126 * (1 shl SCALEBITS)) );
-  FIX_0_50000 = INT32(Round (0.50000 * (1 shl SCALEBITS)) );
-  FIX_0_41869 = INT32(Round (0.41869 * (1 shl SCALEBITS)) );
-  FIX_0_08131 = INT32(Round (0.08131 * (1 shl SCALEBITS)) );
+  FIX_0_29900 = INT32(Round(0.29900 * (1 shl SCALEBITS)));
+  FIX_0_58700 = INT32(Round(0.58700 * (1 shl SCALEBITS)));
+  FIX_0_11400 = INT32(Round(0.11400 * (1 shl SCALEBITS)));
+  FIX_0_16874 = INT32(Round(0.16874 * (1 shl SCALEBITS)));
+  FIX_0_33126 = INT32(Round(0.33126 * (1 shl SCALEBITS)));
+  FIX_0_50000 = INT32(Round(0.50000 * (1 shl SCALEBITS)));
+  FIX_0_41869 = INT32(Round(0.41869 * (1 shl SCALEBITS)));
+  FIX_0_08131 = INT32(Round(0.08131 * (1 shl SCALEBITS)));
 var
   cconvert : my_cconvert_ptr;
   rgb_ycc_tab : INT32_FIELD_PTR;
@@ -232,26 +231,24 @@ begin
   while (num_rows > 0) do
   begin
     Dec(num_rows);
-    inptr := input_buf^[0];
+    inptr := input_buf[0];
     Inc(JSAMPROW_PTR(input_buf));
-    outptr := output_buf^[0]^[output_row];
+    outptr := output_buf[0][output_row];
     Inc(output_row);
-    for col := 0 to pred(num_cols) do
+    for col := 0 to num_cols - 1 do
     begin
-      r := GETJSAMPLE(inptr^[RGB_RED]);
-      g := GETJSAMPLE(inptr^[RGB_GREEN]);
-      b := GETJSAMPLE(inptr^[RGB_BLUE]);
+      r := GETJSAMPLE(inptr[RGB_RED]);
+      g := GETJSAMPLE(inptr[RGB_GREEN]);
+      b := GETJSAMPLE(inptr[RGB_BLUE]);
       Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE);
       (* Y *)
-      //  kylix 3 compiler crashes on this
-      {$IF (not Defined(LINUX)) or Defined(FPC)}
-        outptr^[col] := JSAMPLE (
-      		((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF])
-    		 shr SCALEBITS) );
+      // kylix 3 compiler crashes on this
+      // it also crashes Delphi OSX compiler 9 years later :(
+      {$IF not (Defined(DCC) and not Defined(MSWINDOWS))}
+      outptr[col] := JSAMPLE(((ctab[r+R_Y_OFF] + ctab[g+G_Y_OFF] + ctab[b+B_Y_OFF]) shr SCALEBITS));
       {$IFEND}
     end;
   end;
-
 end;
 
 

Imaging/JpegLib/imjcdctmgr.pas

@@ -12,7 +12,6 @@ unit imjcdctmgr;
 
 interface
 
-{$N+}
 {$I imjconfig.inc}
 
 uses

Imaging/JpegLib/imjconfig.inc

@@ -121,4 +121,6 @@
 {!CHANGE: Added this}
 {$define Delphi_Stream}
 {$Q-}
+{$MINENUMSIZE 4}
+{$ALIGN 8}
 

Imaging/JpegLib/imjdapimin.pas

@@ -1,7 +1,5 @@
 unit imjdapimin;
 
-{$N+}  { Nomssi: cinfo^.output_gamma }
-
 { This file contains application interface code for the decompression half
   of the JPEG library.  These are the "minimum" API routines that may be
   needed in either the normal full-decompression case or the

Imaging/JpegLib/imjddctmgr.pas

@@ -15,8 +15,6 @@ interface
 
 {$I imjconfig.inc}
 
-{$N+}
-
 uses
   imjmorecfg,
   imjinclude,

Imaging/JpegLib/imjdhuff.pas

@@ -1172,7 +1172,8 @@ begin
   end;
 
   { Account for restart interval (no-op if not using restarts) }
-  Dec(entropy^.restarts_to_go);
+  if entropy^.restarts_to_go > 0 then
+    Dec(entropy^.restarts_to_go);
 
   decode_mcu := TRUE;
 end;

Imaging/JpegLib/imjdmainct.pas

@@ -601,7 +601,7 @@ begin
       cinfo^.min_DCT_scaled_size; { height of a row group of component }
     main^.buffer[ci] := cinfo^.mem^.alloc_sarray
 			(j_common_ptr(cinfo), JPOOL_IMAGE,
-			 compptr^.width_in_blocks * LongWord(compptr^.DCT_scaled_size),
+			 compptr^.width_in_blocks * uInt(compptr^.DCT_scaled_size),
 			 JDIMENSION (rgroup * ngroups));
     Inc(compptr);
   end;

Imaging/JpegLib/imjerror.pas

@@ -42,7 +42,7 @@ procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
                    p1 : int; p2 : int; p3 : int; p4 : int);
 
 procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
-                   str : string);
+                   str : AnsiString);
 { Nonfatal errors (we can keep going, but the data is probably corrupt) }
 
 procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
@@ -78,7 +78,7 @@ procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
                   p5 : int; p6 : int; p7 : int; p8 : int);
 
 procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
-                   code : J_MESSAGE_CODE; str : string);
+                   code : J_MESSAGE_CODE; str : AnsiString);
 
 implementation
 
@@ -179,7 +179,7 @@ begin
 end;
 
 procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
-                   str : string);
+                   str : AnsiString);
 begin
   cinfo^.err^.msg_code := ord(code);
   cinfo^.err^.msg_parm.s := str;  { string[JMSG_STR_PARM_MAX] }
@@ -286,7 +286,7 @@ begin
 end;
 
 procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
-                   code : J_MESSAGE_CODE; str : string);
+                   code : J_MESSAGE_CODE; str : AnsiString);
 begin
   cinfo^.err^.msg_code := ord(code);
   cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX }
@@ -296,7 +296,7 @@ end;
 {METHODDEF}
 procedure output_message (cinfo : j_common_ptr);  
 var
-  buffer : string; {[JMSG_LENGTH_MAX];}
+  buffer : AnsiString; {[JMSG_LENGTH_MAX];}
 begin
   { Create the message }
   cinfo^.err^.format_message (cinfo, buffer);
@@ -350,11 +350,11 @@ end;
 
 
 {METHODDEF}
-procedure format_message (cinfo : j_common_ptr; var buffer : string);
+procedure format_message (cinfo : j_common_ptr; var buffer : AnsiString);
 var
   err : jpeg_error_mgr_ptr;
   msg_code : J_MESSAGE_CODE;
-  msgtext : string;
+  msgtext : AnsiString;
   isstring : boolean;
 begin
   err := cinfo^.err;

Imaging/JpegLib/imjfdctflt.pas

@@ -1,6 +1,5 @@
 unit imjfdctflt;
 
-{$N+}
 { This file contains a floating-point implementation of the
   forward DCT (Discrete Cosine Transform).
 

Imaging/JpegLib/imjidctasm.pas

@@ -510,7 +510,7 @@ asm
   mov	edi, DWORD PTR [ebx+eax*4]           { 4 = SizeOf(pointer) }
 
     {Inc(JSAMPLE_PTR(outptr), output_col);}
-  add	edi, LongWord(output_col)
+  add	edi, uInt(output_col)
 
     { Rows of zeroes can be exploited in the same way as we did with columns.
       However, the column calculation has created many nonzero AC terms, so

Imaging/JpegLib/imjidctflt.pas

@@ -1,6 +1,5 @@
 unit imjidctflt;
 
-{$N+}
 { This file contains a floating-point implementation of the
   inverse DCT (Discrete Cosine Transform).  In the IJG code, this routine
   must also perform dequantization of the input coefficients.

Imaging/JpegLib/imjmemnobs.pas

@@ -1,259 +1,259 @@
-unit imjmemnobs;
-{ Delphi3 -- > jmemnobs from jmemwin }
-{ This file provides an Win32-compatible implementation of the system-
-  dependent portion of the JPEG memory manager. }
-
-{ Check jmemnobs.c }
-{ Copyright (C) 1996, Jacques Nomssi Nzali }
-
-
-interface
-
-{$I imjconfig.inc}
-
-uses
-  imjmorecfg,
-  imjdeferr,
-  imjerror,
-  imjpeglib;
-
-{ The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may
-  be requested in a single call to jpeg_get_large (and jpeg_get_small for that
-  matter, but that case should never come into play).  This macro is needed
-  to model the 64Kb-segment-size limit of far addressing on 80x86 machines.
-  On those machines, we expect that jconfig.h will provide a proper value.
-  On machines with 32-bit flat address spaces, any large constant may be used.
-
-  NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
-  size_t and will be a multiple of sizeof(align_type). }
-
-const
-  MAX_ALLOC_CHUNK = long(1000000000);
-
-{GLOBAL}
-procedure jpeg_open_backing_store (cinfo : j_common_ptr;
-                                   info : backing_store_ptr;
-                                   total_bytes_needed : long);
-
-{ These routines take care of any system-dependent initialization and
-  cleanup required. }
-
-{GLOBAL}
-function jpeg_mem_init (cinfo : j_common_ptr) : long;
-
-{GLOBAL}
-procedure jpeg_mem_term (cinfo : j_common_ptr);
-
-{ These two functions are used to allocate and release small chunks of
-  memory.  (Typically the total amount requested through jpeg_get_small is
-  no more than 20K or so; this will be requested in chunks of a few K each.)
-  Behavior should be the same as for the standard library functions malloc
-  and free; in particular, jpeg_get_small must return NIL on failure.
-  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
-  size of the object being freed, just in case it's needed.
-  On an 80x86 machine using small-data memory model, these manage near heap. }
-
-
-{ Near-memory allocation and freeing are controlled by the regular library
-  routines malloc() and free(). }
-
-{GLOBAL}
-function jpeg_get_small (cinfo : j_common_ptr;
-                         sizeofobject : size_t) : pointer;
-
-{GLOBAL}
-{object is a reserved word in Borland Pascal }
-procedure jpeg_free_small (cinfo : j_common_ptr;
-                           an_object : pointer;
-                           sizeofobject : size_t);
-
-{ These two functions are used to allocate and release large chunks of
-  memory (up to the total free space designated by jpeg_mem_available).
-  The interface is the same as above, except that on an 80x86 machine,
-  far pointers are used.  On most other machines these are identical to
-  the jpeg_get/free_small routines; but we keep them separate anyway,
-  in case a different allocation strategy is desirable for large chunks. }
-
-
-{ "Large" objects are allocated in far memory, if possible }
-
-
-{GLOBAL}
-function jpeg_get_large (cinfo : j_common_ptr;
-                         sizeofobject : size_t) : voidp; {far}
-
-{GLOBAL}
-procedure jpeg_free_large (cinfo : j_common_ptr;
-                          {var?} an_object : voidp; {FAR}
-                          sizeofobject : size_t);
-
-{ This routine computes the total memory space available for allocation.
-  It's impossible to do this in a portable way; our current solution is
-  to make the user tell us (with a default value set at compile time).
-  If you can actually get the available space, it's a good idea to subtract
-  a slop factor of 5% or so. }
-
-{GLOBAL}
-function jpeg_mem_available (cinfo : j_common_ptr;
-                             min_bytes_needed : long;
-                             max_bytes_needed : long;
-                             already_allocated : long) : long;
-
-
-implementation
-
-{ This structure holds whatever state is needed to access a single
-  backing-store object.  The read/write/close method pointers are called
-  by jmemmgr.c to manipulate the backing-store object; all other fields
-  are private to the system-dependent backing store routines. }
-
-
-
-{ These two functions are used to allocate and release small chunks of
-  memory.  (Typically the total amount requested through jpeg_get_small is
-  no more than 20K or so; this will be requested in chunks of a few K each.)
-  Behavior should be the same as for the standard library functions malloc
-  and free; in particular, jpeg_get_small must return NIL on failure.
-  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
-  size of the object being freed, just in case it's needed.
-  On an 80x86 machine using small-data memory model, these manage near heap. }
-
-
-{ Near-memory allocation and freeing are controlled by the regular library
-  routines malloc() and free(). }
-
-{GLOBAL}
-function jpeg_get_small (cinfo : j_common_ptr;
-                         sizeofobject : size_t) : pointer;
-var
-  p : pointer;
-begin
-  GetMem(p, sizeofobject);
-  jpeg_get_small := p;
-end;
-
-{GLOBAL}
-{object is a reserved word in Object Pascal }
-procedure jpeg_free_small (cinfo : j_common_ptr;
-                           an_object : pointer;
-                           sizeofobject : size_t);
-begin
-  FreeMem(an_object, sizeofobject);
-end;
-
-{ These two functions are used to allocate and release large chunks of
-  memory (up to the total free space designated by jpeg_mem_available).
-  The interface is the same as above, except that on an 80x86 machine,
-  far pointers are used.  On most other machines these are identical to
-  the jpeg_get/free_small routines; but we keep them separate anyway,
-  in case a different allocation strategy is desirable for large chunks. }
-
-
-
-{GLOBAL}
-function jpeg_get_large (cinfo : j_common_ptr;
-                         sizeofobject : size_t) : voidp; {far}
-var
-  p : pointer;
-begin
-  GetMem(p, sizeofobject);
-  jpeg_get_large := p;
-end;
-
-{GLOBAL}
-procedure jpeg_free_large (cinfo : j_common_ptr;
-                          {var?} an_object : voidp; {FAR}
-                          sizeofobject : size_t);
-begin
-  Freemem(an_object, sizeofobject);
-end;
-
-{ This routine computes the total space still available for allocation by
-  jpeg_get_large.  If more space than this is needed, backing store will be
-  used.  NOTE: any memory already allocated must not be counted.
-
-  There is a minimum space requirement, corresponding to the minimum
-  feasible buffer sizes; jmemmgr.c will request that much space even if
-  jpeg_mem_available returns zero.  The maximum space needed, enough to hold
-  all working storage in memory, is also passed in case it is useful.
-  Finally, the total space already allocated is passed.  If no better
-  method is available, cinfo^.mem^.max_memory_to_use - already_allocated
-  is often a suitable calculation.
-
-  It is OK for jpeg_mem_available to underestimate the space available
-  (that'll just lead to more backing-store access than is really necessary).
-  However, an overestimate will lead to failure.  Hence it's wise to subtract
-  a slop factor from the true available space.  5% should be enough.
-
-  On machines with lots of virtual memory, any large constant may be returned.
-  Conversely, zero may be returned to always use the minimum amount of memory.}
-
-
-
-{ This routine computes the total memory space available for allocation.
-  It's impossible to do this in a portable way; our current solution is
-  to make the user tell us (with a default value set at compile time).
-  If you can actually get the available space, it's a good idea to subtract
-  a slop factor of 5% or so. }
-
-const
-  DEFAULT_MAX_MEM = long(300000);   { for total usage about 450K }
-
-{GLOBAL}
-function jpeg_mem_available (cinfo : j_common_ptr;
-                             min_bytes_needed : long;
-                             max_bytes_needed : long;
-                             already_allocated : long) : long;
-begin
-  {jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
-  jpeg_mem_available := max_bytes_needed;
-end;
-
-
-{ Initial opening of a backing-store object.  This must fill in the
-  read/write/close pointers in the object.  The read/write routines
-  may take an error exit if the specified maximum file size is exceeded.
-  (If jpeg_mem_available always returns a large value, this routine can
-  just take an error exit.) }
-
-
-
-{ Initial opening of a backing-store object. }
-
-{GLOBAL}
-procedure jpeg_open_backing_store (cinfo : j_common_ptr;
-                                   info : backing_store_ptr;
-                                   total_bytes_needed : long);
-begin
-  ERREXIT(cinfo, JERR_NO_BACKING_STORE);
-end;
-
-{ These routines take care of any system-dependent initialization and
-  cleanup required.  jpeg_mem_init will be called before anything is
-  allocated (and, therefore, nothing in cinfo is of use except the error
-  manager pointer).  It should return a suitable default value for
-  max_memory_to_use; this may subsequently be overridden by the surrounding
-  application.  (Note that max_memory_to_use is only important if
-  jpeg_mem_available chooses to consult it ... no one else will.)
-  jpeg_mem_term may assume that all requested memory has been freed and that
-  all opened backing-store objects have been closed. }
-
-
-{ These routines take care of any system-dependent initialization and
-  cleanup required. }
-
-
-{GLOBAL}
-function jpeg_mem_init (cinfo : j_common_ptr) : long;
-begin
-  jpeg_mem_init := DEFAULT_MAX_MEM;   { default for max_memory_to_use }
-end;
-
-{GLOBAL}
-procedure jpeg_mem_term (cinfo : j_common_ptr);
-begin
-
-end;
-
-
-end.
+unit imjmemnobs;
+{ Delphi3 -- > jmemnobs from jmemwin }
+{ This file provides an Win32-compatible implementation of the system-
+  dependent portion of the JPEG memory manager. }
+
+{ Check jmemnobs.c }
+{ Copyright (C) 1996, Jacques Nomssi Nzali }
+
+
+interface
+
+{$I imjconfig.inc}
+
+uses
+  imjmorecfg,
+  imjdeferr,
+  imjerror,
+  imjpeglib;
+
+{ The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may
+  be requested in a single call to jpeg_get_large (and jpeg_get_small for that
+  matter, but that case should never come into play).  This macro is needed
+  to model the 64Kb-segment-size limit of far addressing on 80x86 machines.
+  On those machines, we expect that jconfig.h will provide a proper value.
+  On machines with 32-bit flat address spaces, any large constant may be used.
+
+  NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
+  size_t and will be a multiple of sizeof(align_type). }
+
+const
+  MAX_ALLOC_CHUNK = long(1000000000);
+
+{GLOBAL}
+procedure jpeg_open_backing_store (cinfo : j_common_ptr;
+                                   info : backing_store_ptr;
+                                   total_bytes_needed : long);
+
+{ These routines take care of any system-dependent initialization and
+  cleanup required. }
+
+{GLOBAL}
+function jpeg_mem_init (cinfo : j_common_ptr) : long;
+
+{GLOBAL}
+procedure jpeg_mem_term (cinfo : j_common_ptr);
+
+{ These two functions are used to allocate and release small chunks of
+  memory.  (Typically the total amount requested through jpeg_get_small is
+  no more than 20K or so; this will be requested in chunks of a few K each.)
+  Behavior should be the same as for the standard library functions malloc
+  and free; in particular, jpeg_get_small must return NIL on failure.
+  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
+  size of the object being freed, just in case it's needed.
+  On an 80x86 machine using small-data memory model, these manage near heap. }
+
+
+{ Near-memory allocation and freeing are controlled by the regular library
+  routines malloc() and free(). }
+
+{GLOBAL}
+function jpeg_get_small (cinfo : j_common_ptr;
+                         sizeofobject : size_t) : pointer;
+
+{GLOBAL}
+{object is a reserved word in Borland Pascal }
+procedure jpeg_free_small (cinfo : j_common_ptr;
+                           an_object : pointer;
+                           sizeofobject : size_t);
+
+{ These two functions are used to allocate and release large chunks of
+  memory (up to the total free space designated by jpeg_mem_available).
+  The interface is the same as above, except that on an 80x86 machine,
+  far pointers are used.  On most other machines these are identical to
+  the jpeg_get/free_small routines; but we keep them separate anyway,
+  in case a different allocation strategy is desirable for large chunks. }
+
+
+{ "Large" objects are allocated in far memory, if possible }
+
+
+{GLOBAL}
+function jpeg_get_large (cinfo : j_common_ptr;
+                         sizeofobject : size_t) : voidp; {far}
+
+{GLOBAL}
+procedure jpeg_free_large (cinfo : j_common_ptr;
+                          {var?} an_object : voidp; {FAR}
+                          sizeofobject : size_t);
+
+{ This routine computes the total memory space available for allocation.
+  It's impossible to do this in a portable way; our current solution is
+  to make the user tell us (with a default value set at compile time).
+  If you can actually get the available space, it's a good idea to subtract
+  a slop factor of 5% or so. }
+
+{GLOBAL}
+function jpeg_mem_available (cinfo : j_common_ptr;
+                             min_bytes_needed : long;
+                             max_bytes_needed : long;
+                             already_allocated : long) : long;
+
+
+implementation
+
+{ This structure holds whatever state is needed to access a single
+  backing-store object.  The read/write/close method pointers are called
+  by jmemmgr.c to manipulate the backing-store object; all other fields
+  are private to the system-dependent backing store routines. }
+
+
+
+{ These two functions are used to allocate and release small chunks of
+  memory.  (Typically the total amount requested through jpeg_get_small is
+  no more than 20K or so; this will be requested in chunks of a few K each.)
+  Behavior should be the same as for the standard library functions malloc
+  and free; in particular, jpeg_get_small must return NIL on failure.
+  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
+  size of the object being freed, just in case it's needed.
+  On an 80x86 machine using small-data memory model, these manage near heap. }
+
+
+{ Near-memory allocation and freeing are controlled by the regular library
+  routines malloc() and free(). }
+
+{GLOBAL}
+function jpeg_get_small (cinfo : j_common_ptr;
+                         sizeofobject : size_t) : pointer;
+var
+  p : pointer;
+begin
+  GetMem(p, sizeofobject);
+  jpeg_get_small := p;
+end;
+
+{GLOBAL}
+{object is a reserved word in Object Pascal }
+procedure jpeg_free_small (cinfo : j_common_ptr;
+                           an_object : pointer;
+                           sizeofobject : size_t);
+begin
+  FreeMem(an_object, sizeofobject);
+end;
+
+{ These two functions are used to allocate and release large chunks of
+  memory (up to the total free space designated by jpeg_mem_available).
+  The interface is the same as above, except that on an 80x86 machine,
+  far pointers are used.  On most other machines these are identical to
+  the jpeg_get/free_small routines; but we keep them separate anyway,
+  in case a different allocation strategy is desirable for large chunks. }
+
+
+
+{GLOBAL}
+function jpeg_get_large (cinfo : j_common_ptr;
+                         sizeofobject : size_t) : voidp; {far}
+var
+  p : pointer;
+begin
+  GetMem(p, sizeofobject);
+  jpeg_get_large := p;
+end;
+
+{GLOBAL}
+procedure jpeg_free_large (cinfo : j_common_ptr;
+                          {var?} an_object : voidp; {FAR}
+                          sizeofobject : size_t);
+begin
+  Freemem(an_object, sizeofobject);
+end;
+
+{ This routine computes the total space still available for allocation by
+  jpeg_get_large.  If more space than this is needed, backing store will be
+  used.  NOTE: any memory already allocated must not be counted.
+
+  There is a minimum space requirement, corresponding to the minimum
+  feasible buffer sizes; jmemmgr.c will request that much space even if
+  jpeg_mem_available returns zero.  The maximum space needed, enough to hold
+  all working storage in memory, is also passed in case it is useful.
+  Finally, the total space already allocated is passed.  If no better
+  method is available, cinfo^.mem^.max_memory_to_use - already_allocated
+  is often a suitable calculation.
+
+  It is OK for jpeg_mem_available to underestimate the space available
+  (that'll just lead to more backing-store access than is really necessary).
+  However, an overestimate will lead to failure.  Hence it's wise to subtract
+  a slop factor from the true available space.  5% should be enough.
+
+  On machines with lots of virtual memory, any large constant may be returned.
+  Conversely, zero may be returned to always use the minimum amount of memory.}
+
+
+
+{ This routine computes the total memory space available for allocation.
+  It's impossible to do this in a portable way; our current solution is
+  to make the user tell us (with a default value set at compile time).
+  If you can actually get the available space, it's a good idea to subtract
+  a slop factor of 5% or so. }
+
+const
+  DEFAULT_MAX_MEM = long(300000);   { for total usage about 450K }
+
+{GLOBAL}
+function jpeg_mem_available (cinfo : j_common_ptr;
+                             min_bytes_needed : long;
+                             max_bytes_needed : long;
+                             already_allocated : long) : long;
+begin
+  {jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
+  jpeg_mem_available := max_bytes_needed;
+end;
+
+
+{ Initial opening of a backing-store object.  This must fill in the
+  read/write/close pointers in the object.  The read/write routines
+  may take an error exit if the specified maximum file size is exceeded.
+  (If jpeg_mem_available always returns a large value, this routine can
+  just take an error exit.) }
+
+
+
+{ Initial opening of a backing-store object. }
+
+{GLOBAL}
+procedure jpeg_open_backing_store (cinfo : j_common_ptr;
+                                   info : backing_store_ptr;
+                                   total_bytes_needed : long);
+begin
+  ERREXIT(cinfo, JERR_NO_BACKING_STORE);
+end;
+
+{ These routines take care of any system-dependent initialization and
+  cleanup required.  jpeg_mem_init will be called before anything is
+  allocated (and, therefore, nothing in cinfo is of use except the error
+  manager pointer).  It should return a suitable default value for
+  max_memory_to_use; this may subsequently be overridden by the surrounding
+  application.  (Note that max_memory_to_use is only important if
+  jpeg_mem_available chooses to consult it ... no one else will.)
+  jpeg_mem_term may assume that all requested memory has been freed and that
+  all opened backing-store objects have been closed. }
+
+
+{ These routines take care of any system-dependent initialization and
+  cleanup required. }
+
+
+{GLOBAL}
+function jpeg_mem_init (cinfo : j_common_ptr) : long;
+begin
+  jpeg_mem_init := DEFAULT_MAX_MEM;   { default for max_memory_to_use }
+end;
+
+{GLOBAL}
+procedure jpeg_mem_term (cinfo : j_common_ptr);
+begin
+
+end;
+
+
+end.

Imaging/JpegLib/imjmorecfg.pas

@@ -10,40 +10,13 @@ interface
 
 {$I imjconfig.inc}
 
-{$IFDEF FPC}  { Free Pascal Compiler }
-    type
-      int = longint;
-      uInt = Cardinal; { unsigned int }
-      short = Integer;
-      ushort = Word;
-      long = longint;
-{$ELSE}
-{$IFDEF WIN32}
-  { Delphi 2.0 }
-  type
-    int = Integer;
-    uInt = Cardinal;
-    short = SmallInt;
-    ushort = Word;
-    long = longint;
-  {$ELSE}
-    {$IFDEF VIRTUALPASCAL}
-    type
-      int = longint;
-      uInt = longint; { unsigned int }
-      short = system.Integer;
-      ushort = system.Word;
-      long = longint;
-    {$ELSE}
-    type
-      int = Integer;
-      uInt = Word; { unsigned int }
-      short = Integer;
-      ushort = Word;
-      long = longint;
-    {$ENDIF}
-{$ENDIF}
-{$ENDIF}
+type
+  int = Integer;
+  uInt = Cardinal;
+  short = SmallInt;
+  ushort = Word;
+  long = LongInt;
+
 type
   voidp = pointer;
 
@@ -58,6 +31,7 @@ type
   JPEG standard, and the IJG code does not support anything else!
   We do not support run-time selection of data precision, sorry. }
 
+
 {$ifdef BITS_IN_JSAMPLE_IS_8}   { use 8 or 12 }
 const
   BITS_IN_JSAMPLE = 8;
@@ -67,8 +41,6 @@ const
 {$endif}
 
 
-
-
 { Maximum number of components (color channels) allowed in JPEG image.
   To meet the letter of the JPEG spec, set this to 255.  However, darn
   few applications need more than 4 channels (maybe 5 for CMYK + alpha
@@ -159,7 +131,7 @@ type
 { UINT8 must hold at least the values 0..255. }
 
 type
-  UINT8 = byte;
+  UINT8 = Byte;
 
 { UINT16 must hold at least the values 0..65535. }
 
@@ -167,11 +139,11 @@ type
 
 { INT16 must hold at least the values -32768..32767. }
 
-  INT16 = int;
+  INT16 = SmallInt;
 
 { INT32 must hold at least signed 32-bit values. }
 
-  INT32 = longint;
+  INT32 = LongInt;
 type
   INT32PTR = ^INT32;
 

Imaging/JpegLib/imjpeglib.pas

@@ -722,7 +722,7 @@ type
     { Routine that actually outputs a trace or error message }
     output_message : procedure (cinfo : j_common_ptr);
     { Format a message string for the most recent JPEG error or message }
-    format_message : procedure  (cinfo : j_common_ptr; var buffer : string);
+    format_message : procedure  (cinfo : j_common_ptr; var buffer : AnsiString);
 
     { Reset error state variables at start of a new image }
     reset_error_mgr : procedure (cinfo : j_common_ptr);

Imaging/ZLib/iminffast.pas

@@ -1,318 +1,318 @@
-Unit iminffast;
-
-{
-  inffast.h and
-  inffast.c -- process literals and length/distance pairs fast
-  Copyright (C) 1995-1998 Mark Adler
-
-  Pascal tranlastion
-  Copyright (C) 1998 by Jacques Nomssi Nzali
-  For conditions of distribution and use, see copyright notice in readme.txt
-}
-
-
-interface
-
-{$I imzconf.inc}
-
-uses
-  {$ifdef DEBUG}
-  SysUtils, strutils,
-  {$ENDIF}
-  imzutil, impaszlib;
-
-function inflate_fast( bl : uInt;
-                       bd : uInt;
-                       tl : pInflate_huft;
-                       td : pInflate_huft;
-                      var s : inflate_blocks_state;
-                      var z : z_stream) : int;
-
-
-implementation
-
-uses
-  iminfutil;
-
-
-{ Called with number of bytes left to write in window at least 258
-  (the maximum string length) and number of input bytes available
-  at least ten.  The ten bytes are six bytes for the longest length/
-  distance pair plus four bytes for overloading the bit buffer. }
-
-function inflate_fast( bl : uInt;
-                       bd : uInt;
-                       tl : pInflate_huft;
-                       td : pInflate_huft;
-                      var s : inflate_blocks_state;
-                      var z : z_stream) : int;
-
-var
-  t : pInflate_huft;      { temporary pointer }
-  e : uInt;               { extra bits or operation }
-  b : uLong;              { bit buffer }
-  k : uInt;               { bits in bit buffer }
-  p : pBytef;             { input data pointer }
-  n : uInt;               { bytes available there }
-  q : pBytef;             { output window write pointer }
-  m : uInt;               { bytes to end of window or read pointer }
-  ml : uInt;              { mask for literal/length tree }
-  md : uInt;              { mask for distance tree }
-  c : uInt;               { bytes to copy }
-  d : uInt;               { distance back to copy from }
-  r : pBytef;             { copy source pointer }
-begin
-  { load input, output, bit values (macro LOAD) }
-  p := z.next_in;
-  n := z.avail_in;
-  b := s.bitb;
-  k := s.bitk;
-  q := s.write;
-  if ptr2int(q) < ptr2int(s.read) then
-    m := uInt(ptr2int(s.read)-ptr2int(q)-1)
-  else
-    m := uInt(ptr2int(s.zend)-ptr2int(q));
-
-  { initialize masks }
-  ml := inflate_mask[bl];
-  md := inflate_mask[bd];
-
-  { do until not enough input or output space for fast loop }
-  repeat                      { assume called with (m >= 258) and (n >= 10) }
-    { get literal/length code }
-    {GRABBITS(20);}             { max bits for literal/length code }
-    while (k < 20) do
-    begin
-      Dec(n);
-      b := b or (uLong(p^) shl k);
-      Inc(p);
-      Inc(k, 8);
-    end;
-
-    t := @(huft_ptr(tl)^[uInt(b) and ml]);
-
-    e := t^.exop;
-    if (e = 0) then
-    begin
-      {DUMPBITS(t^.bits);}
-      b := b shr t^.bits;
-      Dec(k, t^.bits);
-     {$IFDEF DEBUG}
-      if (t^.base >= $20) and (t^.base < $7f) then
-        Tracevv('inflate:         * literal '+AnsiChar(t^.base))
-      else
-        Tracevv('inflate:         * literal '+ IntToStr(t^.base));
-      {$ENDIF}
-      q^ := Byte(t^.base);
-      Inc(q);
-      Dec(m);
-      continue;
-    end;
-    repeat
-      {DUMPBITS(t^.bits);}
-      b := b shr t^.bits;
-      Dec(k, t^.bits);
-
-      if (e and 16 <> 0) then
-      begin
-        { get extra bits for length }
-        e := e and 15;
-        c := t^.base + (uInt(b) and inflate_mask[e]);
-        {DUMPBITS(e);}
-        b := b shr e;
-        Dec(k, e);
-        {$IFDEF DEBUG}
-        Tracevv('inflate:         * length ' + IntToStr(c));
-        {$ENDIF}
-        { decode distance base of block to copy }
-        {GRABBITS(15);}           { max bits for distance code }
-        while (k < 15) do
-        begin
-          Dec(n);
-          b := b or (uLong(p^) shl k);
-          Inc(p);
-          Inc(k, 8);
-        end;
-
-        t := @huft_ptr(td)^[uInt(b) and md];
-        e := t^.exop;
-        repeat
-          {DUMPBITS(t^.bits);}
-          b := b shr t^.bits;
-          Dec(k, t^.bits);
-
-          if (e and 16 <> 0) then
-          begin
-            { get extra bits to add to distance base }
-            e := e and 15;
-            {GRABBITS(e);}         { get extra bits (up to 13) }
-            while (k < e) do
-            begin
-              Dec(n);
-              b := b or (uLong(p^) shl k);
-              Inc(p);
-              Inc(k, 8);
-            end;
-
-            d := t^.base + (uInt(b) and inflate_mask[e]);
-            {DUMPBITS(e);}
-            b := b shr e;
-            Dec(k, e);
-
-            {$IFDEF DEBUG}
-            Tracevv('inflate:         * distance '+IntToStr(d));
-            {$ENDIF}
-            { do the copy }
-            Dec(m, c);
-            if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then     { offset before dest }
-            begin                                  {  just copy }
-              r := q;
-              Dec(r, d);
-              q^ := r^;  Inc(q); Inc(r); Dec(c); { minimum count is three, }
-              q^ := r^;  Inc(q); Inc(r); Dec(c); { so unroll loop a little }
-            end
-            else                        { else offset after destination }
-            begin
-              e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
-              r := s.zend;
-              Dec(r, e);                  { pointer to offset }
-              if (c > e) then             { if source crosses, }
-              begin
-                Dec(c, e);                { copy to end of window }
-                repeat
-                  q^ := r^;
-                  Inc(q);
-                  Inc(r);
-                  Dec(e);
-                until (e=0);
-                r := s.window;           { copy rest from start of window }
-              end;
-            end;
-            repeat                       { copy all or what's left }
-              q^ := r^;
-              Inc(q);
-              Inc(r);
-              Dec(c);
-            until (c = 0);
-            break;
-          end
-          else
-            if (e and 64 = 0) then
-            begin
-              Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
-              e := t^.exop;
-            end
-          else
-          begin
-            z.msg := 'invalid distance code';
-            {UNGRAB}
-            c := z.avail_in-n;
-            if (k shr 3) < c then
-              c := k shr 3;
-            Inc(n, c);
-            Dec(p, c);
-            Dec(k, c shl 3);
-            {UPDATE}
-            s.bitb := b;
-            s.bitk := k;
-            z.avail_in := n;
-            Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-            z.next_in := p;
-            s.write := q;
-
-            inflate_fast := Z_DATA_ERROR;
-            exit;
-          end;
-        until FALSE;
-        break;
-      end;
-      if (e and 64 = 0) then
-      begin
-         {t += t->base;
-          e = (t += ((uInt)b & inflate_mask[e]))->exop;}
-
-        Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
-        e := t^.exop;
-        if (e = 0) then
-        begin
-          {DUMPBITS(t^.bits);}
-          b := b shr t^.bits;
-          Dec(k, t^.bits);
-
-         {$IFDEF DEBUG}
-          if (t^.base >= $20) and (t^.base < $7f) then
-            Tracevv('inflate:         * literal '+AnsiChar(t^.base))
-          else
-            Tracevv('inflate:         * literal '+IntToStr(t^.base));
-          {$ENDIF}            
-          q^ := Byte(t^.base);
-          Inc(q);
-          Dec(m);
-          break;
-        end;
-      end
-      else
-        if (e and 32 <> 0) then
-        begin
-          {$IFDEF DEBUG}
-          Tracevv('inflate:         * end of block');
-          {$ENDIF}
-          {UNGRAB}
-          c := z.avail_in-n;
-          if (k shr 3) < c then
-            c := k shr 3;
-          Inc(n, c);
-          Dec(p, c);
-          Dec(k, c shl 3);
-          {UPDATE}
-          s.bitb := b;
-          s.bitk := k;
-          z.avail_in := n;
-          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-          z.next_in := p;
-          s.write := q;
-          inflate_fast := Z_STREAM_END;
-          exit;
-        end
-        else
-        begin
-          z.msg := 'invalid literal/length code';
-          {UNGRAB}
-          c := z.avail_in-n;
-          if (k shr 3) < c then
-            c := k shr 3;
-          Inc(n, c);
-          Dec(p, c);
-          Dec(k, c shl 3);
-          {UPDATE}
-          s.bitb := b;
-          s.bitk := k;
-          z.avail_in := n;
-          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-          z.next_in := p;
-          s.write := q;
-          inflate_fast := Z_DATA_ERROR;
-          exit;
-        end;
-    until FALSE;
-  until (m < 258) or (n < 10);
-
-  { not enough input or output--restore pointers and return }
-  {UNGRAB}
-  c := z.avail_in-n;
-  if (k shr 3) < c then
-    c := k shr 3;
-  Inc(n, c);
-  Dec(p, c);
-  Dec(k, c shl 3);
-  {UPDATE}
-  s.bitb := b;
-  s.bitk := k;
-  z.avail_in := n;
-  Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-  z.next_in := p;
-  s.write := q;
-  inflate_fast := Z_OK;
-end;
-
-end.
+Unit iminffast;
+
+{
+  inffast.h and
+  inffast.c -- process literals and length/distance pairs fast
+  Copyright (C) 1995-1998 Mark Adler
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+
+interface
+
+{$I imzconf.inc}
+
+uses
+  {$ifdef DEBUG}
+  SysUtils, strutils,
+  {$ENDIF}
+  imzutil, impaszlib;
+
+function inflate_fast( bl : uInt;
+                       bd : uInt;
+                       tl : pInflate_huft;
+                       td : pInflate_huft;
+                      var s : inflate_blocks_state;
+                      var z : z_stream) : int;
+
+
+implementation
+
+uses
+  iminfutil;
+
+
+{ Called with number of bytes left to write in window at least 258
+  (the maximum string length) and number of input bytes available
+  at least ten.  The ten bytes are six bytes for the longest length/
+  distance pair plus four bytes for overloading the bit buffer. }
+
+function inflate_fast( bl : uInt;
+                       bd : uInt;
+                       tl : pInflate_huft;
+                       td : pInflate_huft;
+                      var s : inflate_blocks_state;
+                      var z : z_stream) : int;
+
+var
+  t : pInflate_huft;      { temporary pointer }
+  e : uInt;               { extra bits or operation }
+  b : uLong;              { bit buffer }
+  k : uInt;               { bits in bit buffer }
+  p : pBytef;             { input data pointer }
+  n : uInt;               { bytes available there }
+  q : pBytef;             { output window write pointer }
+  m : uInt;               { bytes to end of window or read pointer }
+  ml : uInt;              { mask for literal/length tree }
+  md : uInt;              { mask for distance tree }
+  c : uInt;               { bytes to copy }
+  d : uInt;               { distance back to copy from }
+  r : pBytef;             { copy source pointer }
+begin
+  { load input, output, bit values (macro LOAD) }
+  p := z.next_in;
+  n := z.avail_in;
+  b := s.bitb;
+  k := s.bitk;
+  q := s.write;
+  if ptr2int(q) < ptr2int(s.read) then
+    m := uInt(ptr2int(s.read)-ptr2int(q)-1)
+  else
+    m := uInt(ptr2int(s.zend)-ptr2int(q));
+
+  { initialize masks }
+  ml := inflate_mask[bl];
+  md := inflate_mask[bd];
+
+  { do until not enough input or output space for fast loop }
+  repeat                      { assume called with (m >= 258) and (n >= 10) }
+    { get literal/length code }
+    {GRABBITS(20);}             { max bits for literal/length code }
+    while (k < 20) do
+    begin
+      Dec(n);
+      b := b or (uLong(p^) shl k);
+      Inc(p);
+      Inc(k, 8);
+    end;
+
+    t := @(huft_ptr(tl)^[uInt(b) and ml]);
+
+    e := t^.exop;
+    if (e = 0) then
+    begin
+      {DUMPBITS(t^.bits);}
+      b := b shr t^.bits;
+      Dec(k, t^.bits);
+     {$IFDEF DEBUG}
+      if (t^.base >= $20) and (t^.base < $7f) then
+        Tracevv('inflate:         * literal '+AnsiChar(t^.base))
+      else
+        Tracevv('inflate:         * literal '+ IntToStr(t^.base));
+      {$ENDIF}
+      q^ := Byte(t^.base);
+      Inc(q);
+      Dec(m);
+      continue;
+    end;
+    repeat
+      {DUMPBITS(t^.bits);}
+      b := b shr t^.bits;
+      Dec(k, t^.bits);
+
+      if (e and 16 <> 0) then
+      begin
+        { get extra bits for length }
+        e := e and 15;
+        c := t^.base + (uInt(b) and inflate_mask[e]);
+        {DUMPBITS(e);}
+        b := b shr e;
+        Dec(k, e);
+        {$IFDEF DEBUG}
+        Tracevv('inflate:         * length ' + IntToStr(c));
+        {$ENDIF}
+        { decode distance base of block to copy }
+        {GRABBITS(15);}           { max bits for distance code }
+        while (k < 15) do
+        begin
+          Dec(n);
+          b := b or (uLong(p^) shl k);
+          Inc(p);
+          Inc(k, 8);
+        end;
+
+        t := @huft_ptr(td)^[uInt(b) and md];
+        e := t^.exop;
+        repeat
+          {DUMPBITS(t^.bits);}
+          b := b shr t^.bits;
+          Dec(k, t^.bits);
+
+          if (e and 16 <> 0) then
+          begin
+            { get extra bits to add to distance base }
+            e := e and 15;
+            {GRABBITS(e);}         { get extra bits (up to 13) }
+            while (k < e) do
+            begin
+              Dec(n);
+              b := b or (uLong(p^) shl k);
+              Inc(p);
+              Inc(k, 8);
+            end;
+
+            d := t^.base + (uInt(b) and inflate_mask[e]);
+            {DUMPBITS(e);}
+            b := b shr e;
+            Dec(k, e);
+
+            {$IFDEF DEBUG}
+            Tracevv('inflate:         * distance '+IntToStr(d));
+            {$ENDIF}
+            { do the copy }
+            Dec(m, c);
+            if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then     { offset before dest }
+            begin                                  {  just copy }
+              r := q;
+              Dec(r, d);
+              q^ := r^;  Inc(q); Inc(r); Dec(c); { minimum count is three, }
+              q^ := r^;  Inc(q); Inc(r); Dec(c); { so unroll loop a little }
+            end
+            else                        { else offset after destination }
+            begin
+              e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
+              r := s.zend;
+              Dec(r, e);                  { pointer to offset }
+              if (c > e) then             { if source crosses, }
+              begin
+                Dec(c, e);                { copy to end of window }
+                repeat
+                  q^ := r^;
+                  Inc(q);
+                  Inc(r);
+                  Dec(e);
+                until (e=0);
+                r := s.window;           { copy rest from start of window }
+              end;
+            end;
+            repeat                       { copy all or what's left }
+              q^ := r^;
+              Inc(q);
+              Inc(r);
+              Dec(c);
+            until (c = 0);
+            break;
+          end
+          else
+            if (e and 64 = 0) then
+            begin
+              Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
+              e := t^.exop;
+            end
+          else
+          begin
+            z.msg := 'invalid distance code';
+            {UNGRAB}
+            c := z.avail_in-n;
+            if (k shr 3) < c then
+              c := k shr 3;
+            Inc(n, c);
+            Dec(p, c);
+            Dec(k, c shl 3);
+            {UPDATE}
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+            z.next_in := p;
+            s.write := q;
+
+            inflate_fast := Z_DATA_ERROR;
+            exit;
+          end;
+        until FALSE;
+        break;
+      end;
+      if (e and 64 = 0) then
+      begin
+         {t += t->base;
+          e = (t += ((uInt)b & inflate_mask[e]))->exop;}
+
+        Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
+        e := t^.exop;
+        if (e = 0) then
+        begin
+          {DUMPBITS(t^.bits);}
+          b := b shr t^.bits;
+          Dec(k, t^.bits);
+
+         {$IFDEF DEBUG}
+          if (t^.base >= $20) and (t^.base < $7f) then
+            Tracevv('inflate:         * literal '+AnsiChar(t^.base))
+          else
+            Tracevv('inflate:         * literal '+IntToStr(t^.base));
+          {$ENDIF}            
+          q^ := Byte(t^.base);
+          Inc(q);
+          Dec(m);
+          break;
+        end;
+      end
+      else
+        if (e and 32 <> 0) then
+        begin
+          {$IFDEF DEBUG}
+          Tracevv('inflate:         * end of block');
+          {$ENDIF}
+          {UNGRAB}
+          c := z.avail_in-n;
+          if (k shr 3) < c then
+            c := k shr 3;
+          Inc(n, c);
+          Dec(p, c);
+          Dec(k, c shl 3);
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_fast := Z_STREAM_END;
+          exit;
+        end
+        else
+        begin
+          z.msg := 'invalid literal/length code';
+          {UNGRAB}
+          c := z.avail_in-n;
+          if (k shr 3) < c then
+            c := k shr 3;
+          Inc(n, c);
+          Dec(p, c);
+          Dec(k, c shl 3);
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_fast := Z_DATA_ERROR;
+          exit;
+        end;
+    until FALSE;
+  until (m < 258) or (n < 10);
+
+  { not enough input or output--restore pointers and return }
+  {UNGRAB}
+  c := z.avail_in-n;
+  if (k shr 3) < c then
+    c := k shr 3;
+  Inc(n, c);
+  Dec(p, c);
+  Dec(k, c shl 3);
+  {UPDATE}
+  s.bitb := b;
+  s.bitk := k;
+  z.avail_in := n;
+  Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+  z.next_in := p;
+  s.write := q;
+  inflate_fast := Z_OK;
+end;
+
+end.