├── .gitattributes
├── .gitignore
├── LICENSE
├── README.md
├── buildres.bat
├── memory.pas
├── project1.ico
├── project1.lpi
├── project1.lpr
├── project1.lps
├── project1.res
├── reclist.pas
├── unicodehelper.pas
├── vtxcolordlg.lfm
├── vtxcolordlg.lrs
├── vtxcolordlg.pas
├── vtxconst.pas
├── vtxcursors.lrs
├── vtxedit.ico
├── vtxedit.ini
├── vtxedit.lfm
├── vtxedit.lrs
├── vtxedit.pas
├── vtxencdetect.pas
├── vtxexportoptions.lfm
├── vtxexportoptions.lrs
├── vtxexportoptions.pas
├── vtxpreviewbox.lfm
├── vtxpreviewbox.pas
├── vtxsupport.pas
└── work
├── MicroKnightPlus_v1.0.raw
├── MicroKnight_v1.0.raw
├── P0T-NOoDLE_v1.0.raw
├── TopazPlus_a1200_v1.0.raw
├── TopazPlus_a500_v1.0.raw
├── Topaz_a1200_v1.0.raw
├── Topaz_a500_v1.0.raw
├── c0.cur
├── c0.png
├── c1.cur
├── c1.png
├── c2.cur
├── c2.png
├── c3.cur
├── c3.png
├── c4.cur
├── c4.png
├── c5.cur
├── c5.png
├── c6.cur
├── c6.png
├── c7.cur
├── c7.png
├── c8.cur
├── c8.png
├── c9.cur
├── c9.png
├── cursors.png
├── grayicons.png
├── icons.cdr
├── icons.png
├── mO'sOul_v1.0.raw
└── u_vga16.bdf
/.gitattributes:
--------------------------------------------------------------------------------
1 | # Auto detect text files and perform LF normalization
2 | * text=auto
3 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | # Created by https://www.gitignore.io/api/windows,lazarus,freepascal
2 |
3 | ### FreePascal ###
4 | *.lps
5 | *.compiled
6 | *.[oa]
7 | *.ppu
8 | *.rst
9 | *.cgi
10 | *.exe
11 | *.log
12 | tabs.ini
13 | *.bak*
14 | fp.ini
15 | fp.cfg
16 | fp.dsk
17 |
18 | ### Lazarus ###
19 | # Lazarus compiler-generated binaries (safe to delete)
20 | *.dll
21 | *.so
22 | *.dylib
23 | *.res
24 | *.dbg
25 | *.o
26 | *.or
27 | *.a
28 |
29 | # Lazarus autogenerated files (duplicated info)
30 | *.rsj
31 | *.lrt
32 |
33 | # Lazarus local files (user-specific info)
34 | *.lps
35 |
36 | # Lazarus backups and unit output folders.
37 | # These can be changed by user in Lazarus/project options.
38 | backup/
39 | *.bak
40 | lib/
41 |
42 | # Application bundle for Mac OS
43 | *.app/
44 |
45 | ### Windows ###
46 | # Windows thumbnail cache files
47 | Thumbs.db
48 | ehthumbs.db
49 | ehthumbs_vista.db
50 |
51 | # Folder config file
52 | Desktop.ini
53 |
54 | # Recycle Bin used on file shares
55 | $RECYCLE.BIN/
56 |
57 | # Windows Installer files
58 | *.cab
59 | *.msi
60 | *.msm
61 | *.msp
62 |
63 | # Windows shortcuts
64 | *.lnk
65 |
66 | # CorelDraw backups
67 | Backup_of_*
68 |
69 | # End of https://www.gitignore.io/api/windows,lazarus,freepascal
70 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | BSD 2-Clause License
2 |
3 | Copyright (c) 2017, Daniel Mecklenburg Jr.
4 | All rights reserved.
5 |
6 | Redistribution and use in source and binary forms, with or without
7 | modification, are permitted provided that the following conditions are met:
8 |
9 | * Redistributions of source code must retain the above copyright notice, this
10 | list of conditions and the following disclaimer.
11 |
12 | * Redistributions in binary form must reproduce the above copyright notice,
13 | this list of conditions and the following disclaimer in the documentation
14 | and/or other materials provided with the distribution.
15 |
16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
17 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
20 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
22 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
23 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
24 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # VTXEdit
2 | VTX ANSI Editor.
3 |
4 | ## Building
5 | ### Dependencies
6 | * Package: [BGRABitmapPack](https://github.com/bgrabitmap/bgrabitmap/)
7 |
8 | #### Linux
9 | You will need at least the following libs (packages listed for Ubuntu type distros; adjust accordingly):
10 | ```
11 | sudo apt-get install libgtk2.0-dev
12 | ```
13 |
--------------------------------------------------------------------------------
/buildres.bat:
--------------------------------------------------------------------------------
1 | rem need appropriate script for linux
2 | rem lazres is in the lazarus\tools path
3 |
4 | @echo off
5 |
6 | set PATH=%PATH%;C:\lazarus\tools;
7 |
8 | echo work\c0.cur > lrs.tmp
9 | echo work\c1.cur >> lrs.tmp
10 | echo work\c2.cur >> lrs.tmp
11 | echo work\c3.cur >> lrs.tmp
12 | echo work\c4.cur >> lrs.tmp
13 | echo work\c5.cur >> lrs.tmp
14 | echo work\c6.cur >> lrs.tmp
15 | echo work\c7.cur >> lrs.tmp
16 | echo work\c8.cur >> lrs.tmp
17 | echo work\c9.cur >> lrs.tmp
18 | rem echo work\c4.cur >> lrs.tmp
19 |
20 | lazres vtxcursors.lrs @lrs.tmp
21 |
22 | del lrs.tmp
23 |
--------------------------------------------------------------------------------
/memory.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | unit Memory;
31 |
32 | {$mode objfpc}{$H+}
33 | {$modeswitch advancedrecords}
34 | {$ASMMODE intel}
35 |
36 | interface
37 |
38 | uses
39 | Classes, SysUtils;
40 |
41 | procedure MemZero(dst : Pointer; size : longint); inline;
42 | procedure MemFill(dst : Pointer; size : longint; val : byte); inline;
43 | procedure MemCopy(src, dst : Pointer; size : longint); inline;
44 | function MemComp(src, dst : Pointer; size : longint) : boolean; inline;
45 |
46 | implementation
47 |
48 | procedure MemZero(dst : Pointer; size : longint); inline;
49 | begin
50 | FillByte(dst^, size, $00);
51 | // asm
52 | // MOV EDI, dst
53 | // MOV ECX, size
54 | // XOR AL, AL
55 | // REP STOSB
56 | // end ['AL', 'EDI', 'ECX'];
57 | end;
58 |
59 | procedure MemFill(dst : Pointer; size : longint; val : byte); inline;
60 | begin
61 | FillByte(dst^, size, val);
62 | // asm
63 | // MOV EDI, dst
64 | // MOV ECX, size
65 | // MOV AL, val
66 | // REP STOSB
67 | // end ['AL', 'EDI', 'ECX'];
68 | end;
69 |
70 | procedure MemCopy(src, dst : Pointer; size : longint); inline;
71 | begin
72 | Move(src^, dst^, size);
73 | // asm
74 | // MOV ESI, src
75 | // MOV EDI, dst
76 | // MOV ECX, size
77 | // REP MOVSB
78 | // end ['ESI', 'EDI', 'ECX'];
79 | end;
80 |
81 | function MemComp(src, dst : Pointer; size : longint) : boolean; inline;
82 | //label
83 | // done;
84 | begin
85 | result := CompareMem(src,dst,size);
86 | // asm
87 | // MOV result, $01
88 | // MOV ESI, src
89 | // MOV EDI, dst
90 | // MOV ECX, size
91 | // REPE CMPSB
92 | // JZ DONE
93 | // DEC result
94 | //DONE:
95 | // end;
96 | end;
97 |
98 | end.
99 |
100 |
--------------------------------------------------------------------------------
/project1.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/project1.ico
--------------------------------------------------------------------------------
/project1.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 |
166 |
167 |
168 |
169 |
170 |
171 |
172 |
173 |
174 |
175 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
189 |
--------------------------------------------------------------------------------
/project1.lpr:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | program project1;
31 |
32 | {$mode objfpc}{$H+}
33 |
34 | uses
35 | {$IFDEF UNIX}{$IFDEF UseCThreads}
36 | cthreads,
37 | {$ENDIF}{$ENDIF}
38 | Interfaces, // this includes the LCL widgetset
39 | Forms,
40 | VTXEdit;
41 |
42 | {$R *.res}
43 |
44 | begin
45 | Application.Title:='VTXEdit';
46 | RequireDerivedFormResource:=True;
47 | Application.Initialize;
48 | Application.CreateForm(TfMain, fMain);
49 | Application.Run;
50 | end.
51 |
52 |
53 |
--------------------------------------------------------------------------------
/project1.lps:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 |
166 |
167 |
168 |
169 |
170 |
171 |
172 |
173 |
174 |
175 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
189 |
190 |
191 |
192 |
193 |
194 |
195 |
196 |
197 |
198 |
199 |
200 |
201 |
202 |
203 |
204 |
205 |
206 |
207 |
208 |
209 |
210 |
211 |
212 |
213 |
214 |
215 |
216 |
217 |
218 |
219 |
220 |
221 |
222 |
223 |
224 |
225 |
226 |
227 |
228 |
229 |
230 |
231 |
232 |
233 |
234 |
235 |
236 |
237 |
238 |
239 |
240 |
241 |
242 |
243 |
244 |
245 |
246 |
247 |
248 |
249 |
250 |
251 |
252 |
253 |
254 |
255 |
256 |
257 |
258 |
259 |
260 |
261 |
262 |
263 |
264 |
265 |
266 |
267 |
268 |
269 |
270 |
271 |
272 |
273 |
274 |
275 |
276 |
277 |
278 |
279 |
280 |
281 |
282 |
283 |
284 |
285 |
286 |
287 |
288 |
289 |
290 |
291 |
292 |
293 |
294 |
295 |
296 |
297 |
298 |
299 |
300 |
301 |
302 |
303 |
304 |
305 |
306 |
307 |
308 |
309 |
310 |
311 |
312 |
313 |
314 |
315 |
316 |
317 |
318 |
319 |
320 |
321 |
322 |
323 |
324 |
325 |
326 |
327 |
328 |
329 |
330 |
331 |
332 |
333 |
334 |
335 |
336 |
337 |
338 |
339 |
340 |
341 |
342 |
343 |
344 |
345 |
346 |
347 |
348 |
349 |
350 |
351 |
352 |
353 |
354 |
355 |
356 |
357 |
358 |
359 |
360 |
361 |
362 |
363 |
364 |
365 |
366 |
367 |
368 |
369 |
370 |
371 |
372 |
373 |
374 |
375 |
376 |
377 |
378 |
379 |
380 |
381 |
382 |
383 |
384 |
--------------------------------------------------------------------------------
/project1.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/project1.res
--------------------------------------------------------------------------------
/reclist.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | {
31 | Generic record lists using byte buffer data.
32 | }
33 | unit RecList;
34 |
35 | {$mode objfpc}{$H+}
36 | {$modeswitch advancedrecords}
37 | {$asmmode intel}
38 |
39 | interface
40 |
41 | uses
42 | Classes, SysUtils, Memory;
43 |
44 | type
45 | TRecListExpansion = ( rleDoubles, rleAdds );
46 |
47 | TRecList = record
48 | Data : PBYTE; // pointer to data records
49 | Count : DWORD; // current number of records in Data.
50 | Size : DWORD; // current allocated space
51 | RecSize : DWORD;
52 | Flags : BYTE;
53 | procedure Create(recsz : DWORD; expansion : TRecListExpansion);
54 | procedure Free;
55 | procedure Add(rec : Pointer); // add new record
56 | procedure Remove(recnum : DWORD);
57 | procedure Push(rec : Pointer);
58 | procedure Pop(rec : Pointer);
59 | procedure Put(rec : Pointer; recnum : DWORD);
60 | procedure Get(rec : Pointer; recnum : DWORD);
61 | procedure Clear;
62 | function Copy : TRecList;
63 | procedure Swap(rec1, rec2 : DWORD);
64 | procedure Trim;
65 | function Locked : Boolean;
66 | end;
67 |
68 | implementation
69 |
70 | const
71 | TRECLIST_INITSIZE = 16; // initial number of records allocated on create
72 | TRECLIST_LOCKED = %00000001; // object size is locked. no additions or removals allowed.
73 | TRECLIST_ADDEXPAND = %00000010; // of set, size increases by recsize instead of doubles.
74 |
75 | procedure TRecList.Create(recsz : DWORD; expansion : TRecListExpansion);
76 | begin
77 | self.RecSize := recsz;
78 | self.Count := 0;
79 | self.Size := TRECLIST_INITSIZE;
80 | self.Data := GetMemory(self.RecSize * Size);
81 | FillByte(self.Data[0], self.RecSize * Size, $00);
82 | self.Flags := %00000000;
83 | if expansion = rleAdds then
84 | self.Flags := (self.Flags or TRECLIST_ADDEXPAND);
85 | end;
86 |
87 | function TRecList.Locked : boolean;
88 | begin
89 | result := ((self.Flags and TRECLIST_LOCKED) <> 0);
90 | end;
91 |
92 | procedure TRecList.Free;
93 | begin
94 | if self.Size > 0 then
95 | Freememory(self.Data);
96 | self.Size := 0;
97 | self.Count := 0;
98 | end;
99 |
100 | procedure TRecList.Push(rec : Pointer);
101 | begin
102 | self.Add(rec);
103 | end;
104 |
105 | procedure TRecList.Add(rec : Pointer);
106 | var
107 | newsz : DWORD;
108 | newdata : PBYTE;
109 | begin
110 |
111 | if (self.Flags and TRECLIST_LOCKED) <> 0 then
112 | raise Exception.Create('TRecList Locked.');
113 |
114 | if Count >= Size then
115 | begin
116 | // grow the data
117 | if (self.Flags and TRECLIST_ADDEXPAND) <> 0 then
118 | newsz := self.Size + (TRECLIST_INITSIZE * self.RecSize)
119 | else
120 | newsz := self.Size << 1;
121 |
122 | newdata := getmemory(newsz * self.RecSize);
123 | MemFill(newdata, newsz * self.RecSize, $00);
124 | MemCopy(self.Data, newdata, self.Size * self.RecSize);
125 | FreeMemory(self.Data);
126 | self.Data := newdata;
127 | self.Size := newsz;
128 | end;
129 |
130 | MemCopy(rec, @self.Data[self.Count * self.RecSize], self.RecSize);
131 | self.Count += 1;
132 | end;
133 |
134 | procedure TRecList.Pop(rec : Pointer);
135 | begin
136 | if self.Count = 0 then
137 | raise Exception.Create('TRecList Stack Underflow.');
138 | self.Get(rec, self.Count - 1);
139 | self.Count -= 1;
140 | end;
141 |
142 | procedure TRecList.Remove(recnum : DWORD);
143 | var
144 | totsz : DWORD;
145 | endsz : DWORD;
146 | begin
147 |
148 | if (self.Flags and TRECLIST_LOCKED) <> 0 then
149 | raise Exception.Create('TRecList Locked.');
150 |
151 | if recnum >= self.Count then
152 | raise Exception.Create('TRecList Out of Bounds.');
153 |
154 | totsz := (self.RecSize * self.Size);
155 | endsz := totsz - ((recnum + 1) * self.RecSize);
156 | move(
157 | self.Data[(recnum + 1) * self.RecSize],
158 | self.Data[recnum * self.RecSize],
159 | endsz);
160 | self.Count -= 1;
161 | end;
162 |
163 | procedure TRecList.Put(rec : Pointer; recnum : DWORD);
164 | begin
165 | if recnum >= self.Count then
166 | raise Exception.Create('TRecList Out of Bounds.');
167 |
168 | MemCopy(rec, @self.Data[recnum * self.RecSize], self.RecSize);
169 | end;
170 |
171 | procedure TRecList.Get(rec : Pointer; recnum : DWORD);
172 | begin
173 | if recnum >= self.Count then
174 | raise Exception.Create('TRecList Out of Bounds.');
175 |
176 | MemCopy(@self.Data[recnum * self.RecSize], rec, self.RecSize);
177 | end;
178 |
179 | procedure TRecList.Clear;
180 | begin
181 | FreeMemory(self.Data);
182 | self.Count := 0;
183 | self.Size := TRECLIST_INITSIZE;
184 | self.Data := GetMemory(self.RecSize * Size);
185 | end;
186 |
187 | // create copy of TRecList
188 | // WARNING : CLEAR ANY DATA INSIDE THAT CONTAINS OTHER TRECLISTS
189 | function TRecList.Copy : TRecList;
190 | var
191 | memsize : longint;
192 | begin
193 | result.Count := self.Count;
194 | result.RecSize := self.RecSize;
195 | result.Size := self.Size;
196 | memsize := self.RecSize * self.Size;
197 | result.Data := Getmemory(memsize);
198 | MemCopy(self.Data, result.Data, memsize);
199 | end;
200 |
201 | // swap contents of two recors.
202 | procedure TRecList.Swap(rec1, rec2 : DWORD);
203 | var
204 | idx1, idx2 : DWORD;
205 | tmp : PBYTE;
206 | begin
207 | if (rec1 >= self.Count) or (rec2 >= self.Count) then
208 | raise Exception.Create('TRecList Out of Bounds.');
209 |
210 | tmp := GetMemory(self.RecSize);
211 | idx1 := rec1 * self.RecSize;
212 | idx2 := rec2 * self.RecSize;
213 |
214 | MemCopy(@self.Data[idx1], tmp, self.RecSize);
215 | MemCopy(@self.Data[idx2], @self.Data[idx1], self.RecSize);
216 | MemCopy(tmp, @self.Data[idx2], self.RecSize);
217 | FreeMemory(tmp);
218 | end;
219 |
220 | // trim memory/ used when rec is not expecet to grow any more.
221 | procedure TRecList.Trim;
222 | var
223 | tmp : PBYTE;
224 | l : DWORD;
225 | begin
226 | l := self.Count * self.RecSize;
227 | tmp := GetMemory(l);
228 | MemCopy(self.Data, tmp, l);
229 | Freememory(self.Data);
230 | self.Data := tmp;
231 | self.Flags := self.Flags or TRECLIST_LOCKED;
232 | end;
233 |
234 | end.
235 |
236 |
--------------------------------------------------------------------------------
/unicodehelper.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | unit UnicodeHelper;
31 |
32 | {$mode objfpc}{$H+}
33 | {$modeswitch typehelpers}
34 |
35 | interface
36 |
37 | uses
38 | SysUtils;
39 |
40 | type
41 |
42 | TUnicodeStringArray = array of UnicodeString;
43 |
44 | TWords = array of Word;
45 |
46 | TWideChars = array of WideChar;
47 |
48 | TWideCharHelper = type helper for WideChar
49 | public
50 | function getUTF8Length : integer; // from 1 to 3 (4=not yet).
51 | function getUTF16Length : integer; // always 2
52 | function getCPLength : integer; // always 1
53 | function toCharCode : integer;
54 | function fromCharCode(chr : integer) : WideChar;
55 | end;
56 |
57 | TUnicodeStringHelper = type helper for UnicodeString
58 | public
59 | function length : integer; overload;
60 | function substring(index : Integer): unicodestring; overload;
61 | function substring(index : Integer; len : Integer): unicodestring; overload;
62 | function charCodeAt(index : integer) : integer;
63 | function charAt(index : integer) : WideChar;
64 | function split(const Separators: array of WideChar): TUnicodeStringArray; overload;
65 | // other String Helper type functions can be added as required.
66 |
67 | function toWideCharArray : TWideChars;
68 | function toWordArray : TWords;
69 |
70 | function toUTF8Bytes : TBytes;
71 | function toUTF16Bytes : TBytes;
72 | function toCPBytes : TBytes;
73 |
74 | function toEncodedCPBytes(table : PWord) : TBytes;
75 |
76 | function getUTF8BytesLength : integer; // varies
77 | function getUTF16BytesLength : integer; // length * 2
78 | function getCPBytesLength : integer; // length
79 |
80 | function fromUTF8Bytes(bytes : TBytes) : UnicodeString;
81 | function fromUTF16Bytes(bytes : TBytes) : UnicodeString;
82 | function fromCPBytes(bytes : TBytes) : UnicodeString;
83 |
84 | function hasUTF8BrokenBytes(bytes : TBytes) : boolean;
85 | function hasUTF16BrokenBytes(bytes : TBytes) : boolean;
86 | function hasCPBrokenBytes(bytes : TBytes) : boolean; // always false
87 |
88 | function getUTF8BrokenBytes(bytes : TBytes) : TBytes;
89 | function getUTF16BrokenBytes(bytes : TBytes) : TBytes;
90 | function getCPBrokenBytes(bytes : TBytes) : TBytes; // always returns []
91 |
92 | procedure mapCP(map : TWideChars);
93 | end;
94 |
95 |
96 | implementation
97 |
98 | { TWideCHarHelper }
99 |
100 | function TWideCharHelper.getUTF8Length : integer;
101 | begin
102 | if integer(self) < $80 then result := 1
103 | else if integer(self) < $800 then result := 2
104 | else if integer(self) < $10000 then result := 3
105 | else result := 4;
106 | end;
107 |
108 | function TWideCharHelper.getUTF16Length : integer; inline;
109 | begin
110 | result := 2;
111 | end;
112 |
113 | function TWideCharHelper.getCPLength : integer; inline;
114 | begin
115 | result := 1;
116 | end;
117 |
118 | function TWideCharHelper.toCharCode : integer; inline;
119 | begin
120 | result := integer(self);
121 | end;
122 |
123 | function TWideCharHelper.fromCharCode(chr : integer) : WideChar; inline;
124 | begin
125 | result := WideChar(chr);
126 | end;
127 |
128 | { TUnicodeStringHelper }
129 |
130 | {
131 | length : length of the UnicodeString in WideChars.
132 | }
133 | function TUnicodeStringHelper.length : integer; inline;
134 | begin
135 | result := system.length(self);
136 | end;
137 |
138 | function TUnicodeStringHelper.substring(index : Integer): unicodestring;
139 | var
140 | strlen, len : integer;
141 | begin
142 | strlen := self.length;
143 | if (index < 0) or (index >= strlen) then
144 | result := ''
145 | else
146 | begin
147 | len := strlen - index;
148 | setlength(result, len);
149 | move(self[1 + index], result[1], len * sizeof(WideChar));
150 | end;
151 | end;
152 |
153 | function TUnicodeStringHelper.substring(index : Integer; len : Integer): unicodestring;
154 | var
155 | strlen : integer;
156 | begin
157 | strlen := self.length;
158 | if (index < 0) or (index >= strlen) or (len <= 0) then
159 | result := ''
160 | else
161 | begin
162 | if index + len > strlen then
163 | len := strlen - index;
164 | setlength(result, len);
165 | move(self[1 + index], result[1], len * sizeof(WideChar));
166 | end;
167 | end;
168 |
169 | function TUnicodeStringHelper.charCodeAt(index : integer) : integer; inline;
170 | begin
171 | if (index < 0) or (index >= self.length) then
172 | result := 0
173 | else
174 | result := self[index + 1].toCharCode;
175 | end;
176 |
177 | function TUnicodeStringHelper.charAt(index : integer) : WideChar; inline;
178 | begin
179 | if (index < 0) or (index >= self.length) then
180 | result := WideChar(0)
181 | else
182 | result := self[index + 1];
183 | end;
184 |
185 |
186 | Function TUnicodeStringHelper.split(const Separators: array of WideChar): TUnicodeStringArray;
187 | var
188 | i, j, lastpos : integer;
189 | ch : widechar;
190 |
191 | x : UnicodeString;
192 | begin
193 | x := self;
194 | setlength(result, 0);
195 | lastpos := 0;
196 | for i := 0 to self.length - 1 do
197 | begin
198 | ch := self.charAt(i);
199 | for j := 0 to system.length(Separators) - 1 do
200 | begin
201 | if ch = Separators[j] then
202 | begin
203 | setlength(result, system.length(result) + 1);
204 | result[system.length(result) - 1] := self.substring(lastpos, i - lastpos);
205 | lastpos := i + 1;
206 | break;
207 | end;
208 | end;
209 | end;
210 | setlength(result, system.length(result) + 1);
211 | result[system.length(result) - 1] := self.substring(lastpos);
212 | end;
213 |
214 | {
215 | Function Split(const Separators: array of Char; ACount: Integer): TStringArray; overload;
216 | Function Split(const Separators: array of Char; Options: TStringSplitOptions): TStringArray; overload;
217 | Function Split(const Separators: array of Char; ACount: Integer; Options: TStringSplitOptions): TStringArray; overload;
218 | Function Split(const Separators: array of string): TStringArray; overload;
219 | Function Split(const Separators: array of string; ACount: Integer): TStringArray; overload;
220 | Function Split(const Separators: array of string; Options: TStringSplitOptions): TStringArray; overload;
221 | Function Split(const Separators: array of string; ACount: Integer; Options: TStringSplitOptions): TStringArray; overload;
222 | Function Split(const Separators: array of Char; AQuote: Char): TStringArray; overload;
223 | Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char): TStringArray; overload;
224 | Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload;
225 | Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: Integer): TStringArray; overload;
226 | Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: Integer; Options: TStringSplitOptions): TStringArray; overload;
227 | Function Split(const Separators: array of string; AQuote: Char): TStringArray; overload;
228 | Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char): TStringArray; overload;
229 | Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload;
230 | Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: Integer): TStringArray; overload;
231 | Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: Integer; Options: TStringSplitOptions): TStringArray; overload;
232 | }
233 |
234 | {
235 | toUTF8Bytes : returns array of bytes encoded in UTF8.
236 | }
237 |
238 | function TUnicodeStringHelper.toWideCharArray : TWideChars;
239 | begin
240 | setlength(result, self.length);
241 | move(self[1], result[0], sizeof(WideChar));
242 | end;
243 |
244 | function TUnicodeStringHelper.toWordArray : TWords;
245 | var
246 | len : longint;
247 | begin
248 | len := self.length;
249 | setlength(result, len);
250 | move(self[1], result[0], sizeof(WideChar) * len);
251 | end;
252 |
253 | function TUnicodeStringHelper.toUTF8Bytes : TBytes;
254 | var
255 | cv, i, len, cl : integer;
256 | p : pbyte;
257 | cw : WideChar;
258 | begin
259 | len := self.getUTF8BytesLength;
260 | setlength(Result, len);
261 | p := @Result[0];
262 | for i := 1 to self.length do
263 | begin
264 | cw := self[i];
265 | cv := cw.toCharCode;
266 | cl := cw.getUTF8Length;
267 | case cl of
268 | 1:
269 | begin
270 | p^ := cv;
271 | end;
272 |
273 | 2:
274 | begin
275 | p^ := %11000000 or ((cv >> 6) and %00011111);
276 | p += 1;
277 | p^ := %10000000 or (cv and %00111111);
278 | end;
279 |
280 | 3:
281 | begin
282 | p^ := %11100000 or ((cv >> 12) and %00001111);
283 | p += 1;
284 | p^ := %10000000 or ((cv >> 6) and %00111111);
285 | p += 1;
286 | p^ := %10000000 or (cv and %00111111);
287 | end;
288 |
289 | 4: raise exception.create('Characters $10000+ unsupported');
290 | end;
291 | p += 1;
292 | end;
293 | end;
294 |
295 | {
296 | toUTF16Bytes : returns array of bytes encoded in UTF16.
297 | }
298 | function TUnicodeStringHelper.toUTF16Bytes : TBytes;
299 | var
300 | len : integer;
301 | begin
302 | len := self.getUTF16BytesLength;
303 | setlength(Result, len);
304 | move(self[1], Result[0], len);
305 | end;
306 |
307 | {
308 | toCPBytes : returns array of bytes. if character is beyond the 255 range, it
309 | is converted to NULL.
310 | }
311 | function TUnicodeStringHelper.toCPBytes : TBytes;
312 | var
313 | len, i, cv : integer;
314 | begin
315 | len := self.length;
316 | setlength(Result, len);
317 | for i := 1 to len do
318 | begin
319 | cv := self[i].toCharCode;
320 | if cv > 255 then
321 | cv := 0;
322 | Result[i - 1] := cv;
323 | end;
324 | end;
325 |
326 | {
327 | toEncodedCPBytes : convert unicodestring to 8 bit ascii using mapping table
328 | }
329 | function TUnicodeStringHelper.toEncodedCPBytes(table : PWord) : TBytes;
330 | var
331 | len, i, cv : integer;
332 | ascii, j : integer;
333 | begin
334 | len := self.length;
335 | setlength(Result, len);
336 | for i := 1 to len do
337 | begin
338 | cv := self[i].toCharCode;
339 |
340 | ascii := 0;
341 | // skip control codes
342 | for j := 32 to 255 do
343 | begin
344 | if cv = table[j] then
345 | begin
346 | ascii := j;
347 | break;
348 | end;
349 | end;
350 | Result[i - 1] := ascii;
351 | end;
352 | end;
353 |
354 | {
355 | getUTF8BytesLength : returns number of bytes required to encode as UTF8.
356 | }
357 | function TUnicodeStringHelper.getUTF8BytesLength : integer;
358 | var
359 | i : integer;
360 | begin
361 | result := 0;
362 | for i := 1 to system.length(self) do
363 | result += self[i].getUTF8Length;
364 | end;
365 |
366 | {
367 | getUTF16BytesLength : returns number of bytes required to encode as UTF16.
368 | }
369 | function TUnicodeStringHelper.getUTF16BytesLength : integer; inline;
370 | begin
371 | result := self.length << 1;
372 | end;
373 |
374 | {
375 | getCPBytesLength : returns number of bytes required to encode as codepage.
376 | Does not consider any characters beyond the 255 charcode value.
377 | }
378 | function TUnicodeStringHelper.getCPBytesLength : integer; inline;
379 | begin
380 | result := self.length;
381 | end;
382 |
383 | {
384 | fromUTF8Bytes : returns unicodestring of UTF8 in bytes. ignores broken bytes
385 | of partial codepoints on end. use hasUTF8BrokenBytes / getUTF8BrokenBytes to
386 | detect / retrieve the broken bytes to pump into next chunk from stream.
387 | }
388 | function TUnicodeStringHelper.fromUTF8Bytes(bytes : TBytes) : UnicodeString;
389 | var
390 | len, pos : integer;
391 | val : UInt32;
392 | b : byte;
393 | begin
394 | len := system.length(bytes);
395 | result := '';
396 | pos := 0;
397 | while pos < len do
398 | begin
399 | b := bytes[pos];
400 | if (b and %11111000) = %11110000 then
401 | begin
402 | // 4 bytes
403 | raise exception.create('Characters $10000+ unsupported');
404 | end
405 | else if (b and %11110000) = %11100000 then
406 | begin
407 | // 3 bytes
408 | if pos + 3 <= len then
409 | begin
410 | val := (bytes[pos + 2] and $3F)
411 | or ((bytes[pos + 1] and $3F) << 6)
412 | or ((b and $0F) << 12);
413 | result += WideChar(val);
414 | end;
415 | //else broken
416 | pos += 3;
417 | end
418 | else if (b and %11100000) = %11000000 then
419 | begin
420 | // 2 bytes
421 | if pos + 2 <= len then
422 | begin
423 | val := (bytes[pos + 1] and $3F)
424 | or ((b and $1F) << 6);
425 | result += WideChar(val);
426 | end;
427 | //else broken
428 | pos += 2;
429 |
430 | end
431 | else if (b and %10000000) = %00000000 then
432 | begin
433 | // 1 byte
434 | result += WideChar(b);
435 | pos += 1;
436 | end;
437 | end;
438 | end;
439 |
440 | {
441 | fromUTF16Bytes : returns unicodestring of UTF16 in bytes. ignores broken bytes
442 | of partial codepoints on end. use hasUTF16BrokenBytes / getUTF16BrokenBytes
443 | to detect / retrieve the broken bytes to pump into next chunk from stream.
444 | }
445 | function TUnicodeStringHelper.fromUTF16Bytes(bytes : TBytes) : UnicodeString;
446 | var
447 | len, pos : integer;
448 | begin
449 | len := system.length(bytes);
450 | result := '';
451 | pos := 0;
452 | while pos < len do
453 | begin
454 | if pos + 1 < len then
455 | result += widechar(bytes[pos] + (bytes[pos + 1] << 8)); // little endian
456 | pos += 2;
457 | end;
458 | end;
459 |
460 | {
461 | fromCPBytes : returns unicodestring of ascii in bytes.
462 | }
463 | function TUnicodeStringHelper.fromCPBytes(bytes : TBytes) : UnicodeString;
464 | var
465 | len, i : integer;
466 | begin
467 | len := system.length(bytes);
468 | result := '';
469 | for i := 0 to len - 1 do
470 | result += WideChar(bytes[i]);
471 | end;
472 |
473 | {
474 | getUTF8BrokenBytes : returns left overs of broken codepoints in byte array.
475 | }
476 | function TUnicodeStringHelper.getUTF8BrokenBytes(bytes : TBytes) : TBytes;
477 | var
478 | len, pos : integer;
479 | b : byte;
480 | begin
481 | len := system.length(bytes);
482 | pos := 0;
483 | while pos < len do
484 | begin
485 | b := bytes[pos];
486 | if (b and %11111000) = %11110000 then
487 | begin
488 | // 4 bytes
489 | raise exception.create('Characters $10000+ unsupported');
490 | end
491 | else if (b and %11110000) = %11100000 then
492 | begin
493 | // 3 bytes
494 | if pos + 3 > len then
495 | begin
496 | setlength(result, len - pos);
497 | move(bytes[pos], result[0], len-pos);
498 | exit;
499 | end;
500 | pos += 3;
501 | end
502 | else if (b and %11100000) = %11000000 then
503 | begin
504 | // 2 bytes
505 | if pos + 2 > len then
506 | begin
507 | setlength(result, len - pos);
508 | move(bytes[pos], result[0], len-pos);
509 | exit;
510 | end;
511 | pos += 2;
512 | end
513 | else if (b and %10000000) = %00000000 then
514 | begin
515 | pos += 1;
516 | end;
517 | end;
518 | setlength(result, 0);
519 | end;
520 |
521 | {
522 | getUTF16BrokenBytes : returns left overs of broken codepoints in byte array.
523 | }
524 | function TUnicodeStringHelper.getUTF16BrokenBytes(bytes : TBytes) : TBytes;
525 | begin
526 | if self.HasUTF16BrokenBytes(bytes) then
527 | begin
528 | setlength(Result, 1);
529 | Result[0] := bytes[system.length(bytes) - 1];
530 | end
531 | else
532 | setlength(Result, 0);
533 | end;
534 |
535 | {
536 | getCPBrokenBytes : always returns empty byte array.
537 | }
538 | function TUnicodeStringHelper.getCPBrokenBytes(bytes : TBytes) : TBytes; inline;
539 | begin
540 | setlength(Result, 0);
541 | end;
542 |
543 | {
544 | hasUTF8BrokenBytes : returns true if there is a broken codepoint at the end
545 | of the byte array.
546 | }
547 | function TUnicodeStringHelper.hasUTF8BrokenBytes(bytes : TBytes) : boolean;
548 | var
549 | len, pos : integer;
550 | b : byte;
551 | begin
552 | len := system.length(bytes);
553 | pos := 0;
554 | while pos < len do
555 | begin
556 | b := bytes[pos];
557 | if (b and %11111000) = %11110000 then
558 | begin
559 | // 4 bytes
560 | raise exception.create('Characters $10000+ unsupported');
561 | end
562 | else if (b and %11110000) = %11100000 then
563 | begin
564 | // 3 bytes
565 | if pos + 3 >= len then
566 | exit(true);
567 | pos += 3;
568 | end
569 | else if (b and %11100000) = %11000000 then
570 | begin
571 | // 2 bytes
572 | if pos + 2 >= len then
573 | exit(true);
574 | pos += 2;
575 | end
576 | else if (b and %10000000) = %00000000 then
577 | begin
578 | pos += 1;
579 | end;
580 | end;
581 | result := false;
582 | end;
583 |
584 | {
585 | hasUTF16BrokenBytes : returns true if there is a broken codepoint at the end
586 | of the byte array.
587 | }
588 | function TUnicodeStringHelper.hasUTF16BrokenBytes(bytes : TBytes) : boolean; inline;
589 | begin
590 | result := ((system.length(bytes) and $1) <> 0);
591 | end;
592 |
593 | {
594 | hasCPBrokenBytes : always returns false.
595 | }
596 | function TUnicodeStringHelper.hasCPBrokenBytes(bytes : TBytes) : boolean; inline;
597 | begin
598 | result := false;
599 | end;
600 |
601 | {
602 | mapCP : will convert a codepaged unicodestring to true unicode using an
603 | array [0..255] of WideChars. if a character is outside the 0-255 range, it
604 | will be mapped to null.
605 | }
606 | procedure TUnicodeStringHelper.mapCP(map : TWideChars);
607 | var
608 | len, i : integer;
609 | pwc : PWideChar;
610 | cpchr : integer;
611 | begin
612 | if system.length(map) <> 256 then
613 | raise exception.create('Invalid mapping table length. Needs 256 characters.');
614 |
615 | len := self.length;
616 | pwc := getmemory(len * sizeof(WideChar));
617 | move(self[1], pwc, len * sizeof(WideChar));
618 | self := '';
619 | for i := 0 to len - 1 do
620 | begin
621 | cpchr := pwc[i].toCharCode;
622 | if cpchr > 255 then
623 | cpchr := 0; // set to null if out of range.
624 | self += map[cpchr];
625 | end;
626 | freememory(pwc);
627 | end;
628 |
629 | end.
630 |
631 |
--------------------------------------------------------------------------------
/vtxcolordlg.lfm:
--------------------------------------------------------------------------------
1 | object fColorDialog: TfColorDialog
2 | Left = 639
3 | Height = 354
4 | Top = 354
5 | Width = 519
6 | BorderStyle = bsDialog
7 | Caption = 'ANSI Colors'
8 | ClientHeight = 354
9 | ClientWidth = 519
10 | OnCreate = FormCreate
11 | OnDestroy = FormDestroy
12 | OnShow = FormShow
13 | LCLVersion = '1.6.4.0'
14 | object bOK: TButton
15 | Left = 8
16 | Height = 25
17 | Top = 323
18 | Width = 75
19 | Caption = 'OK'
20 | ModalResult = 1
21 | TabOrder = 0
22 | end
23 | object bCancel: TButton
24 | Left = 90
25 | Height = 25
26 | Top = 323
27 | Width = 75
28 | Cancel = True
29 | Caption = 'Cancel'
30 | ModalResult = 2
31 | TabOrder = 1
32 | end
33 | object Label1: TLabel
34 | Left = 6
35 | Height = 15
36 | Top = 6
37 | Width = 64
38 | Caption = 'ANSI colors:'
39 | ParentColor = False
40 | end
41 | object pbColors: TPaintBox
42 | Left = 8
43 | Height = 297
44 | Top = 22
45 | Width = 261
46 | ParentColor = False
47 | OnMouseDown = pbColorsMouseDown
48 | OnPaint = pbColorsPaint
49 | end
50 | object Label2: TLabel
51 | Left = 190
52 | Height = 15
53 | Top = 329
54 | Width = 32
55 | Caption = 'Color:'
56 | ParentColor = False
57 | end
58 | object tbANSIColor: TEdit
59 | Left = 225
60 | Height = 23
61 | Top = 325
62 | Width = 44
63 | NumbersOnly = True
64 | OnEditingDone = tbANSIColorEditingDone
65 | TabOrder = 2
66 | Text = 'tbANSIColor'
67 | end
68 | object pbHS: TPaintBox
69 | Left = 276
70 | Height = 193
71 | Top = 6
72 | Width = 209
73 | OnMouseDown = pbHSMouseDown
74 | OnMouseMove = pbHSMouseMove
75 | OnMouseUp = pbHSMouseUp
76 | OnPaint = pbHSPaint
77 | end
78 | object pbL: TPaintBox
79 | Left = 490
80 | Height = 193
81 | Top = 8
82 | Width = 24
83 | OnMouseDown = pbLMouseDown
84 | OnMouseMove = pbLMouseMove
85 | OnMouseUp = pbLMouseUp
86 | OnPaint = pbLPaint
87 | end
88 | object tbRed: TEdit
89 | Left = 306
90 | Height = 23
91 | Top = 230
92 | Width = 44
93 | NumbersOnly = True
94 | OnEditingDone = tbRedEditingDone
95 | TabOrder = 3
96 | Text = 'tbRed'
97 | end
98 | object Label3: TLabel
99 | Left = 280
100 | Height = 15
101 | Top = 232
102 | Width = 23
103 | Caption = 'Red:'
104 | ParentColor = False
105 | end
106 | object tbHue: TEdit
107 | Left = 306
108 | Height = 23
109 | Top = 256
110 | Width = 44
111 | NumbersOnly = True
112 | OnEditingDone = tbHueEditingDone
113 | TabOrder = 4
114 | Text = 'tbHue'
115 | end
116 | object Label4: TLabel
117 | Left = 278
118 | Height = 15
119 | Top = 258
120 | Width = 25
121 | Caption = 'Hue:'
122 | ParentColor = False
123 | end
124 | object tbL: TEdit
125 | Left = 306
126 | Height = 23
127 | Top = 282
128 | Width = 44
129 | Enabled = False
130 | ReadOnly = True
131 | TabOrder = 5
132 | Text = 'tbL'
133 | end
134 | object Label5: TLabel
135 | Left = 294
136 | Height = 15
137 | Top = 284
138 | Width = 9
139 | Caption = 'L:'
140 | ParentColor = False
141 | end
142 | object tbB: TEdit
143 | Left = 470
144 | Height = 23
145 | Top = 282
146 | Width = 44
147 | Enabled = False
148 | ReadOnly = True
149 | TabOrder = 6
150 | Text = 'tbB'
151 | end
152 | object tbBlue: TEdit
153 | Left = 470
154 | Height = 23
155 | Top = 230
156 | Width = 44
157 | NumbersOnly = True
158 | OnEditingDone = tbBlueEditingDone
159 | TabOrder = 7
160 | Text = 'tbBlue'
161 | end
162 | object tbLum: TEdit
163 | Left = 470
164 | Height = 23
165 | Top = 256
166 | Width = 44
167 | NumbersOnly = True
168 | OnEditingDone = tbLumEditingDone
169 | TabOrder = 8
170 | Text = 'tbLum'
171 | end
172 | object Label6: TLabel
173 | Left = 440
174 | Height = 15
175 | Top = 232
176 | Width = 26
177 | Caption = 'Blue:'
178 | ParentColor = False
179 | end
180 | object Label7: TLabel
181 | Left = 439
182 | Height = 15
183 | Top = 258
184 | Width = 27
185 | Caption = 'Lum:'
186 | ParentColor = False
187 | end
188 | object Label8: TLabel
189 | Left = 456
190 | Height = 15
191 | Top = 284
192 | Width = 10
193 | Caption = 'B:'
194 | ParentColor = False
195 | end
196 | object Label9: TLabel
197 | Left = 354
198 | Height = 15
199 | Top = 232
200 | Width = 34
201 | Caption = 'Green:'
202 | ParentColor = False
203 | end
204 | object Label10: TLabel
205 | Left = 368
206 | Height = 15
207 | Top = 258
208 | Width = 19
209 | Caption = 'Sat:'
210 | ParentColor = False
211 | end
212 | object Label11: TLabel
213 | Left = 376
214 | Height = 15
215 | Top = 284
216 | Width = 11
217 | Caption = 'A:'
218 | ParentColor = False
219 | end
220 | object tbA: TEdit
221 | Left = 390
222 | Height = 23
223 | Top = 282
224 | Width = 44
225 | Enabled = False
226 | ReadOnly = True
227 | TabOrder = 9
228 | Text = 'tbA'
229 | end
230 | object tbSat: TEdit
231 | Left = 390
232 | Height = 23
233 | Top = 256
234 | Width = 44
235 | NumbersOnly = True
236 | OnEditingDone = tbSatEditingDone
237 | TabOrder = 10
238 | Text = 'tbSat'
239 | end
240 | object tbGreen: TEdit
241 | Left = 390
242 | Height = 23
243 | Top = 230
244 | Width = 44
245 | NumbersOnly = True
246 | OnEditingDone = tbGreenEditingDone
247 | TabOrder = 11
248 | Text = 'tbGreen'
249 | end
250 | object pbDesiredColor: TPaintBox
251 | Left = 282
252 | Height = 24
253 | Top = 324
254 | Width = 115
255 | OnPaint = pbDesiredColorPaint
256 | end
257 | object Label12: TLabel
258 | Left = 282
259 | Height = 15
260 | Top = 306
261 | Width = 45
262 | Caption = 'Desided:'
263 | ParentColor = False
264 | end
265 | object Label13: TLabel
266 | Left = 400
267 | Height = 15
268 | Top = 306
269 | Width = 37
270 | Caption = 'Actual:'
271 | ParentColor = False
272 | end
273 | object pbActualColor: TPaintBox
274 | Left = 400
275 | Height = 24
276 | Top = 324
277 | Width = 115
278 | OnPaint = pbActualColorPaint
279 | end
280 | object Label14: TLabel
281 | Left = 280
282 | Height = 15
283 | Top = 208
284 | Width = 23
285 | Caption = 'Hex:'
286 | ParentColor = False
287 | end
288 | object tbHex: TEdit
289 | Left = 306
290 | Height = 23
291 | Top = 204
292 | Width = 208
293 | MaxLength = 7
294 | OnEditingDone = tbHexEditingDone
295 | TabOrder = 12
296 | Text = 'tbHex'
297 | end
298 | end
299 |
--------------------------------------------------------------------------------
/vtxcolordlg.lrs:
--------------------------------------------------------------------------------
1 | { This is an automatically generated lazarus resource file }
2 |
3 | LazarusResources.Add('TfColorDialog','FORMDATA',[
4 | 'TPF0'#13'TfColorDialog'#12'fColorDialog'#4'Left'#3#251#2#6'Height'#3'B'#1#3
5 | +'Top'#3#162#1#5'Width'#3#7#2#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#11'A'
6 | +'NSI Colors'#12'ClientHeight'#3'B'#1#11'ClientWidth'#3#7#2#10'LCLVersion'#6#7
7 | +'1.6.4.0'#0#7'TButton'#7'Button1'#4'Left'#2#8#6'Height'#2#25#3'Top'#3#30#1#5
8 | +'Width'#2'K'#7'Caption'#6#2'OK'#11'ModalResult'#2#1#8'TabOrder'#2#0#0#0#7'TB'
9 | +'utton'#7'Button2'#4'Left'#2'Z'#6'Height'#2#25#3'Top'#3#30#1#5'Width'#2'K'#6
10 | +'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#6
11 | +'TLabel'#6'Label1'#4'Left'#2#6#6'Height'#2#15#3'Top'#2#6#5'Width'#2'@'#7'Cap'
12 | +'tion'#6#12'ANSI colors:'#11'ParentColor'#8#0#0#9'TPaintBox'#9'PaintBox1'#4
13 | +'Left'#2#8#6'Height'#3#4#1#3'Top'#2#22#5'Width'#3#5#1#0#0#6'TLabel'#6'Label2'
14 | +#4'Left'#3#174#0#6'Height'#2#15#3'Top'#3'"'#1#5'Width'#2' '#7'Caption'#6#6'C'
15 | +'olor:'#11'ParentColor'#8#0#0#5'TEdit'#5'Edit1'#4'Left'#3#222#0#6'Height'#2
16 | +#23#3'Top'#3#30#1#5'Width'#2','#8'TabOrder'#2#2#4'Text'#6#5'Edit1'#0#0#9'TPa'
17 | +'intBox'#9'PaintBox2'#4'Left'#3#20#1#6'Height'#3#219#0#3'Top'#2#6#5'Width'#3
18 | +#209#0#0#0#9'TPaintBox'#9'PaintBox3'#4'Left'#3#234#1#6'Height'#3#218#0#3'Top'
19 | +#2#6#5'Width'#2#24#0#0#5'TEdit'#5'Edit2'#4'Left'#3'2'#1#6'Height'#2#23#3'Top'
20 | +#3#230#0#5'Width'#2','#8'TabOrder'#2#3#4'Text'#6#5'Edit2'#0#0#6'TLabel'#6'La'
21 | +'bel3'#4'Left'#3#22#1#6'Height'#2#15#3'Top'#3#232#0#5'Width'#2#25#7'Caption'
22 | +#6#4'Hue:'#11'ParentColor'#8#0#0#5'TEdit'#5'Edit3'#4'Left'#3'2'#1#6'Height'#2
23 | +#23#3'Top'#3#0#1#5'Width'#2','#8'TabOrder'#2#4#4'Text'#6#5'Edit3'#0#0#6'TLab'
24 | +'el'#6'Label4'#4'Left'#3#28#1#6'Height'#2#15#3'Top'#3#2#1#5'Width'#2#19#7'Ca'
25 | +'ption'#6#4'Sat:'#11'ParentColor'#8#0#0#5'TEdit'#5'Edit4'#4'Left'#3'2'#1#6'H'
26 | +'eight'#2#23#3'Top'#3#26#1#5'Width'#2','#8'TabOrder'#2#5#4'Text'#6#5'Edit4'#0
27 | +#0#6'TLabel'#6'Label5'#4'Left'#3#20#1#6'Height'#2#15#3'Top'#3#28#1#5'Width'#2
28 | +#27#7'Caption'#6#4'Lum:'#11'ParentColor'#8#0#0#5'TEdit'#5'Edit5'#4'Left'#3
29 | +#214#1#6'Height'#2#23#3'Top'#3#26#1#5'Width'#2','#8'TabOrder'#2#6#4'Text'#6#5
30 | +'Edit5'#0#0#5'TEdit'#5'Edit6'#4'Left'#3#214#1#6'Height'#2#23#3'Top'#3#230#0#5
31 | +'Width'#2','#8'TabOrder'#2#7#4'Text'#6#5'Edit6'#0#0#5'TEdit'#5'Edit7'#4'Left'
32 | +#3#214#1#6'Height'#2#23#3'Top'#3#0#1#5'Width'#2','#8'TabOrder'#2#8#4'Text'#6
33 | +#5'Edit7'#0#0#6'TLabel'#6'Label6'#4'Left'#3#189#1#6'Height'#2#15#3'Top'#3#232
34 | +#0#5'Width'#2#23#7'Caption'#6#4'Red:'#11'ParentColor'#8#0#0#6'TLabel'#6'Labe'
35 | +'l7'#4'Left'#3#178#1#6'Height'#2#15#3'Top'#3#2#1#5'Width'#2'"'#7'Caption'#6#6
36 | +'Green:'#11'ParentColor'#8#0#0#6'TLabel'#6'Label8'#4'Left'#3#186#1#6'Height'
37 | +#2#15#3'Top'#3#28#1#5'Width'#2#26#7'Caption'#6#5'Blue:'#11'ParentColor'#8#0#0
38 | +#6'TLabel'#6'Label9'#4'Left'#3'm'#1#6'Height'#2#15#3'Top'#3#232#0#5'Width'#2
39 | +#9#7'Caption'#6#2'L:'#11'ParentColor'#8#0#0#6'TLabel'#7'Label10'#4'Left'#3'k'
40 | +#1#6'Height'#2#15#3'Top'#3#2#1#5'Width'#2#11#7'Caption'#6#2'A:'#11'ParentCol'
41 | +'or'#8#0#0#6'TLabel'#7'Label11'#4'Left'#3'l'#1#6'Height'#2#15#3'Top'#3#30#1#5
42 | +'Width'#2#10#7'Caption'#6#2'B:'#11'ParentColor'#8#0#0#5'TEdit'#5'Edit8'#4'Le'
43 | +'ft'#3'z'#1#6'Height'#2#23#3'Top'#3#26#1#5'Width'#2','#8'TabOrder'#2#9#4'Tex'
44 | +'t'#6#5'Edit8'#0#0#5'TEdit'#5'Edit9'#4'Left'#3'z'#1#6'Height'#2#23#3'Top'#3#0
45 | +#1#5'Width'#2','#8'TabOrder'#2#10#4'Text'#6#5'Edit9'#0#0#5'TEdit'#6'Edit10'#4
46 | +'Left'#3'z'#1#6'Height'#2#23#3'Top'#3#230#0#5'Width'#2','#8'TabOrder'#2#11#4
47 | +'Text'#6#6'Edit10'#0#0#0
48 | ]);
49 |
--------------------------------------------------------------------------------
/vtxcolordlg.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | unit VTXColorDlg;
31 |
32 | {$mode objfpc}{$H+}
33 |
34 | interface
35 |
36 | uses
37 | Classes,
38 | SysUtils,
39 | LResources,
40 | Forms,
41 | Controls,
42 | Graphics,
43 | Dialogs,
44 | ExtCtrls,
45 | Buttons,
46 | Math,
47 | VTXSupport,
48 | VTXConst,
49 | StdCtrls;
50 |
51 | type
52 |
53 | TLAB = record
54 | l, a, b : double;
55 | end;
56 |
57 | THSL = record
58 | h, s, l : double;
59 | end;
60 |
61 | TRGB = record
62 | r, g, b : double;
63 | end;
64 |
65 | TXYZ = record
66 | x, y, z : double;
67 | end;
68 |
69 | { TfColorDialog }
70 |
71 | TfColorDialog = class(TForm)
72 | bOK: TButton;
73 | bCancel: TButton;
74 | tbANSIColor: TEdit;
75 | tbGreen: TEdit;
76 | tbHex: TEdit;
77 | tbRed: TEdit;
78 | tbHue: TEdit;
79 | tbL: TEdit;
80 | tbB: TEdit;
81 | tbBlue: TEdit;
82 | tbLum: TEdit;
83 | tbA: TEdit;
84 | tbSat: TEdit;
85 | Label1: TLabel;
86 | Label10: TLabel;
87 | Label11: TLabel;
88 | Label12: TLabel;
89 | Label13: TLabel;
90 | Label14: TLabel;
91 | Label2: TLabel;
92 | Label3: TLabel;
93 | Label4: TLabel;
94 | Label5: TLabel;
95 | Label6: TLabel;
96 | Label7: TLabel;
97 | Label8: TLabel;
98 | Label9: TLabel;
99 | pbColors: TPaintBox;
100 | pbHS: TPaintBox;
101 | pbL: TPaintBox;
102 | pbDesiredColor: TPaintBox;
103 | pbActualColor: TPaintBox;
104 | procedure FormCreate(Sender: TObject);
105 | procedure FormDestroy(Sender: TObject);
106 | procedure FormShow(Sender: TObject);
107 | procedure pbActualColorPaint(Sender: TObject);
108 | procedure pbColorsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
109 | procedure pbColorsPaint(Sender: TObject);
110 | procedure pbDesiredColorPaint(Sender: TObject);
111 | procedure pbHSMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
112 | procedure pbHSMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
113 | procedure pbHSMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
114 | procedure pbHSPaint(Sender: TObject);
115 | procedure pbLMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
116 | procedure pbLMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
117 | procedure pbLMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
118 | procedure pbLPaint(Sender: TObject);
119 | function FindANSIColor : integer;
120 | procedure SetANSIColor;
121 | procedure SetHSLColor;
122 | procedure SetRGBColor;
123 | procedure SetLABColor;
124 | procedure tbAEditingDone(Sender: TObject);
125 | procedure tbANSIColorEditingDone(Sender: TObject);
126 | procedure tbBEditingDone(Sender: TObject);
127 | procedure tbBlueEditingDone(Sender: TObject);
128 | procedure tbGreenEditingDone(Sender: TObject);
129 | procedure tbHexEditingDone(Sender: TObject);
130 | procedure tbHueEditingDone(Sender: TObject);
131 | procedure tbLEditingDone(Sender: TObject);
132 | procedure tbLumEditingDone(Sender: TObject);
133 | procedure tbRedEditingDone(Sender: TObject);
134 | procedure tbSatEditingDone(Sender: TObject);
135 | private
136 | { private declarations }
137 | public
138 | { public declarations }
139 | fColor : integer; // ansi color 0-255
140 | fMaxColors : integer;
141 | end;
142 |
143 | var
144 | fColorDialog: TfColorDialog;
145 | bmpHS : TBitmap;
146 | ANSILAB : array [0 .. 255] of TLAB;
147 |
148 | rows : integer;
149 |
150 | // desired color
151 | DesiredRGB : TRGB;
152 | DesiredHSL : THSL;
153 | DesiredXYZ : TXYZ;
154 | DesiredLAB : TLAB;
155 |
156 | drag : boolean;
157 |
158 | const
159 | d65: TXYZ = (
160 | x: 0.9505;
161 | y: 1.0;
162 | z: 1.0890;
163 | );
164 |
165 | function RGB2XYZ(rgb: TRGB): TXYZ;
166 | function RGB2HSL(rgb: TRGB): THSL;
167 | function XYZ2LAB(xyz: TXYZ): TLAB;
168 | function HSL2RGB(hsl: THSL): TRGB;
169 | function XYZ2RGB(xyz: TXYZ): TRGB;
170 | function LAB2XYZ(lab: TLAB): TXYZ;
171 | function SetRGB(r, g, b : byte) : TRGB;
172 | function doubletostr(v : double) : string;
173 | function Distance3D(x1, y1, z1, x2, y2, z2 : double): double;
174 |
175 | implementation
176 |
177 | { TfColorDialog }
178 |
179 | function SetRGB(r, g, b : byte) : TRGB;
180 | begin
181 | result.r := r / 255.0;
182 | result.g := g / 255.0;
183 | result.b := b / 255.0;
184 | end;
185 |
186 | // paint color picker + highlight selected color
187 | procedure TfColorDialog.pbColorsPaint(Sender: TObject);
188 | var
189 | pb : TPaintBox;
190 | cnv : TCanvas;
191 | x, y, c : integer;
192 | cw, ch : integer;
193 | r : TRect;
194 | begin
195 | pb := TPaintBox(Sender);
196 | cnv := pb.Canvas;
197 | cw := pb.Width >> 4;
198 | ch := pb.Height >> 4;
199 |
200 | // draw selection rect first
201 | x := fColor and $F;
202 | y := fColor >> 4;
203 | r.Top := y * ch;
204 | r.Left := x * cw;
205 | r.Width := cw + 2;
206 | r.Height := ch + 2;
207 | cnv.Brush.Color := clWhite;
208 | cnv.Pen.Color := clWhite;
209 | cnv.DrawFocusRect(r);
210 |
211 | c := 0;
212 | for y := 0 to rows do
213 | begin
214 | for x := 0 to 15 do
215 | begin
216 | r.Top := y * ch + 2;
217 | r.Left := x * cw + 2;
218 | r.Width := cw - 2;
219 | r.Height := ch - 2;
220 |
221 | cnv.Brush.Color := ANSIColor[c];
222 | cnv.FillRect(r);
223 | Draw3DRect(cnv, r, true);
224 | c += 1;
225 | end;
226 | end;
227 | end;
228 |
229 | procedure TfColorDialog.pbDesiredColorPaint(Sender: TObject);
230 | var
231 | pb : TPaintBox;
232 | cnv : TCanvas;
233 | r, g, b : integer;
234 | rect : TRect;
235 | begin
236 | pb := TPaintBox(Sender);
237 | cnv := pb.Canvas;
238 | rect := pb.ClientRect;
239 |
240 | r := floor(DesiredRGB.r * 255.0);
241 | g := floor(DesiredRGB.g * 255.0);
242 | b := floor(DesiredRGB.b * 255.0);
243 |
244 | cnv.Brush.Color := RGBToColor(r, g, b);
245 | cnv.FillRect(rect);
246 | Draw3DRect(cnv, rect, true);
247 | end;
248 |
249 | procedure TfColorDialog.pbActualColorPaint(Sender: TObject);
250 | var
251 | pb : TPaintBox;
252 | cnv : TCanvas;
253 | r, g, b : integer;
254 | rect : TRect;
255 | begin
256 | pb := TPaintBox(Sender);
257 | cnv := pb.Canvas;
258 | rect := pb.ClientRect;
259 |
260 | r := (ANSIColor[fColor] ) and $FF;
261 | g := (ANSIColor[fColor] >> 8) and $FF;
262 | b := (ANSIColor[fColor] >> 16) and $FF;
263 |
264 | cnv.Brush.Color := RGBToColor(r, g, b);
265 | cnv.FillRect(rect);
266 | Draw3DRect(cnv, rect, true);
267 | end;
268 |
269 | function Distance3D(x1, y1, z1, x2, y2, z2 : double): double;
270 | var
271 | x, y, z : double;
272 | begin
273 | x := (x1 - x2);
274 | y := (y1 - y2);
275 | z := (z1 - z2);
276 | x *= x;
277 | y *= y;
278 | z *= z;
279 | result := (x + y + z);
280 | end;
281 |
282 | // find closest ansi color
283 | function TfColorDialog.FindANSIColor : integer;
284 | var
285 | i : integer;
286 | d, mind : double;
287 | begin
288 | mind := 9999;
289 | for i := 0 to fMaxColors - 1 do
290 | begin
291 | d := Distance3D(
292 | DesiredLAB.l, DesiredLAB.a, DesiredLAB.b,
293 | ANSILAB[i].l, ANSILAB[i].a, ANSILAB[i].b);
294 | if d < mind then
295 | begin
296 | mind := d;
297 | result := i;
298 | end;
299 | end;
300 | end;
301 |
302 | // set all colors based on fcolor
303 | procedure TfColorDialog.SetANSIColor;
304 | var
305 | r, g, b : integer;
306 | begin
307 | // load settings based on fANSIColor.
308 | r := (ANSIColor[fColor] ) and $FF;
309 | g := (ANSIColor[fColor] >> 8) and $FF;
310 | b := (ANSIColor[fColor] >> 16) and $FF;
311 |
312 | DesiredRGB := SetRGB(r, g, b);
313 | DesiredHSL := RGB2HSL(DesiredRGB);
314 | DesiredXYZ := RGB2XYZ(DesiredRGB);
315 | DesiredLAB := XYZ2LAB(DesiredXYZ);
316 |
317 | tbANSIColor.Text := inttostr(fColor);
318 | tbHex.Text := Format('#%2.2X%2.2X%2.2X', [r, g, b]);
319 |
320 | tbRed.Text := inttostr(r);
321 | tbGreen.Text := inttostr(g);
322 | tbBlue.Text := inttostr(b);
323 |
324 | tbHue.Text := doubletostr(DesiredHSL.h * 100);
325 | tbSat.Text := doubletostr(DesiredHSL.s * 100);
326 | tbLum.Text := doubletostr(DesiredHSL.l * 100);
327 |
328 | tbL.Text := doubletostr(DesiredLAB.l);
329 | tbA.Text := doubletostr(DesiredLAB.a);
330 | tbB.Text := doubletostr(DesiredLAB.b);
331 |
332 | pbDesiredColor.Invalidate;
333 | pbActualColor.Invalidate;
334 | pbHS.Invalidate;
335 | pbL.Invalidate;
336 | end;
337 |
338 | procedure TfColorDialog.SetRGBColor;
339 | var
340 | r, g, b : integer;
341 | begin
342 | DesiredHSL := RGB2HSL(DesiredRGB);
343 | DesiredXYZ := RGB2XYZ(DesiredRGB);
344 | DesiredLAB := XYZ2LAB(DesiredXYZ);
345 |
346 | // find closest ANSI color
347 | fColor := FindANSIColor;
348 |
349 | // fill in values
350 | tbANSIColor.Text := inttostr(fColor);
351 |
352 | r := floor(DesiredRGB.r * 255.0);
353 | g := floor(DesiredRGB.g * 255.0);
354 | b := floor(DesiredRGB.b * 255.0);
355 | tbHex.Text := Format('#%2.2X%2.2X%2.2X', [r, g, b]);
356 |
357 | tbRed.Text := inttostr(r);
358 | tbGreen.Text := inttostr(g);
359 | tbBlue.Text := inttostr(b);
360 |
361 | tbHue.Text := doubletostr(DesiredHSL.h * 100);
362 | tbSat.Text := doubletostr(DesiredHSL.s * 100);
363 | tbLum.Text := doubletostr(DesiredHSL.l * 100);
364 |
365 | tbL.Text := doubletostr(DesiredLAB.l);
366 | tbA.Text := doubletostr(DesiredLAB.a);
367 | tbB.Text := doubletostr(DesiredLAB.b);
368 |
369 | pbColors.Invalidate;
370 | pbDesiredColor.Invalidate;
371 | pbActualColor.Invalidate;
372 | pbHS.Invalidate;
373 | pbL.Invalidate;
374 | end;
375 |
376 | procedure TfColorDialog.SetLABColor;
377 | var
378 | r, g, b : integer;
379 | begin
380 | DesiredXYZ := LAB2XYZ(DesiredLAB);
381 | DesiredRGB := XYZ2RGB(DesiredXYZ);
382 | DesiredHSL := RGB2HSL(DesiredRGB);
383 |
384 | // find closest ANSI color
385 | fColor := FindANSIColor;
386 |
387 | // fill in values
388 | tbANSIColor.Text := inttostr(fColor);
389 |
390 | r := floor(DesiredRGB.r * 255.0);
391 | g := floor(DesiredRGB.g * 255.0);
392 | b := floor(DesiredRGB.b * 255.0);
393 | tbHex.Text := Format('#%2.2X%2.2X%2.2X', [r, g, b]);
394 |
395 | tbRed.Text := inttostr(r);
396 | tbGreen.Text := inttostr(g);
397 | tbBlue.Text := inttostr(b);
398 |
399 | tbHue.Text := doubletostr(DesiredHSL.h * 100);
400 | tbSat.Text := doubletostr(DesiredHSL.s * 100);
401 | tbLum.Text := doubletostr(DesiredHSL.l * 100);
402 |
403 | tbL.Text := doubletostr(DesiredLAB.l);
404 | tbA.Text := doubletostr(DesiredLAB.a);
405 | tbB.Text := doubletostr(DesiredLAB.b);
406 |
407 | pbColors.Invalidate;
408 | pbDesiredColor.Invalidate;
409 | pbActualColor.Invalidate;
410 | pbHS.Invalidate;
411 | pbL.Invalidate;
412 | end;
413 |
414 | // set all colors based on desiredhsl
415 | procedure TfColorDialog.SetHSLColor;
416 | var
417 | r, g, b : integer;
418 | begin
419 | DesiredRGB := HSL2RGB(DesiredHSL);
420 | DesiredXYZ := RGB2XYZ(DesiredRGB);
421 | DesiredLAB := XYZ2LAB(DesiredXYZ);
422 |
423 | // find closest ANSI color
424 | fColor := FindANSIColor;
425 |
426 | // fill in values
427 | tbANSIColor.Text := inttostr(fColor);
428 |
429 | r := floor(DesiredRGB.r * 255.0);
430 | g := floor(DesiredRGB.g * 255.0);
431 | b := floor(DesiredRGB.b * 255.0);
432 | tbHex.Text := Format('#%2.2X%2.2X%2.2X', [r, g, b]);
433 |
434 | tbRed.Text := inttostr(r);
435 | tbGreen.Text := inttostr(g);
436 | tbBlue.Text := inttostr(b);
437 |
438 | tbHue.Text := doubletostr(DesiredHSL.h * 100);
439 | tbSat.Text := doubletostr(DesiredHSL.s * 100);
440 | tbLum.Text := doubletostr(DesiredHSL.l * 100);
441 |
442 | tbL.Text := doubletostr(DesiredLAB.l);
443 | tbA.Text := doubletostr(DesiredLAB.a);
444 | tbB.Text := doubletostr(DesiredLAB.b);
445 |
446 | pbColors.Invalidate;
447 | pbDesiredColor.Invalidate;
448 | pbActualColor.Invalidate;
449 | pbHS.Invalidate;
450 | pbL.Invalidate;
451 | end;
452 |
453 | procedure TfColorDialog.tbANSIColorEditingDone(Sender: TObject);
454 | var
455 | v : integer;
456 | begin
457 | v := StrToInt(tbANSIColor.Text);
458 | if v < 0 then
459 | v := 0;
460 | if v > fMaxColors - 1 then
461 | v := fMaxColors - 1;
462 | fColor := v;
463 | SetANSIColor;
464 | pbColors.Invalidate;
465 | end;
466 |
467 | function HexChar(ch : char) : integer;
468 | var
469 | c : integer;
470 | begin
471 | ch := UpCase(ch);
472 | result := string('0123456789ABCDEF').IndexOf(ch);
473 | end;
474 |
475 | procedure TfColorDialog.tbHexEditingDone(Sender: TObject);
476 | var
477 | hex : string;
478 | i : integer;
479 | v : longint;
480 | r, g, b : integer;
481 | begin
482 | // validate hex
483 | hex := tbHex.Text;
484 | if (hex.Length = 7) and (LeftStr(hex,1) = '#') then
485 | hex := RightStr(hex, 6);
486 | if hex.Length = 6 then
487 | begin
488 | for i := 0 to 5 do
489 | if HexChar(hex.Chars[i]) = -1 then
490 | exit;
491 | v := StrToInt('$' + hex);
492 | r := (v >> 16) and $FF;
493 | g := (v >> 8) and $FF;
494 | b := (v ) and $FF;
495 | DesiredRGB := SetRGB(r, g, b);
496 | SetRGBColor;
497 | end;
498 | end;
499 |
500 | procedure TfColorDialog.tbRedEditingDone(Sender: TObject);
501 | var
502 | v : double;
503 | begin
504 | v := StrToFloat(tbRed.Text) / 255;
505 | if v < 0 then v := 0;
506 | if v > 1 then v := 1;
507 | DesiredRGB.r := v;
508 | SetRGBColor;
509 | end;
510 |
511 | procedure TfColorDialog.tbGreenEditingDone(Sender: TObject);
512 | var
513 | v : double;
514 | begin
515 | v := StrToFloat(tbGreen.Text) / 255;
516 | if v < 0 then v := 0;
517 | if v > 1 then v := 1;
518 | DesiredRGB.g := v;
519 | SetRGBColor;
520 | end;
521 |
522 | procedure TfColorDialog.tbBlueEditingDone(Sender: TObject);
523 | var
524 | v : double;
525 | begin
526 | v := StrToFloat(tbBlue.Text) / 255;
527 | if v < 0 then v := 0;
528 | if v > 1 then v := 1;
529 | DesiredRGB.b := v;
530 | SetRGBColor;
531 | end;
532 |
533 | procedure TfColorDialog.tbHueEditingDone(Sender: TObject);
534 | var
535 | v : double;
536 | begin
537 | v := StrToFloat(tbHue.Text) / 100;
538 | if v < 0 then v := 0;
539 | if v > 1 then v := 1;
540 | DesiredHSL.h := v;
541 | SetHSLColor;
542 | end;
543 |
544 | procedure TfColorDialog.tbSatEditingDone(Sender: TObject);
545 | var
546 | v : double;
547 | begin
548 | v := StrToFloat(tbSat.Text) / 100;
549 | if v < 0 then v := 0;
550 | if v > 1 then v := 1;
551 | DesiredHSL.s := v;
552 | SetHSLColor;
553 | end;
554 |
555 | procedure TfColorDialog.tbLumEditingDone(Sender: TObject);
556 | var
557 | v : double;
558 | begin
559 | v := StrToFloat(tbLum.Text) / 100;
560 | if v < 0 then v := 0;
561 | if v > 1 then v := 1;
562 | DesiredHSL.l := v;
563 | SetHSLColor;
564 | end;
565 |
566 | procedure TfColorDialog.tbLEditingDone(Sender: TObject);
567 | var
568 | v : double;
569 | begin
570 | v := StrToFloat(tbL.Text);
571 | if v < 0 then v := 0;
572 | if v > 100 then v := 100;
573 | DesiredLAB.l := v;
574 | SetLABColor;
575 | end;
576 |
577 | procedure TfColorDialog.tbAEditingDone(Sender: TObject);
578 | var
579 | v : double;
580 | begin
581 | v := StrToFloat(tbA.Text);
582 | if v < -100 then v := -100;
583 | if v > 100 then v := 100;
584 | DesiredLAB.a := v;
585 | SetLABColor;
586 | end;
587 |
588 | procedure TfColorDialog.tbBEditingDone(Sender: TObject);
589 | begin
590 | DesiredLAB.b := StrToFloat(tbB.Text);
591 | SetLABColor;
592 | end;
593 |
594 |
595 | procedure TfColorDialog.pbHSMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
596 | var
597 | pb : TPaintBox;
598 | w, h : integer;
599 | begin
600 | // pick this color. mark as moving
601 | drag := true;
602 |
603 | pb := TPaintBox(Sender);
604 | w := pb.ClientRect.Width;
605 | h := pb.ClientRect.Height;
606 |
607 | // get hs
608 | DesiredHSL.h := x / w;
609 | DesiredHSL.s := y / h;
610 | SetHSLColor;
611 | end;
612 |
613 | procedure TfColorDialog.pbHSMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
614 | var
615 | pb : TPaintBox;
616 | w, h : integer;
617 | begin
618 | // pick this color. mark as moving
619 | pb := TPaintBox(Sender);
620 | w := pb.ClientRect.Width;
621 | h := pb.ClientRect.Height;
622 |
623 | if drag and between(X, 0, w - 1) and between(Y, 0, h - 1) then
624 | begin
625 | // get hs
626 | DesiredHSL.h := x / w;
627 | DesiredHSL.s := y / h;
628 | SetHSLColor;
629 | end;
630 | end;
631 |
632 | procedure TfColorDialog.pbHSMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
633 | begin
634 | // pick this color. mark as moving
635 | drag := false;
636 | end;
637 |
638 | procedure TfColorDialog.pbHSPaint(Sender: TObject);
639 | var
640 | pb : TPaintBox;
641 | cnv : TCanvas;
642 | w, h : integer;
643 | x, y : integer;
644 | rect : TRect;
645 | begin
646 | pb := TPaintBox(Sender);
647 | cnv := pb.Canvas;
648 | w := pb.ClientRect.Width;
649 | h := pb.ClientRect.Height;
650 |
651 | cnv.Draw(0, 0, bmpHS);
652 | Draw3DRect(cnv, pb.ClientRect, true);
653 |
654 | x := floor((StrToFloat(tbHue.Text) / 100.0) * w);
655 | y := floor((StrToFloat(tbSat.Text) / 100.0) * h);
656 | rect.Top := y - 1;
657 | rect.Left := x - 1;
658 | rect.Width := 3;
659 | rect.Height := 3;
660 | cnv.Brush.Style := bsClear;
661 | cnv.Pen.Color := clWhite;
662 | cnv.Rectangle(rect);
663 | rect.inflate(1, 1);
664 | cnv.Pen.Color := clBlack;
665 | cnv.Rectangle(rect);
666 | end;
667 |
668 | procedure TfColorDialog.pbLMouseDown(Sender: TObject; Button: TMouseButton;
669 | Shift: TShiftState; X, Y: Integer);
670 | var
671 | pb : TPaintBox;
672 | h : integer;
673 | begin
674 | // pick this color. mark as moving
675 | drag := true;
676 |
677 | pb := TPaintBox(Sender);
678 | h := pb.ClientRect.Height;
679 |
680 | // get hs
681 | DesiredHSL.l := y / h;
682 |
683 | SetHSLColor;
684 | end;
685 |
686 | procedure TfColorDialog.pbLMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
687 | var
688 | pb : TPaintBox;
689 | w, h : integer;
690 | begin
691 | pb := TPaintBox(Sender);
692 | w := pb.ClientRect.Width;
693 | h := pb.ClientRect.Height;
694 |
695 | if drag and between(X, 0, w - 1) and between(Y, 0, h - 1) then
696 | begin
697 | // get hs
698 | DesiredHSL.l := y / h;
699 |
700 | SetHSLColor;
701 | end;
702 | end;
703 |
704 | procedure TfColorDialog.pbLMouseUp(Sender: TObject; Button: TMouseButton;
705 | Shift: TShiftState; X, Y: Integer);
706 | begin
707 | drag := false;
708 | end;
709 |
710 | procedure TfColorDialog.pbLPaint(Sender: TObject);
711 | var
712 | w, h : integer;
713 | pb : TPaintBox;
714 | cnv : TCanvas;
715 | y : integer;
716 | hsl : THSL;
717 | rgb : TRGB;
718 | r, g, b : byte;
719 | rect : TRect;
720 | begin
721 | // need to draw this custom every time
722 | pb := TPaintBox(Sender);
723 | cnv := pb.Canvas;
724 | w := pb.ClientRect.Width;
725 | h := pb.ClientRect.Height;
726 |
727 | hsl.h := (StrToFloat(tbHue.Text) / 100);
728 | hsl.s := (StrToFloat(tbSat.Text) / 100);
729 | for y := 0 to h - 1 do
730 | begin
731 | hsl.l := y / h;
732 | rgb := HSL2RGB(hsl);
733 | r := floor(rgb.r * 255.0);
734 | g := floor(rgb.g * 255.0);
735 | b := floor(rgb.b * 255.0);
736 | cnv.Pen.Mode := pmCopy;
737 | cnv.Pen.Width := 1;
738 | cnv.Pen.Color := RGBToColor(r, g, b);
739 | cnv.Line(0, y, w - 1, y);
740 | end;
741 | Draw3DRect(cnv, pb.ClientRect, true);
742 |
743 | y := floor((StrToFloat(tbLum.Text) / 100.0) * h);
744 | rect.Top := y - 1;
745 | rect.Left := 0;
746 | rect.Height := 3;
747 | rect.Width := w;
748 |
749 | cnv.Brush.Style := bsClear;
750 | cnv.Pen.Color := clWhite;
751 | cnv.Pen.Mode:= pmXor;
752 | cnv.Rectangle(rect);
753 | end;
754 |
755 | { CONVERT RGB TO XYZ }
756 | function RGB2XYZ(rgb: TRGB): TXYZ;
757 | var
758 | r, g, b: double;
759 | xyz: TXYZ;
760 |
761 | {------------------------------------------------------------------------------
762 | CONVERSION FOR RGB TO XYZ
763 | }
764 | function _F2S(v: real): real; inline;
765 | var
766 | ret : double;
767 | begin
768 | if v > 0.04045 then
769 | ret := power((v + 0.055) / 1.055, 2.2)
770 | else
771 | ret := v / 12.92;
772 | _F2S := ret;
773 | end;
774 |
775 | begin
776 | r := _F2S(rgb.r);
777 | g := _F2S(rgb.g);
778 | b := _F2S(rgb.b);
779 | xyz.x := (r * 0.4124 + g * 0.3576 + b * 0.1805);
780 | xyz.y := (r * 0.2126 + g * 0.7152 + b * 0.0722);
781 | xyz.z := (r * 0.0193 + g * 0.1192 + b * 0.9505);
782 | RGB2XYZ := xyz;
783 | end;
784 |
785 | { CONVERT RGB TO HSL }
786 | function RGB2HSL(rgb: TRGB): THSL;
787 | var
788 | mx, mn, delta: double;
789 | begin
790 | mx := Max(rgb.r, Max(rgb.g, rgb.b));
791 | mn := Min(rgb.r, Min(rgb.g, rgb.b));
792 | result.l := (mx + mn) / 2.0;
793 |
794 | if mx = mn then
795 | begin
796 | result.h := 0;
797 | result.s := 0;
798 | end
799 | else
800 | begin
801 | delta := mx - mn;
802 | if result.l > 0.5 then
803 | result.s := delta / (2 - mx - mn)
804 | else
805 | result.s := delta / (mx + mn);
806 | if rgb.r = mx then
807 | begin
808 | result.h := (rgb.g - rgb.b) / delta;
809 | if rgb.g < rgb.b then
810 | result.h := result.h + 6.0;
811 | end
812 | else
813 | if rgb.g = mx then
814 | result.h := (rgb.b - rgb.r) / delta + 2
815 | else
816 | result.h := (rgb.r - rgb.g) / delta + 4;
817 | end;
818 | if result.s = 0.0 then
819 | result.h := 0.0
820 | else
821 | begin
822 | result.h := result.h / 6.0;
823 | result.h := result.h - floor(result.h);
824 | end;
825 | end;
826 |
827 | { CONVERT XYZ TO LAB }
828 | function XYZ2LAB(xyz: TXYZ): TLAB;
829 |
830 | {------------------------------------------------------------------------------
831 | CONVERSION FOR XYZ TO LAB
832 | }
833 | function _FXYZ(t: real): real; inline;
834 | var
835 | ret: real;
836 | begin
837 | if t > 0.008856 then
838 | ret := power(t, 1.0 / 3.0)
839 | else
840 | ret := 7.787 * t + (16.0 / 116.0);
841 | _FXYZ := ret;
842 | end;
843 |
844 | begin
845 | result.l := 116.0 * _FXYZ(xyz.y / d65.y) - 16.0;
846 | result.a := 500.0 * (_FXYZ(xyz.x / d65.x) - _FXYZ(xyz.y / d65.y));
847 | result.b := 200.0 * (_FXYZ(xyz.y / d65.y) - _FXYZ(xyz.z / d65.z));
848 | end;
849 |
850 | { CONVERT HSL TO RGB }
851 | function HSL2RGB(hsl: THSL): TRGB;
852 | var
853 | q, p: real;
854 |
855 | {------------------------------------------------------------------------------
856 | CONVERSION FOR HSL TO RGB
857 | }
858 | function _FHSL(p, q, t: real): real; inline;
859 | begin
860 | result := p;
861 | if t < 0.0 then
862 | t := t + 1.0;
863 |
864 | if t > 1.0 then
865 | t := t - 1.0;
866 |
867 | if t * 6 < 1 then
868 | result := p + (q - p) * 6.0 * t
869 | else if t * 2 < 1 then
870 | result := q
871 | else if t * 3 < 2 then
872 | result := p + (q - p) * (2 / 3 - t) * 6;
873 | end;
874 |
875 | begin
876 | if hsl.s = 0 then
877 | begin
878 | result.r := hsl.l;
879 | result.g := hsl.l;
880 | result.b := hsl.l;
881 | end
882 | else
883 | begin
884 | if hsl.l < 0.5 then
885 | q := hsl.l * (1 + hsl.s)
886 | else
887 | q := (hsl.l + hsl.s) - (hsl.l * hsl.s);
888 | p := 2.0 * hsl.l - q;
889 | result.r := _FHSL(p, q, hsl.h + 1 / 3);
890 | result.g := _FHSL(p, q, hsl.h);
891 | result.b := _FHSL(p, q, hsl.h - 1 / 3);
892 | end;
893 | end;
894 |
895 | { CONVERT XYZ to RGB }
896 | function XYZ2RGB(xyz: TXYZ): TRGB;
897 | var
898 | r, g, b: double;
899 |
900 | {------------------------------------------------------------------------------
901 | CONVERSION FOR XYZ TO RGB
902 | }
903 | function _FFROMS(v: real): real; inline;
904 | begin
905 | if v <= 0.0031308 then
906 | result := 12.92 * v
907 | else
908 | result := (1.055 * power(v, 0.416667)) - 0.055;
909 | end;
910 |
911 | begin
912 | r := xyz.x * 3.2410 - xyz.y * 1.5374 - xyz.z * 0.4986;
913 | g := -xyz.x * 0.9692 + xyz.y * 1.8760 + xyz.z * 0.0416;
914 | b := xyz.x * 0.0556 - xyz.y * 0.2040 + xyz.z * 1.0570;
915 | result.r := _FFROMS(r);
916 | result.g := _FFROMS(g);
917 | result.b := _FFROMS(b);
918 | end;
919 |
920 | { CONVERT LAB TO XYZ }
921 | function LAB2XYZ(lab: TLAB): TXYZ;
922 | var
923 | fx, fy, fz: double;
924 |
925 | {------------------------------------------------------------------------------
926 | CONVERSION FOR LAB TO XYZ
927 | }
928 | function _FLABADJ(v, w: real): real; inline;
929 | const
930 | delta: double = 6.0 / 29.0;
931 | var
932 | ret: double;
933 | begin
934 | if v > delta then
935 | result := w * (v * v * v)
936 | else
937 | result := (v - 16.0 / 116.0) * 3 * (delta * delta) * w;
938 | end;
939 |
940 | begin
941 | fy := (lab.l + 16.0) / 116.0;
942 | fx := fy + (lab.a / 500.0);
943 | fz := fy - (lab.b / 200.0);
944 | result.x := _FLABADJ(fx, d65.x);
945 | result.y := _FLABADJ(fy, d65.y);
946 | result.z := _FLABADJ(fz, d65.z);
947 | end;
948 |
949 | function doubletostr(v : double) : string;
950 | begin
951 | result := Format('%.2f', [ v ]);
952 | end;
953 |
954 | procedure TfColorDialog.FormCreate(Sender: TObject);
955 | var
956 | w, h : integer;
957 | x, y : integer;
958 | r, g, b : integer;
959 | i : integer;
960 | hsl : THSL;
961 | rgb : TRGB;
962 | xyz : TXYZ;
963 | begin
964 | w := pbHS.Width;
965 | h := pbHS.Height;
966 |
967 | SetANSIColor;
968 | bmpHS := TBitmap.Create;
969 | bmpHS.Width := w;
970 | bmpHS.Height := h;
971 | bmpHS.PixelFormat := pf24bit;
972 | for y := 0 to h - 1 do
973 | for x := 0 to w - 1 do
974 | begin
975 | hsl.h := x / w;
976 | hsl.s := y / h;
977 | hsl.l := 0.5;
978 | rgb := HSL2RGB(hsl);
979 | r := floor(rgb.r * 255);
980 | g := floor(rgb.g * 255);
981 | b := floor(rgb.b * 255);
982 | bmpHS.Canvas.Pixels[x, y] := RGBToColor(r, g, b);
983 | end;
984 |
985 | // ansi lab lut
986 | for i := 0 to 255 do
987 | begin
988 | r := (ANSIColor[i] ) and $FF;
989 | g := (ANSIColor[i] >> 8) and $FF;
990 | b := (ANSIColor[i] >> 16) and $FF;
991 | rgb := SetRGB(r, g, b);
992 | xyz := RGB2XYZ(rgb);
993 | ANSILAB[i] := XYZ2LAB(xyz);
994 | end;
995 |
996 | end;
997 |
998 | procedure TfColorDialog.FormDestroy(Sender: TObject);
999 | begin
1000 | bmpHS.Free;
1001 | end;
1002 |
1003 | procedure TfColorDialog.FormShow(Sender: TObject);
1004 | begin
1005 | // number of rows to display for colors
1006 | rows := iif(fMaxColors = 256, 15, 0);
1007 | if fColor > fMaxColors then
1008 | fColor := fMaxColors - 1;
1009 | end;
1010 |
1011 | procedure TfColorDialog.pbColorsMouseDown(Sender: TObject;
1012 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1013 | var
1014 | pb : TPaintBox;
1015 | x1, y1 : integer;
1016 | cw, ch : integer;
1017 | c : integer;
1018 | begin
1019 | pb := TPaintBox(Sender);
1020 | cw := pb.Width >> 4;
1021 | ch := pb.Height >> 4;
1022 | x1 := x div cw;
1023 | y1 := y div ch;
1024 | if between(x1, 0, 15) and between(y1, 0, rows) then
1025 | begin
1026 | c := x1 + (y1 << 4);
1027 | if between(c, 0, fMaxColors - 1) then
1028 | begin
1029 | fColor := c;
1030 | SetANSIColor;
1031 | pbColors.Invalidate;
1032 | end;
1033 | end;
1034 | end;
1035 |
1036 | initialization
1037 | {$R *.lfm}
1038 |
1039 | end.
1040 |
1041 |
--------------------------------------------------------------------------------
/vtxedit.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/vtxedit.ico
--------------------------------------------------------------------------------
/vtxedit.ini:
--------------------------------------------------------------------------------
1 | [VTXEdit]
2 | PreviewBoxOpen=1
3 | WindowMax=1
4 | Window=0,0 1046,689
5 | PreviewBox=1340,231 168,363
6 |
7 | [KeyBinds]
8 | Up=CursorUp
9 | Down=CursorDown
10 | Left=CursorLeft
11 | Right=CursorRight
12 | Ctrl+Up=NextFG
13 | Ctrl+Down=PrevFG
14 | Ctrl+Left=PrevBG
15 | Ctrl+Right=NextBG
16 | Return=CursorNewLine
17 | Tab=CursorForwardTab
18 | Shift+Tab=CursorBackwardTab
19 | Back=CursorBack
20 | F1=Print @FKey1@
21 | F2=Print @FKey2@
22 | F3=Print @FKey3@
23 | F4=Print @FKey4@
24 | F5=Print @FKey5@
25 | F6=Print @FKey6@
26 | F7=Print @FKey7@
27 | F8=Print @FKey8@
28 | F9=Print @FKey9@
29 | F10=Print @FKey10@
30 | Alt+F1=FKeySet 1
31 | Alt+F2=FKeySet 2
32 | Alt+F3=FKeySet 3
33 | Alt+F4=FKeySet 4
34 | Alt+F5=FKeySet 5
35 | Alt+F6=FKeySet 6
36 | Alt+F7=FKeySet 7
37 | Alt+F8=FKeySet 8
38 | Alt+F9=FKeySet 9
39 | Alt+F10=FKeySet 10
40 | Alt+1=ModeChars
41 | Alt+2=ModeLeftRightBlocks
42 | Alt+3=ModeTopBottomBlocks
43 | Alt+4=ModeQuarterBlocks
44 | Alt+5=ModeSixels
45 | ALT+S=ToolSelect
46 | Alt+D=ToolDraw
47 | Alt+P=ToolPaint
48 | Alt+F=ToolFill
49 | Alt+L=ToolLine
50 | Alt+R=ToolRectangle
51 | Alt+E=ToolEllipse
52 | Alt+Y=ToolEyeDropper
53 | Alt+Space=Print \xA0
54 | Ctrl+Space=Print @CurrChar@
55 | Ctrl+N=FileNew
56 | Ctrl+O=FileOpen
57 | Ctrl+S=FileSave
58 | Ctrl+Q=FileExit
59 | ; =FileSaveAs
60 | ; =FileImport
61 | ; =FileExport
62 | ; =ShowPreview
63 | Ctrl+X=EditCut
64 | Ctrl+C=EditCopy
65 | Ctrl+V=EditPaste
66 | Ctrl+Z=EditUndo
67 | Shift+Ctrl+Z=EditRedo
68 | Ctrl+PgUp=ObjectMoveForward
69 | Ctrl+PgDn=ObjectMoveBack
70 | Shift+PgUp=ObjectMoveToFront
71 | Shift+PgDn=ObjectMoveToBack
72 | Shift+Down=ObjectMerge
73 | Ctrl+Shift+Down=ObjectMergeAll
74 | Ctrl+Tab=ObjectNext
75 | ; =ObjectFlipHorz
76 | ; =ObjectFlipVert
77 | ; =ObjectPrev
78 | ;
79 | Del=Delete
80 | Esc=Escape
81 |
--------------------------------------------------------------------------------
/vtxencdetect.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | unit VTXEncDetect;
31 |
32 | {$mode objfpc}{$H+}
33 |
34 | interface
35 |
36 | uses
37 | Classes, SysUtils;
38 |
39 | type
40 | TDetectEnc = (
41 | deNone, deAnsi, deAscii, deUtf8Bom, deUtf8NoBom,
42 | deUtf16LeBom, deUtf16LeNoBom, deUtf16BeBom, deUtf16BeNoBom );
43 |
44 |
45 | function DetectEncoding(buffer : TBytes) : TDetectEnc;
46 | function CheckBom(buffer : TBytes) : TDetectEnc;
47 |
48 |
49 | implementation
50 |
51 | const
52 | _utf16BeBom : array [0..1] of byte = ( $FE, $FF );
53 | _utf16LeBom : array [0..1] of byte = ( $FF, $FE );
54 | _utf8Bom : array [0..2] of byte = ( $EF, $BB, $BF );
55 |
56 | var
57 | _nullSuggestsBinary : boolean = true;
58 | _utf16ExpectedNullPercent : double = 70;
59 | _utf16UnexpectedNullPercent : double = 10;
60 |
61 | function GetBomLengthFromEncodingMode(encoding : TDetectEnc) : integer;
62 | begin
63 | case encoding of
64 | deUtf16BeBom,
65 | deUtf16LeBom:
66 | result := 2;
67 |
68 | deUtf8Bom:
69 | result := 3;
70 |
71 | else
72 | result := 0;
73 | end;
74 | end;
75 |
76 | function CheckBom(buffer : TBytes) : TDetectEnc;
77 | var
78 | size : longint;
79 | begin
80 | size := length(buffer);
81 | result := deNone;
82 | if (size >= 2)
83 | and (buffer[0] = _utf16LeBom[0])
84 | and (buffer[1] = _utf16LeBom[1]) then
85 | result := deUtf16LeBom;
86 | if (size >= 2)
87 | and (buffer[0] = _utf16BeBom[0])
88 | and (buffer[1] = _utf16BeBom[1]) then
89 | result := deUtf16BeBom;
90 | if (size >= 3)
91 | and (buffer[0] = _utf8Bom[0])
92 | and (buffer[1] = _utf8Bom[1])
93 | and (buffer[2] = _utf8Bom[2]) then
94 | result := deUtf8Bom;
95 | end;
96 |
97 | function CheckUtf8(buffer : TBytes) : TDetectEnc;
98 | var
99 | pos : integer;
100 | modeChars : integer;
101 | ch : byte;
102 | onlySawAsciiRange : boolean;
103 | size : longint;
104 | begin
105 | size := length(buffer);
106 | pos := 0;
107 | while pos < size do
108 | begin
109 | ch := buffer[pos];
110 | pos += 1;
111 | if (ch = $00) and _nullSuggestsBinary then
112 | begin result := deNone; exit; end;
113 |
114 | if ch <= 127 then modeChars := 0
115 | else if (ch >= 194) and (ch <= 223) then modeChars := 1
116 | else if (ch >= 224) and (ch <= 239) then modeChars := 2
117 | else if (ch >= 240) and (ch <= 244) then modeChars := 4
118 | else
119 | begin result := deNone; exit; end;
120 |
121 | while (modechars > 0) and (pos < size) do
122 | begin
123 | onlySawAsciiRange := false;
124 | ch := buffer[pos];
125 | pos += 1;
126 | if (ch < 127) or (ch > 191) then
127 | begin result := deNone; exit; end;
128 | modeChars -= 1;
129 | end;
130 | end;
131 | if onlySawAsciiRange then
132 | result := deAscii
133 | else
134 | result := deUtf8NoBom;
135 | end;
136 |
137 |
138 | function CheckUtf16NewLineChars(buffer : TBytes) : TDetectEnc;
139 | var
140 | leControlChars : integer;
141 | beControlChars : integer;
142 | pos : integer;
143 | ch1, ch2 : byte;
144 | size : longint;
145 | begin
146 | size := length(buffer);
147 | if size < 2 then
148 | begin
149 | result := deNone;
150 | exit;
151 | end;
152 | size -= 1;
153 |
154 | leControlChars := 0;
155 | beControlChars := 0;
156 |
157 | pos := 0;
158 | while pos < size do
159 | begin
160 | ch1 := buffer[pos];
161 | pos += 1;
162 | ch2 := buffer[pos];
163 | pos += 1;
164 | if ch1 = $00 then
165 | begin
166 | if (ch2 = $0A) or (ch2 = $0d) then
167 | beControlChars += 1;
168 | end
169 | else if ch2 = $00 then
170 | begin
171 | if (ch1 = $0a) or (ch1 = $0d) then
172 | leControlChars += 1;
173 | end;
174 | if (leControlChars > 0) and (beControlChars > 0) then
175 | begin result := deNone; exit; end;
176 | end;
177 | if leControlChars > 0 then
178 | begin result := deUtf16LeNoBom; exit; end;
179 | if beControlChars > 0 then
180 | result := deUtf16BeNoBom
181 | else
182 | result := deNone;
183 | end;
184 |
185 | function DoesContainNulls(buffer : TBytes) : boolean;
186 | var
187 | pos : integer;
188 | size : longint;
189 | begin
190 | size := length(buffer);
191 | pos := 0;
192 | result := false;
193 | while pos < size do
194 | begin
195 | if buffer[pos] = $00 then
196 | begin result := true; break; end;
197 |
198 | pos += 1;
199 | end;
200 | end;
201 |
202 | function CheckUtf16Ascii(buffer : TBytes) : TDetectEnc;
203 | var
204 | numOddNulls,
205 | numEvenNulls : integer;
206 | pos : integer;
207 | evenNullThreshold,
208 | oddNullThreshold,
209 | expectedNullThreshold,
210 | unexpectedNullThreashold : double;
211 | size : longint;
212 | begin
213 | size := length(buffer);
214 | numOddNulls := 0;
215 | numEvenNulls := 0;
216 | pos := 0;
217 | while pos < size do
218 | begin
219 | if buffer[pos] = $00 then
220 | numEvenNulls += 1;
221 | if pos + 1 < size then
222 | if buffer[pos + 1] = $00 then
223 | numOddNulls += 1;
224 | pos += 2;
225 | end;
226 | evenNullThreshold := numEvenNulls * 2.0 / size;
227 | oddNullThreshold := numOddNulls * 2.0 / size;
228 | expectedNullThreshold := _utf16ExpectedNullPercent / 100;
229 | unexpectedNullThreashold := _utf16UnexpectedNullPercent / 100;
230 |
231 | if (evenNullThreshold < unexpectedNullThreashold) and (oddNullThreshold > expectedNullThreshold) then
232 | begin result := deUtf16LeNoBom; exit end;
233 |
234 | if (oddNullThreshold < unexpectedNullThreashold) and (evenNullThreshold > expectedNullThreshold) then
235 | begin result := deUtf16BeBom; exit; end;
236 |
237 | result := deNone;
238 | end;
239 |
240 | function DetectEncoding(buffer : TBytes) : TDetectEnc;
241 | var
242 | encoding : TDetectEnc;
243 | size : longint;
244 | begin
245 | size := length(buffer);
246 | encoding := CheckBom(buffer);
247 | if encoding <> deNone then
248 | begin result := encoding; exit; end;
249 |
250 | encoding := CheckUtf8(buffer);
251 | if encoding <> deNone then
252 | begin result := encoding; exit; end;
253 |
254 | // encoding := CheckUtf16NewlineChars(buffer);
255 | // if encoding <> deNone then
256 | // begin result := encoding; exit; end;
257 |
258 | encoding := CheckUtf16Ascii(buffer);
259 | if encoding <> deNone then
260 | begin result := encoding; exit; end;
261 |
262 | if not DoesContainNulls(buffer) then
263 | begin result := deAnsi; exit; end;
264 |
265 | if _nullSuggestsBinary then
266 | result := deNone
267 | else
268 | result := deAnsi;
269 |
270 | end;
271 |
272 | end.
273 |
274 |
--------------------------------------------------------------------------------
/vtxexportoptions.lfm:
--------------------------------------------------------------------------------
1 | object fExportOptions: TfExportOptions
2 | Left = 703
3 | Height = 123
4 | Top = 419
5 | Width = 265
6 | BorderStyle = bsDialog
7 | Caption = 'Export Options'
8 | ClientHeight = 123
9 | ClientWidth = 265
10 | LCLVersion = '1.6.4.0'
11 | object cbUseLineLen: TCheckBox
12 | Left = 14
13 | Height = 19
14 | Top = 12
15 | Width = 127
16 | Caption = 'Restrict Line Length:'
17 | TabOrder = 0
18 | end
19 | object cbUseSauce: TCheckBox
20 | Left = 14
21 | Height = 19
22 | Top = 32
23 | Width = 104
24 | Caption = 'Append SAUCE.'
25 | TabOrder = 1
26 | end
27 | object Button1: TButton
28 | Left = 102
29 | Height = 25
30 | Top = 92
31 | Width = 75
32 | Caption = 'OK'
33 | ModalResult = 1
34 | TabOrder = 2
35 | end
36 | object Button2: TButton
37 | Left = 180
38 | Height = 25
39 | Top = 92
40 | Width = 75
41 | Caption = 'Cancel'
42 | ModalResult = 2
43 | TabOrder = 3
44 | end
45 | object seLineLen: TSpinEdit
46 | Left = 179
47 | Height = 21
48 | Top = 10
49 | Width = 76
50 | Font.Height = -11
51 | MaxValue = 132
52 | MinValue = 40
53 | ParentFont = False
54 | TabOrder = 4
55 | Value = 79
56 | end
57 | object cbStaticObjects: TCheckBox
58 | Left = 14
59 | Height = 19
60 | Top = 52
61 | Width = 95
62 | Caption = 'Static Objects.'
63 | TabOrder = 5
64 | end
65 | object cbUseBOM: TCheckBox
66 | Left = 14
67 | Height = 19
68 | Top = 70
69 | Width = 135
70 | Caption = 'Prefix Encoding BOM.'
71 | TabOrder = 6
72 | end
73 | end
74 |
--------------------------------------------------------------------------------
/vtxexportoptions.lrs:
--------------------------------------------------------------------------------
1 | { This is an automatically generated lazarus resource file }
2 |
3 | LazarusResources.Add('TfExportOptions','FORMDATA',[
4 | 'TPF0'#15'TfExportOptions'#14'fExportOptions'#4'Left'#3#191#2#6'Height'#2'{'#3
5 | +'Top'#3#163#1#5'Width'#3#9#1#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#14'E'
6 | +'xport Options'#12'ClientHeight'#2'{'#11'ClientWidth'#3#9#1#10'LCLVersion'#6
7 | +#7'1.6.4.0'#0#9'TCheckBox'#12'cbUseLineLen'#4'Left'#2#14#6'Height'#2#19#3'To'
8 | +'p'#2#12#5'Width'#2#127#7'Caption'#6#21'Restrict Line Length:'#8'TabOrder'#2
9 | +#0#0#0#9'TCheckBox'#10'cbUseSauce'#4'Left'#2#14#6'Height'#2#19#3'Top'#2' '#5
10 | +'Width'#2'h'#7'Caption'#6#13'Append SAUCE.'#8'TabOrder'#2#1#0#0#7'TButton'#7
11 | +'Button1'#4'Left'#2'f'#6'Height'#2#25#3'Top'#2'\'#5'Width'#2'K'#7'Caption'#6
12 | +#2'OK'#11'ModalResult'#2#1#8'TabOrder'#2#2#0#0#7'TButton'#7'Button2'#4'Left'
13 | +#3#180#0#6'Height'#2#25#3'Top'#2'\'#5'Width'#2'K'#7'Caption'#6#6'Cancel'#11
14 | +'ModalResult'#2#2#8'TabOrder'#2#3#0#0#9'TSpinEdit'#9'seLineLen'#4'Left'#3#179
15 | +#0#6'Height'#2#21#3'Top'#2#10#5'Width'#2'L'#11'Font.Height'#2#245#8'MaxValue'
16 | +#3#132#0#8'MinValue'#2'('#10'ParentFont'#8#8'TabOrder'#2#4#5'Value'#2'O'#0#0
17 | +#9'TCheckBox'#15'cbStaticObjects'#4'Left'#2#14#6'Height'#2#19#3'Top'#2'4'#5
18 | +'Width'#2'_'#7'Caption'#6#15'Static Objects.'#8'TabOrder'#2#5#0#0#9'TCheckBo'
19 | +'x'#8'cbUseBOM'#4'Left'#2#14#6'Height'#2#19#3'Top'#2'F'#5'Width'#3#135#0#7'C'
20 | +'aption'#6#20'Prefix Encoding BOM.'#8'TabOrder'#2#6#0#0#0
21 | ]);
22 |
--------------------------------------------------------------------------------
/vtxexportoptions.pas:
--------------------------------------------------------------------------------
1 | unit VTXExportOptions;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
9 | StdCtrls, Spin;
10 |
11 | type
12 |
13 | { TfExportOptions }
14 |
15 | TfExportOptions = class(TForm)
16 | Button1: TButton;
17 | Button2: TButton;
18 | cbUseLineLen: TCheckBox;
19 | cbUseSauce: TCheckBox;
20 | cbStaticObjects: TCheckBox;
21 | cbUseBOM: TCheckBox;
22 | seLineLen: TSpinEdit;
23 | private
24 | { private declarations }
25 | public
26 | { public declarations }
27 | end;
28 |
29 | var
30 | fExportOptions: TfExportOptions;
31 |
32 | implementation
33 |
34 | { TfExportOptions }
35 |
36 | initialization
37 | {$I vtxexportoptions.lrs}
38 |
39 | end.
40 |
41 |
--------------------------------------------------------------------------------
/vtxpreviewbox.lfm:
--------------------------------------------------------------------------------
1 | object fPreview: TfPreview
2 | Left = 1194
3 | Height = 363
4 | Top = 262
5 | Width = 300
6 | BorderIcons = []
7 | BorderStyle = bsSizeToolWin
8 | Caption = 'Preview'
9 | ClientHeight = 363
10 | ClientWidth = 300
11 | FormStyle = fsStayOnTop
12 | OnCreate = FormCreate
13 | OnShow = FormShow
14 | ShowInTaskBar = stNever
15 | LCLVersion = '1.6.4.0'
16 | object ScrollBox1: TScrollBox
17 | Left = 0
18 | Height = 363
19 | Top = 0
20 | Width = 300
21 | HorzScrollBar.Increment = 10
22 | HorzScrollBar.Page = 105
23 | HorzScrollBar.Smooth = True
24 | HorzScrollBar.Tracking = True
25 | VertScrollBar.Increment = 10
26 | VertScrollBar.Page = 106
27 | VertScrollBar.Smooth = True
28 | VertScrollBar.Tracking = True
29 | Anchors = [akTop, akLeft, akRight, akBottom]
30 | ClientHeight = 359
31 | ClientWidth = 296
32 | Color = clBlack
33 | ParentColor = False
34 | TabOrder = 0
35 | OnPaint = ScrollBox1Paint
36 | object pbPreview: TPaintBox
37 | Left = 0
38 | Height = 105
39 | Top = 1
40 | Width = 105
41 | Align = alCustom
42 | Color = clBlack
43 | ParentColor = False
44 | OnPaint = pbPreviewPaint
45 | end
46 | end
47 | end
48 |
--------------------------------------------------------------------------------
/vtxpreviewbox.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | unit VTXPreviewBox;
31 |
32 | {$mode objfpc}{$H+}
33 |
34 | interface
35 |
36 | uses
37 | Classes,
38 | {$ifdef WINDOWS} Windows, {$endif}
39 | Forms,
40 | Graphics,
41 | ExtCtrls,
42 | VTXConst,
43 | VTXSupport,
44 | math,
45 | BGRABitmap,
46 | BGRABitmapTypes
47 | ;
48 |
49 | type
50 |
51 | { TfPreview }
52 |
53 | TfPreview = class(TForm)
54 | pbPreview: TPaintBox;
55 | ScrollBox1: TScrollBox;
56 | procedure FormCreate(Sender: TObject);
57 | procedure FormShow(Sender: TObject);
58 | procedure pbPreviewPaint(Sender: TObject);
59 | procedure ScrollBox1Paint(Sender: TObject);
60 | private
61 | { private declarations }
62 | public
63 | { public declarations }
64 | end;
65 |
66 | var
67 | fPreview : TfPreview;
68 | ScrollWidth : integer;
69 |
70 | implementation
71 |
72 | {$R *.lfm}
73 |
74 | { TfPreview }
75 | procedure TfPreview.FormCreate(Sender: TObject);
76 | {$ifdef WINDOWS}
77 | var
78 | loc_SBInfo : TNonCLientMetrics;
79 | {$endif}
80 | begin
81 | DoubleBuffered:=true;
82 | {$ifdef WINDOWS}
83 | loc_SBInfo.cbSize := SizeOf(loc_SBInfo);
84 | SystemParametersInfo(SPI_GetNonClientMetrics,0,@loc_SBInfo,0);
85 | ScrollWidth := loc_SBInfo.iScrollWidth;
86 | {$else}
87 | // calculate scrollbar width.
88 | {$endif}
89 | end;
90 |
91 | procedure TfPreview.ScrollBox1Paint(Sender: TObject);
92 | var
93 | fw, w, h : integer;
94 | begin
95 | // set size of pbPreview to max zoom out for bmpPage
96 | if bmpPreview = nil then exit;
97 |
98 | w := floor(bmpPreview.Width * XScale);
99 | h := bmpPreview.Height;
100 | fw := w + 8;
101 |
102 | if h > ScrollBox1.ClientHeight then
103 | fw += ScrollWidth + 2;
104 |
105 | if width <> fw then
106 | begin
107 | self.Constraints.MaxWidth:=fw;
108 | self.Constraints.MinWidth:=fw;
109 | self.Width := fw;
110 | end;
111 | if pbPreview.Width <> w then
112 | pbPreview.Width := w;
113 |
114 | if pbPreview.Height <> h then
115 | pbPreview.Height := h;
116 | end;
117 |
118 | // this routine needs better looking / faster update
119 | // maybe drop the tscrollbox, move to panel/image, add scrollbars,
120 | // and only draw displayable chunk?
121 | procedure TfPreview.pbPreviewPaint(Sender: TObject);
122 | var
123 | pb : TPaintBox;
124 | cnv : TCanvas;
125 | bmp, bmp2 : TBGRABitmap;
126 | i, r, c, x, y : integer;
127 | off : longint;
128 | cell : TCell;
129 | cp : TEncoding;
130 | objonrow : boolean;
131 | objnum : integer;
132 | neighbors : byte;
133 | begin
134 | if (bmpPreview = nil) then exit;
135 |
136 | pb := TPaintBox(Sender);
137 | cnv := pb.Canvas;
138 | if XScale = 1 then
139 | cnv.Draw(0, 0, bmpPreview.Bitmap)
140 | else
141 | begin
142 | bmpPreview.ResampleFilter := rfMitchell;
143 | bmp2 := bmpPreview.Resample(pb.Width, pb.Height, rmFineResample) as TBGRABitmap;
144 | cnv.Draw(0, 0, bmp2.Bitmap);
145 | bmp2.Free;
146 | end;
147 |
148 | // draw objects over top
149 | // from topmost to bottommost
150 | bmp := TBGRABitmap.Create(8, 16);
151 | for r := 0 to NumRows - 1do
152 | begin
153 | // any objects on this row?
154 | y := (r << 2);
155 | for c := 0 to NumCols - 1 do
156 | begin
157 | x := floor((c << 1) * XScale);
158 | objnum := GetObjectCell(r, c, cell);
159 | if (objnum >= 0) and (not Objects[objnum].Hidden) then
160 | if cell.Chr <> _EMPTY then
161 | begin
162 | // object here.
163 | cp := Fonts[GetBits(cell.Attr, A_CELL_FONT_MASK, 28)];
164 | if (cp = encUTF8) or (cp = encUTF16) then
165 | off := GetGlyphOff(cell.Chr, CPages[cp].GlyphTable, CPages[cp].GlyphTableSize)
166 | else
167 | begin
168 | if cell.Chr > 255 then cell.Chr := 0;
169 | off := CPages[cp].QuickGlyph[cell.Chr];
170 | end;
171 | GetGlyphBmp(bmp, CPages[cp].GlyphTable, off, cell.Attr, false);
172 | // bmp.ResampleFilter:=rfMitchell;
173 | bmp2 := bmp.Resample(round(2 * XScale), 4, rmFineResample) as TBGRABitmap;
174 | cnv.Draw(x, y, bmp2.Bitmap);
175 | bmp2.free;
176 | end;
177 | end;
178 | end;
179 | bmp.free;
180 | end;
181 |
182 | procedure TfPreview.FormShow(Sender: TObject);
183 | var
184 | h, w, fw : integer;
185 | begin
186 | if bmpPage = nil then exit;
187 |
188 | w := floor(bmpPreview.Width * XScale);
189 | h := bmpPreview.Height;
190 | fw := w + 8;
191 |
192 | if h > ScrollBox1.ClientHeight then
193 | fw += ScrollWidth + 2;
194 |
195 | if Width <> fw then
196 | begin
197 | self.Constraints.MaxWidth:=fw;
198 | self.Constraints.MinWidth:=fw;
199 | self.Width := fw;
200 | end;
201 |
202 | if pbPreview.Width <> w then
203 | pbPreview.Width := w;
204 |
205 | if pbPreview.Height <> h then
206 | pbPreview.Height := h;
207 | end;
208 |
209 | end.
210 |
211 |
--------------------------------------------------------------------------------
/vtxsupport.pas:
--------------------------------------------------------------------------------
1 | {
2 |
3 | BSD 2-Clause License
4 |
5 | Copyright (c) 2017, Daniel Mecklenburg Jr. All rights reserved.
6 |
7 | Redistribution and use in source and binary forms, with or without modification,
8 | are permitted provided that the following conditions are met:
9 |
10 | * Redistributions of source code must retain the above copyright notice, this
11 | list of conditions and the following disclaimer.
12 |
13 | * Redistributions in binary form must reproduce the above copyright notice,
14 | this list of conditions and the following disclaimer in the documentation
15 | and/or other materials provided with the distribution.
16 |
17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 |
28 | }
29 |
30 | unit VTXSupport;
31 |
32 | {$mode objfpc}{$H+}
33 | {$modeswitch advancedrecords}
34 | {$ASMMODE intel}
35 |
36 | interface
37 |
38 | uses
39 | UnicodeHelper,
40 | Classes,
41 | Forms,
42 | SysUtils,
43 | ExtCtrls,
44 | VTXConst,
45 | BGRABitmap,
46 | BGRABitmapTypes,
47 | RecList,
48 | Math,
49 | {$ifdef WINDOWS}
50 | Windows,
51 | {$else}
52 | LCLType,
53 | {$endif}
54 | Graphics;
55 |
56 | procedure DrawDashLine(cnv : TCanvas; x1, y1, x2, y2 : integer; clr1, clr2 : TColor);
57 | procedure DrawDashRect(cnv : TCanvas; rect : TRect; clr1, clr2 : TColor);
58 | procedure DrawDashRect(cnv : TCanvas; x1, y1, x2, y2 : integer; clr1, clr2 : TColor);
59 | function GetGlyphOff(codepoint : integer; table : PByte; size : integer) : integer;
60 | procedure GetGlyphBmp(var bmp : TBGRABitmap; base : pbyte; off : integer; attr : Uint32; blink : boolean);
61 | function Between(val, lo, hi : integer) : boolean; inline;
62 | function Between(val, lo, hi : char) : boolean; inline;
63 | function HasBits(val, mask : UInt32) : boolean; inline;
64 | function GetBits(val, mask : UInt32; shift : integer = 0) : UInt32; inline;
65 | procedure SetBits(var val : UInt32; mask, bits : UInt32; shift : integer = 0); inline;
66 | procedure SetBit(var val : byte; mask : byte; bit : boolean); inline;
67 | procedure SetBit(var val : UInt32; mask : UInt32; bit : boolean); inline;
68 | procedure SetBit(var val : longint; mask : longint; bit : boolean); inline;
69 | procedure Swap(var val1, val2 : integer); inline;
70 | procedure Swap(var val1, val2 : UInt32); inline;
71 | function Brighten(color : TColor; factor: real): TColor;
72 | function DrawTextCentered(cnv: TCanvas; const r: TRect; s: unicodeString): Integer;
73 | function DrawTextRight(cnv: TCanvas; const r: TRect; s: unicodeString): Integer;
74 | procedure DrawRectangle(cnv: TCanvas; x1, y1, x2, y2 : integer; clr : TColor);
75 | procedure DrawRectangle(cnv: TCanvas; rect : TRect; clr : TColor);
76 | procedure LineCalcInit(x0, y0, x1, y1 : integer);
77 | function LineCalcNext(var xo, yo : integer) : boolean;
78 | procedure EllipseCalcInit(xrad, yrad : longint);
79 | function EllipseCalcNext(var xo, yo : longint) : boolean;
80 | function QuadToStr(q : TQuad) : unicodestring;
81 | function StrToQuad(str : unicodestring) : TQuad;
82 | procedure SetFormQuad(f : TForm; q : TQuad);
83 | function GetFormQuad(f : TForm) : TQuad;
84 | function CharsToStr(src : array of char; len : integer) : unicodestring;
85 | function CharsToStr(src : array of byte; len : integer) : unicodestring;
86 | function isInteger(str : unicodestring) : boolean;
87 | function iif(cond : boolean; trueval, falseval : integer) : integer; inline;
88 | function iif(cond : boolean; trueval, falseval : byte) : byte; inline;
89 | function iif(cond : boolean; trueval, falseval : char) : char; inline;
90 | function iif(cond : boolean; trueval, falseval : string) : string; inline;
91 | function iif(cond : boolean; trueval, falseval : unicodestring) : unicodestring; inline;
92 | function iif(cond : boolean; trueval, falseval : uint32) : uint32; inline;
93 | function RectWidth(r : TRect) : integer; inline;
94 | function RectHeight(r : TRect) : integer; inline;
95 | procedure DrawStretchedBitmap(cnv : TCanvas; r : TRect; bmp : TBGRABitmap);
96 | function GetObjectCell(row, col : integer; var cell : TCell) : integer;
97 | function InRect(x, y, rx, ry, rw, rh : integer) : boolean; inline;
98 | operator =(cell1, cell2 : TCell) : boolean;
99 | procedure Draw3DRect(cnv : TCanvas; rect : TRect; sunk : boolean);
100 | procedure Draw3DRect(cnv : TCanvas; x1, y1, x2, y2 : integer; sunk : boolean);
101 |
102 | var
103 | // various settings
104 | PageType : integer; // from cbPageType PAGETYPE_
105 | ColorScheme : integer; // from cbColorScheme COLORSCHEME_
106 |
107 | bmpPage : TBGRABitmap; // the page.
108 | bmpPreview : TBGRABitmap;
109 | PageZoom : double; // 1.0 = 100%
110 | XScale : double; // horizontal stretch. 1.0 = 100%
111 | CellWidth, CellHeight : integer; // pixels
112 | CellWidthZ, CellHeightZ : integer; // adjusted by PageZoom
113 | NumCols, NumRows : integer; // doc size
114 |
115 | Page : TPage; // main doc
116 |
117 | // objects on doc
118 | Objects : TObjList;
119 |
120 | // as cells are painted, updates get added to this. keep the original cell,
121 | // and update the new cell with the last cell painted.
122 | CurrUndoData : TRecList;
123 |
124 | // the undo/redo list
125 | UndoPos : integer; // where are we on the undo list
126 | Undo : TRecList; // the list
127 |
128 | // fonts. (CSI 10-19 / 80-85 D
129 | Fonts : array [0..15] of TEncoding;
130 |
131 | KeyBinds : array of TKeyBinds;
132 |
133 | implementation
134 |
135 | operator =(cell1, cell2 : TCell) : boolean;
136 | begin
137 | result := (cell1.Chr = cell2.Chr) and (cell1.Attr = cell2.Attr);
138 | end;
139 |
140 | {*****************************************************************************}
141 |
142 | { Support Functions }
143 |
144 | function InRect(x, y, rx, ry, rw, rh : integer) : boolean; inline;
145 | begin
146 | result := (x >= rx) and (x < rx + rw) and (y >= ry) and (y < ry + rh);
147 | end;
148 |
149 | function GetObjectCell(row, col : integer; var cell : TCell) : integer;
150 | var
151 | i : integer;
152 | objr, objc, p : integer;
153 | cellrec : TCell;
154 | begin
155 | for i := length(Objects) - 1 downto 0 do
156 | begin
157 | if InRect(
158 | col, row,
159 | Objects[i].Col, Objects[i].Row,
160 | Objects[i].Width, Objects[i].Height) then
161 | begin
162 | objr := row - Objects[i].Row;
163 | objc := col - Objects[i].Col;
164 | p := objr * Objects[i].Width + objc;
165 |
166 | Objects[i].Data.Get(@cellrec, p);
167 | if cellrec.Chr <> _EMPTY then
168 | begin
169 | cell := cellrec;
170 | exit(i);
171 | end;
172 | end;
173 | end;
174 | cell.Chr := _EMPTY;
175 | cell.Attr := $0007;
176 | result := -1;
177 | end;
178 |
179 | function VTXRGB(r, g, b : byte) : dword; inline;
180 | begin
181 | result := ((b << 16) or (g << 8) or r);
182 | end;
183 |
184 | function iif(cond : boolean; trueval, falseval : uint32) : uint32; inline;
185 | begin
186 | if cond then result := trueval else result := falseval;
187 | end;
188 |
189 | function iif(cond : boolean; trueval, falseval : unicodestring) : unicodestring; inline;
190 | begin
191 | if cond then result := trueval else result := falseval;
192 | end;
193 |
194 | function iif(cond : boolean; trueval, falseval : string) : string; inline;
195 | begin
196 | if cond then result := trueval else result := falseval;
197 | end;
198 |
199 | function iif(cond : boolean; trueval, falseval : char) : char; inline;
200 | begin
201 | if cond then result := trueval else result := falseval;
202 | end;
203 |
204 | function iif(cond : boolean; trueval, falseval : integer) : integer; inline;
205 | begin
206 | if cond then result := trueval else result := falseval;
207 | end;
208 |
209 | function iif(cond : boolean; trueval, falseval : byte) : byte; inline;
210 | begin
211 | if cond then result := trueval else result := falseval;
212 | end;
213 |
214 | // get offset of codepoint of glyph in UVGA16. return 0 if not found
215 | // called like GetGlyphOff(9673, @UVGA16, sizeof(UVGA16));
216 | function GetGlyphOff(codepoint : integer; table : PByte; size : integer) : integer;
217 | var
218 | rec, min, max : integer;
219 | key, off : integer;
220 | recs : integer;
221 | begin
222 | recs := size div 18;
223 |
224 | // do binary search for codepoint in glyphtable
225 | min := 0;
226 | max := recs;
227 | repeat
228 | if max < min then
229 | begin
230 | // not found! return 0 (the undef char)
231 | off := 0;
232 | break;
233 | end;
234 |
235 | rec := (max + min) >> 1;
236 | off := rec * 18;
237 | key := (table[off] << 8) or table[off + 1];
238 |
239 | if key = codepoint then
240 | // got a match. exit with off
241 | break;
242 |
243 | if key < codepoint then
244 | min := rec + 1
245 | else if key > codepoint then
246 | max := rec - 1;
247 |
248 | until key = codepoint;
249 | result := off + 2;
250 | end;
251 |
252 | // return new rendered glyph - does not render blink or double height
253 | procedure GetGlyphBmp(
254 | var bmp : TBGRABitmap;
255 | base : pbyte; // base address of glyph table
256 | off : integer; // offset into glyph table points to 8x16
257 | attr : Uint32; // standard cell attributes
258 | blink : boolean // if on, conceal text.
259 | );
260 | var
261 | x, y : Integer;
262 | b : Word;
263 | ptr : PBYTE;
264 | bptr : PBGRAPixel;
265 | sptr : PBGRAPixel;
266 | fg, bg, sc : TBGRAPixel;
267 | italics,
268 | bold,
269 | shadow,
270 | underline,
271 | strike,
272 | dstrike : Boolean;
273 | disp : Integer;
274 | adj : Integer;
275 | i, dl : Integer;
276 | s : PBGRAPixel;
277 | fi, bi : Integer;
278 | begin
279 | ptr := @base[off];
280 |
281 | italics := HasBits(attr, A_CELL_ITALICS);
282 | bold := HasBits(attr, A_CELL_BOLD);
283 | shadow := HasBits(attr, A_CELL_SHADOW);
284 | underline := HasBits(attr, A_CELL_UNDERLINE);
285 | strike := HasBits(attr, A_CELL_STRIKETHROUGH);
286 | dstrike := HasBits(attr, A_CELL_DOUBLESTRIKE);
287 | disp := GetBits(attr, A_CELL_DISPLAY_MASK);
288 |
289 | // dont' swap bold bit if BBS or CTerm and colors between 8-15
290 | fi := GetBits(attr, A_CELL_FG_MASK);
291 | bi := GetBits(attr, A_CELL_BG_MASK, 8);
292 | if HasBits(attr, A_CELL_REVERSE) then
293 | begin
294 | if ColorScheme = COLORSCHEME_BBS then
295 | begin
296 | i := fi and $08;
297 | fi := fi and $07;
298 | bi := bi or i;
299 | end;
300 | fg := ANSIColor[bi];
301 | bg := ANSIColor[fi];
302 | end
303 | else
304 | begin
305 | fg := ANSIColor[fi];
306 | bg := ANSIColor[bi];
307 | end;
308 |
309 | // get faint foreground color
310 | if HasBits(attr, A_CELL_FAINT) then
311 | fg := Brighten(fg, -0.33);
312 |
313 | // compute shadow color
314 | if shadow then
315 | sc := Brighten(bg, -0.33);
316 |
317 | // draw background.
318 | bmp.FillRect(0, 0, 8, 16, bg);
319 |
320 | // draw the cell
321 | if not blink and (disp <> A_CELL_DISPLAY_CONCEAL) then
322 | begin
323 |
324 | for y := 0 to 15 do
325 | begin
326 | bptr := bmp.ScanLine[y]; // get ptr into bmp
327 | if (y < 15) then
328 | begin
329 | sptr := bmp.ScanLine[y + 1]; // get ptr for shadow
330 | sptr += 1;
331 | end;
332 |
333 | b := ptr^; // get byte of character def
334 | inc(ptr);
335 |
336 | // alter for underline, strikethrough, and doublestrike
337 | if underline and (y = 15) then b := $ff;
338 | if strike and (y = 7) then b := $ff;
339 | if dstrike and ((y = 3) or (y = 11)) then b := $ff;
340 |
341 | // build bits
342 | for x := 0 to 7 do
343 | begin
344 | // if bit on at this x,y for this character
345 | if (b and $80) <> 0 then
346 | begin
347 | // shift top portion of bitmap 1 px right for italics
348 | adj := 0;
349 | if italics and (y < 8) then
350 | inc(adj);
351 |
352 | // draw if on the bitmap
353 | if x + adj < 8 then
354 | begin
355 | // draw shadow color bit first
356 | if shadow and (x + adj < 7) and (y < 15) then
357 | sptr[adj] := sc;
358 |
359 | // if shadow and (y > 0) and (x + adj < 7) then
360 | // bptr[adj - 7] := sc;
361 |
362 | // draw character bit
363 | bptr[adj] := fg;
364 |
365 | // repeat for bold
366 | if bold and (x + adj < 7) then
367 | bptr[adj + 1] := fg;
368 |
369 | end;
370 | end;
371 | bptr += 1;
372 | sptr += 1;
373 | b := b << 1;
374 | end;
375 | end;
376 |
377 | // adjust for double height
378 | if disp = A_CELL_DISPLAY_TOP then
379 | begin
380 | // stretch top half down over entire cell
381 | for i := 7 downto 0 do
382 | begin
383 | s := bmp.ScanLine[i];
384 | dl := i << 1;
385 | Move(s[0], bmp.ScanLine[dl ][0], 32);
386 | Move(s[0], bmp.ScanLine[dl + 1][0], 32);
387 | end;
388 | end
389 |
390 | else if disp = A_CELL_DISPLAY_BOTTOM then
391 | begin
392 | // stretch bottom half up over entire cell
393 | for i := 8 to 15 do
394 | begin
395 | s := bmp.ScanLine[i];
396 | dl := (i - 8) << 1;
397 | Move(s[0], bmp.ScanLine[dl ][0], 32);
398 | Move(s[0], bmp.ScanLine[dl + 1][0], 32);
399 | end;
400 | end;
401 |
402 | // bmp.InvalidateBitmap;
403 | end;
404 | end;
405 |
406 | // is val between lo and hi?
407 | function Between(val, lo, hi : integer) : boolean; inline;
408 | begin
409 | result := ((val >= lo) and (val <= hi));
410 | end;
411 |
412 | // is val between lo and hi?
413 | function Between(val, lo, hi : char) : boolean; inline;
414 | begin
415 | result := ((ord(val) >= ord(lo)) and (ord(val) <= ord(hi)));
416 | end;
417 |
418 | // any bits set?
419 | function HasBits(val, mask : UInt32) : boolean; inline;
420 | begin
421 | result := ((val and mask) <> 0);
422 | end;
423 |
424 | // return bits under bitmask
425 | function GetBits(val, mask : UInt32; shift : integer = 0) : UInt32; inline;
426 | begin
427 | result := ((val and mask) >> shift);
428 | end;
429 |
430 | // set bits for bitmask
431 | procedure SetBits(var val : UInt32; mask, bits : UInt32; shift : integer = 0); inline;
432 | begin
433 | val := ((val and not mask) or ((bits << shift) and mask));
434 | end;
435 |
436 | procedure SetBit(var val : byte; mask : byte; bit : boolean);
437 | var
438 | bitval : byte;
439 | begin
440 | bitval := mask;
441 | if not bit then
442 | bitval := 0;
443 | val := ((val and not mask) or bitval);
444 | end;
445 |
446 | procedure SetBit(var val : UInt32; mask : UInt32; bit : boolean);
447 | var
448 | bitval : UInt32;
449 | begin
450 | bitval := mask;
451 | if not bit then
452 | bitval := 0;
453 | val := ((val and not mask) or bitval);
454 | end;
455 |
456 | procedure SetBit(var val : longint; mask : longint; bit : boolean);
457 | var
458 | bitval : longint;
459 | begin
460 | bitval := mask;
461 | if not bit then
462 | bitval := 0;
463 | val := ((val and not mask) or bitval);
464 | end;
465 |
466 | procedure Swap(var val1, val2 : integer); inline;
467 | var
468 | tmp : integer;
469 | begin
470 | tmp := val1; val1 := val2; val2 := tmp;
471 | end;
472 |
473 | procedure Swap(var val1, val2 : UInt32); inline;
474 | var
475 | tmp : UInt32;
476 | begin
477 | tmp := val1; val1 := val2; val2 := tmp;
478 | end;
479 |
480 | // brighten / darken color
481 | function Brighten(color : TColor; factor: real): TColor;
482 |
483 | function Norm(val : byte) : double; inline;
484 | begin
485 | result := val / 255.0;
486 | end;
487 |
488 | function Unnorm(val : double) : byte; inline;
489 | begin
490 | result := round(val * 255.0);
491 | end;
492 |
493 | var
494 | r, g, b : double;
495 | begin
496 | r := Norm(Red(color));
497 | g := Norm(Green(color));
498 | b := Norm(Blue(color));
499 | if factor < 0 then
500 | begin
501 | factor := factor + 1.0;
502 | r := r * factor;
503 | g := g * factor;
504 | b := b * factor;
505 | end
506 | else
507 | begin
508 | r := (1.0 - r) * factor + r;
509 | g := (1.0 - g) * factor + g;
510 | b := (1.0 - b) * factor + b;
511 | end;
512 | result := VTXRGB(Unnorm(r), Unnorm(g), Unnorm(b));
513 | end;
514 |
515 | function RectWidth(r : TRect) : integer; inline;
516 | begin
517 | result := r.Right - r.Left;
518 | end;
519 |
520 | function RectHeight(r : TRect) : integer; inline;
521 | begin
522 | result := r.Bottom - r.Top;
523 | end;
524 |
525 | function DrawTextCentered(cnv : TCanvas; const r : TRect; s : unicodeString) : integer;
526 | var
527 | sz : TSize;
528 | begin
529 | sz := cnv.TextExtent(s);
530 | cnv.TextOut(r.Left + ((RectWidth(r) - sz.cx) >> 1), r.Top + ((RectHeight(r) - sz.cy) >> 1), s);
531 | end;
532 |
533 | function DrawTextRight(cnv : TCanvas; const r : TRect; s : unicodeString) : integer;
534 | var
535 | sz : TSize;
536 | rtop, rleft, rright, rwidth, rheight : integer;
537 | begin
538 | sz := cnv.TextExtent(s);
539 | rtop := r.top;
540 | rleft := r.left;
541 | rright := r.right;
542 | rwidth := RectWidth(r);
543 | rheight := RectHeight(r);
544 | if rheight < sz.cy then
545 | rheight := sz.cy;
546 | cnv.TextOut(rright - sz.cx, rtop + ((rheight - sz.cy) >> 1), s);
547 | end;
548 |
549 | procedure DrawRectangle(cnv: TCanvas; rect : TRect; clr : TColor);
550 | begin
551 | DrawRectangle(cnv, rect.Left, rect.Top, rect.Right - 1, rect.Bottom - 1, clr);
552 | end;
553 |
554 | procedure DrawRectangle(cnv: TCanvas; x1, y1, x2, y2 : integer; clr : TColor);
555 | begin
556 | cnv.Pen.Color := clr;
557 | cnv.Line(x2, y1, x1, y1);
558 | cnv.Line(x1, y1, x1, y2);
559 | cnv.Line(x1, y2, x2, y2);
560 | cnv.Line(x2, y2, x2, y1);
561 | end;
562 |
563 | // http://members.chello.at/~easyfilter/bresenham.html
564 |
565 | // encapsulated line plotting globals
566 | var
567 | LineData : record
568 | calcX0, calcY0,
569 | calcX1, calcY1 : longint;
570 | calcDX, calcDY,
571 | calcSX, calcSY : longint;
572 | calcErr : longint;
573 | end;
574 |
575 | // initialize line plotting calculator
576 | procedure LineCalcInit(x0, y0, x1, y1 : longint);
577 | begin
578 | LineData.calcX0 := x0;
579 | LineData.calcY0 := y0;
580 | LineData.calcX1 := x1;
581 | LineData.calcY1 := y1;
582 | with LineData do
583 | begin
584 | calcDX := abs(x1 - x0);
585 | calcDY := abs(y1 - y0);
586 | if x0 < x1 then
587 | calcSX := 1
588 | else
589 | calcSX := -1;
590 | if y0 < y1 then
591 | calcSY := 1
592 | else
593 | calcSY := -1;
594 | if calcDX > calcDY then
595 | calcErr := calcDX div 2
596 | else
597 | calcErr := (-calcDY) div 2;
598 | end;
599 | end;
600 |
601 | // get next point
602 | function LineCalcNext(var xo, yo : longint) : boolean;
603 | var
604 | e2 : longint;
605 | begin
606 | with LineData do
607 | begin
608 | result := ((calcX0 = calcX1) and (calcY0 = calcY1));
609 | if not result then
610 | begin
611 | e2 := calcErr;
612 | if e2 > -calcDX then
613 | begin
614 | calcErr -= calcDY;
615 | calcX0 += calcSX;
616 | end;
617 | if e2 < calcDY then
618 | begin
619 | calcErr += calcDX;
620 | calcY0 += calcSY;
621 | end;
622 | result := ((calcX0 = calcX1) and (calcY0 = calcY1));
623 | end;
624 | xo := calcX0;
625 | yo := calcY0;
626 | end;
627 | end;
628 |
629 | // encapsulated ellipse plotting globals
630 | var
631 | EllipseData : record
632 | State : integer;
633 | X, Y : longint;
634 | TwoASquare, TwoBSquare : longint;
635 | XChange, YChange : longint;
636 | EllipseError : longint;
637 | StoppingX, StoppingY : longint;
638 | XRadius, YRadius : longint;
639 | end;
640 |
641 | procedure EllipseCalcInit(xrad, yrad : longint);
642 | begin
643 | EllipseData.XRadius := xrad;
644 | EllipseData.YRadius := yrad;
645 | EllipseData.State := 0;
646 |
647 | end;
648 |
649 | function EllipseCalcNext(var xo, yo : longint) : boolean;
650 | begin
651 | result := false;
652 | with EllipseData do
653 | begin
654 | if (XRadius = 0) or (YRadius = 0) then
655 | begin
656 | xo := 0;
657 | yo := 0;
658 | result := true;
659 | exit;
660 | end;
661 | case State of
662 | 0, 1:
663 | begin
664 | if State = 0 then
665 | begin
666 | // init for first part of ellipse
667 | TwoASquare := 2 * XRadius * XRadius;
668 | TwoBSquare := 2 * YRadius * YRadius;
669 | X := XRadius;
670 | Y := 0;
671 | XChange := YRadius * YRadius * (1 - 2 * XRadius);
672 | YChange := XRadius * XRadius;
673 | EllipseError := 0;
674 | StoppingX := TwoBSquare * XRadius;
675 | StoppingY := 0;
676 | State := 1;
677 | end;
678 | if StoppingX >= StoppingY then
679 | begin
680 | // the results.
681 | xo := X;
682 | yo := Y;
683 | y += 1;
684 | inc(StoppingY, TwoASquare);
685 | inc(EllipseError, YChange);
686 | inc(YChange, TwoASquare);
687 | if ((2 * EllipseError + XChange) > 0) then
688 | begin
689 | x -= 1;
690 | dec(StoppingX, TwoBSquare);
691 | inc(EllipseError, XChange);
692 | inc(XChange, TwoBSquare)
693 | end;
694 | end
695 | else
696 | begin
697 | X := 0;
698 | Y := YRadius;
699 | XChange := YRadius * YRadius;
700 | YChange := XRadius * XRadius * (1 - 2 * YRadius);
701 | EllipseError := 0;
702 | StoppingX := 0;
703 | StoppingY := TwoASquare * YRadius;
704 | State := 2;
705 |
706 | if StoppingX <= StoppingY then
707 | begin
708 | // the results.
709 | xo := X;
710 | yo := Y;
711 | x += 1;;
712 | inc(StoppingX, TwoBSquare);
713 | inc(EllipseError, XChange);
714 | inc(XChange, TwoBSquare);
715 | if ((2 * EllipseError + YChange) > 0) then
716 | begin
717 | y -= 1;
718 | dec(StoppingY, TwoASquare);
719 | inc(EllipseError, YChange);
720 | inc(YChange, TwoASquare)
721 | end;
722 | end
723 | else
724 | begin
725 | // done
726 | xo := x;
727 | yo := y;
728 | result := true;
729 | end;
730 | end;
731 | end;
732 |
733 | 2:
734 | begin
735 | if StoppingX <= StoppingY then
736 | begin
737 | // the results.
738 | xo := X;
739 | yo := Y;
740 | x += 1;;
741 | inc(StoppingX, TwoBSquare);
742 | inc(EllipseError, XChange);
743 | inc(XChange, TwoBSquare);
744 | if ((2 * EllipseError + YChange) > 0) then
745 | begin
746 | y -= 1;
747 | dec(StoppingY, TwoASquare);
748 | inc(EllipseError, YChange);
749 | inc(YChange, TwoASquare)
750 | end;
751 | end
752 | else
753 | begin
754 | // done
755 | xo := x;
756 | yo := y;
757 | result := true;
758 | end;
759 | end;
760 |
761 | end;
762 | end;
763 | end;
764 |
765 | function QuadToStr(q : TQuad) : unicodestring;
766 | begin
767 | result := format('%d,%d %d,%d', [ q.v0, q.v1, q.v2, q.v3]);
768 | end;
769 |
770 | function isInteger(str : unicodestring) : boolean;
771 | var
772 | i : integer;
773 | begin
774 | for i := 1 to str.length do
775 | if not between(str[i], '0', '9') then
776 | exit(false);
777 | result := true;
778 | end;
779 |
780 | function StrToQuad(str : unicodestring) : TQuad;
781 | var
782 | l : integer;
783 | vals : TUnicodeStringArray;
784 | begin
785 | result.v0 := 64;
786 | result.v1 := 64;
787 | result.v2 := 64;
788 | result.v3 := 64;
789 | vals := str.Split([',',' ']);
790 | l := length(vals);
791 | if (l >= 1) and isInteger(vals[0]) then result.v0 := strtoint(vals[0]);
792 | if (l >= 2) and isInteger(vals[1]) then result.v1 := strtoint(vals[1]);
793 | if (l >= 3) and isInteger(vals[2]) then result.v2 := strtoint(vals[2]);
794 | if (l >= 4) and isInteger(vals[3]) then result.v3 := strtoint(vals[3]);
795 | setlength(vals,0);
796 | end;
797 |
798 | procedure SetFormQuad(f : TForm; q : TQuad);
799 | begin
800 | if q.v0 < 0 then q.v0 := 0;
801 | if q.v1 < 0 then q.v1 := 0;
802 | if q.v0 > Screen.Width then q.v0 := 0;
803 | if q.v1 > Screen.Height then q.v1 := 0;
804 |
805 | f.Left := q.v0;
806 | f.Top := q.v1;
807 | if q.v2 > 0 then
808 | begin
809 | f.Width := q.v2;
810 | f.Height := q.v3;
811 | end;
812 | end;
813 |
814 | function GetFormQuad(f : TForm) : TQuad;
815 | begin
816 | result.v0 := f.RestoredLeft;
817 | result.v1 := f.RestoredTop;
818 | result.v2 := f.RestoredWidth;
819 | result.v3 := f.RestoredHeight;
820 | end;
821 |
822 | function CharsToStr(src : array of char; len : integer) : unicodestring;
823 | var
824 | i : integer;
825 | begin
826 | result := '';
827 | len := length(src);
828 | for i := 0 to len - 1 do
829 | begin
830 | if src[i] = #0 then
831 | break;
832 | result += src[i];
833 | end;
834 | end;
835 |
836 | function CharsToStr(src : array of byte; len : integer) : unicodestring;
837 | var
838 | i : integer;
839 | begin
840 | result := '';
841 | len := length(src);
842 | for i := 0 to len - 1 do
843 | begin
844 | if src[i] = 0 then
845 | break;
846 | result += char(src[i]);
847 | end;
848 | end;
849 |
850 | procedure DrawDashLine(cnv : TCanvas; x1, y1, x2, y2 : integer; clr1, clr2 : TColor);
851 | begin
852 | cnv.Brush.Style := bsClear;
853 | cnv.Pen.Color := clr1;
854 | cnv.Pen.Style := psSolid;
855 | cnv.Line(x1, y1, x2, y2);
856 | cnv.Brush.Style := bsClear;
857 | cnv.Pen.Color := clr2;
858 | cnv.Pen.Style := psDot;
859 | cnv.Line(x1, y1, x2, y2);
860 | end;
861 |
862 | procedure DrawDashRect(cnv : TCanvas; rect : TRect; clr1, clr2 : TColor);
863 | begin
864 | cnv.Brush.Style := bsClear;
865 | cnv.Pen.Color := clr1;
866 | cnv.Pen.Style := psSolid;
867 | cnv.Rectangle(rect);
868 | cnv.Brush.Style := bsClear;
869 | cnv.Pen.Color := clr2;
870 | cnv.Pen.Style := psDot;
871 | cnv.Rectangle(rect);
872 | end;
873 |
874 | procedure DrawDashRect(cnv : TCanvas; x1, y1, x2, y2 : integer; clr1, clr2 : TColor);
875 | begin
876 | cnv.Brush.Style := bsClear;
877 | cnv.Pen.Color := clr1;
878 | cnv.Pen.Style := psSolid;
879 | cnv.Rectangle(x1, y1, x2, y2);
880 | cnv.Brush.Style := bsClear;
881 | cnv.Pen.Color := clr2;
882 | cnv.Pen.Style := psDot;
883 | cnv.Rectangle(x1, y1, x2, y2);
884 | end;
885 |
886 | procedure DrawStretchedBitmap(cnv : TCanvas; r : TRect; bmp : TBGRABitmap);
887 | var
888 | tmpbmp : TBGRABitmap;
889 | begin
890 | tmpbmp := bmp.Resample(r.Width, r.Height, rmSimpleStretch) as TBGRABitmap;
891 | tmpbmp.Draw(cnv, r.left, r.top);
892 | tmpbmp.free;
893 | end;
894 |
895 | procedure Draw3DRect(cnv : TCanvas; rect : TRect; sunk : boolean);
896 | begin
897 | Draw3DRect(cnv, rect.Left, rect.Top, rect.Right, rect.Bottom, sunk);
898 | end;
899 |
900 | procedure Draw3DRect(cnv : TCanvas; x1, y1, x2, y2 : integer; sunk : boolean);
901 | var
902 | c1, c2 : TBGRAPixel;
903 | bmp : TBGRABitmap;
904 | w, h : integer;
905 | begin
906 | w := x2 - x1;
907 | h := y2 - y1;
908 |
909 | bmp := TBGRABitmap.Create(w, h, BGRAPixelTransparent);
910 |
911 | if sunk then
912 | begin
913 | c1 := BGRA(0, 0, 0, 192);
914 | c2 := BGRA(255, 255, 255, 192);
915 | end
916 | else
917 | begin
918 | c1 := BGRA(255, 255, 255, 192);
919 | c2 := BGRA(0, 0, 0, 192);
920 | end;
921 |
922 | bmp.DrawLine(0, h - 2, 0, 0, c1, true, dmSet);
923 | bmp.DrawLine(0, 0, w - 2, 0, c1, true, dmSet);
924 | bmp.DrawLine(1, h - 1, w - 1, h - 1, c2, true, dmSet);
925 | bmp.DrawLine(w - 1, h - 1, w - 1, 1, c2, true, dmSet);
926 |
927 | cnv.Draw(x1, y1, bmp.Bitmap);
928 | bmp.Free;
929 | end;
930 |
931 | end.
932 |
933 |
--------------------------------------------------------------------------------
/work/MicroKnightPlus_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/MicroKnightPlus_v1.0.raw
--------------------------------------------------------------------------------
/work/MicroKnight_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/MicroKnight_v1.0.raw
--------------------------------------------------------------------------------
/work/P0T-NOoDLE_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/P0T-NOoDLE_v1.0.raw
--------------------------------------------------------------------------------
/work/TopazPlus_a1200_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/TopazPlus_a1200_v1.0.raw
--------------------------------------------------------------------------------
/work/TopazPlus_a500_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/TopazPlus_a500_v1.0.raw
--------------------------------------------------------------------------------
/work/Topaz_a1200_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/Topaz_a1200_v1.0.raw
--------------------------------------------------------------------------------
/work/Topaz_a500_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/Topaz_a500_v1.0.raw
--------------------------------------------------------------------------------
/work/c0.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c0.cur
--------------------------------------------------------------------------------
/work/c0.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c0.png
--------------------------------------------------------------------------------
/work/c1.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c1.cur
--------------------------------------------------------------------------------
/work/c1.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c1.png
--------------------------------------------------------------------------------
/work/c2.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c2.cur
--------------------------------------------------------------------------------
/work/c2.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c2.png
--------------------------------------------------------------------------------
/work/c3.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c3.cur
--------------------------------------------------------------------------------
/work/c3.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c3.png
--------------------------------------------------------------------------------
/work/c4.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c4.cur
--------------------------------------------------------------------------------
/work/c4.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c4.png
--------------------------------------------------------------------------------
/work/c5.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c5.cur
--------------------------------------------------------------------------------
/work/c5.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c5.png
--------------------------------------------------------------------------------
/work/c6.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c6.cur
--------------------------------------------------------------------------------
/work/c6.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c6.png
--------------------------------------------------------------------------------
/work/c7.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c7.cur
--------------------------------------------------------------------------------
/work/c7.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c7.png
--------------------------------------------------------------------------------
/work/c8.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c8.cur
--------------------------------------------------------------------------------
/work/c8.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c8.png
--------------------------------------------------------------------------------
/work/c9.cur:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c9.cur
--------------------------------------------------------------------------------
/work/c9.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/c9.png
--------------------------------------------------------------------------------
/work/cursors.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/cursors.png
--------------------------------------------------------------------------------
/work/grayicons.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/grayicons.png
--------------------------------------------------------------------------------
/work/icons.cdr:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/icons.cdr
--------------------------------------------------------------------------------
/work/icons.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/icons.png
--------------------------------------------------------------------------------
/work/mO'sOul_v1.0.raw:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/codewar65/VTXEdit/ddd31be618071df1ec668d99b1812a79179846b3/work/mO'sOul_v1.0.raw
--------------------------------------------------------------------------------