├── CHMer.dpr
├── CHMer.dproj
├── CHMer.res
├── HTMLTools.pas
├── HyperParse.pas
├── LICENSE
├── SystemUtils.pas
├── latin1.pas
├── readme.txt
├── screenshot.png
├── source
├── chm.ico
├── chm_150.png
├── chm_32.ico
└── chm_44.png
├── uAddNewEmpty.dfm
├── uAddNewEmpty.pas
├── uAddProperty.dfm
├── uAddProperty.pas
├── uEditFont.dfm
├── uEditFont.pas
├── uEditValue.dfm
├── uEditValue.pas
├── uHelpProject.pas
├── uMain.dfm
├── uMain.pas
├── uSelectImage.dfm
├── uSelectImage.pas
├── uSettings.dfm
└── uSettings.pas
/CHMer.dpr:
--------------------------------------------------------------------------------
1 | program CHMer;
2 |
3 | uses
4 | Forms,
5 | uMain in 'uMain.pas' {frmMain},
6 | uHelpProject in 'uHelpProject.pas',
7 | uSelectImage in 'uSelectImage.pas' {frmSelectImage},
8 | uAddProperty in 'uAddProperty.pas' {frmAddProperty},
9 | uSettings in 'uSettings.pas' {frmSettings},
10 | uEditValue in 'uEditValue.pas' {frmEditValue},
11 | uEditFont in 'uEditFont.pas' {frmEditFont},
12 | uAddNewEmpty in 'uAddNewEmpty.pas' {frmAddNewEmpty};
13 |
14 | {$R *.res}
15 |
16 | begin
17 | Application.Initialize;
18 | Application.MainFormOnTaskbar := True;
19 | Application.CreateForm(TfrmMain, frmMain);
20 | Application.Run;
21 | end.
22 |
--------------------------------------------------------------------------------
/CHMer.dproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {F849BF51-C28E-4647-8099-AF611DD925AE}
4 | CHMer.dpr
5 | True
6 | Release
7 | 3
8 | Application
9 | VCL
10 | 18.8
11 | Win64
12 |
13 |
14 | true
15 |
16 |
17 | true
18 | Base
19 | true
20 |
21 |
22 | true
23 | Base
24 | true
25 |
26 |
27 | true
28 | Base
29 | true
30 |
31 |
32 | true
33 | Cfg_1
34 | true
35 | true
36 |
37 |
38 | true
39 | Cfg_1
40 | true
41 | true
42 |
43 |
44 | true
45 | Base
46 | true
47 |
48 |
49 | true
50 | Cfg_2
51 | true
52 | true
53 |
54 |
55 | true
56 | Cfg_2
57 | true
58 | true
59 |
60 |
61 | false
62 | false
63 | false
64 | false
65 | false
66 | 00400000
67 | CHMer
68 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
69 | 1049
70 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
71 | bin
72 | dcu
73 | dcu
74 | dcu
75 |
76 |
77 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
78 | Debug
79 | true
80 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=
81 | 1033
82 | $(BDS)\bin\default_app.manifest
83 | CHMer_Icon2.ico
84 | true
85 | chm_44.png
86 | chm_150.png
87 |
88 |
89 | bin64
90 | 1033
91 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
92 | true
93 | Debug
94 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
95 | $(BDS)\bin\default_app.manifest
96 | CHMer_Icon2.ico
97 | true
98 | chm_44.png
99 | chm_150.png
100 |
101 |
102 | RELEASE;$(DCC_Define)
103 | 0
104 | false
105 | 0
106 |
107 |
108 | true
109 | true
110 | 1033
111 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.15.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=
112 | source\chm.ico
113 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
114 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
115 | 15
116 |
117 |
118 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
119 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
120 | source\chm.ico
121 | 15
122 | true
123 | 1033
124 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.15.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
125 | true
126 |
127 |
128 | DEBUG;$(DCC_Define)
129 | false
130 | true
131 |
132 |
133 | true
134 | 3
135 | true
136 | 1033
137 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.11.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
138 | source\chm.ico
139 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
140 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
141 | 11
142 |
143 |
144 | 11
145 | true
146 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
147 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
148 | 1033
149 | source\chm.ico
150 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.11.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
151 | true
152 | 3
153 |
154 |
155 |
156 | MainSource
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 | dfm
165 |
166 |
167 |
168 | dfm
169 |
170 |
171 |
172 | dfm
173 |
174 |
175 |
176 | dfm
177 |
178 |
179 |
180 | dfm
181 |
182 |
183 |
184 | dfm
185 |
186 |
187 | Cfg_2
188 | Base
189 |
190 |
191 | Base
192 |
193 |
194 | Cfg_1
195 | Base
196 |
197 |
198 |
199 | Delphi.Personality.12
200 |
201 |
202 |
203 |
204 | CHMer.dpr
205 |
206 |
207 | Microsoft Office 2000 Sample Automation Server Wrapper Components
208 | Microsoft Office XP Sample Automation Server Wrapper Components
209 |
210 |
211 |
212 | True
213 | True
214 |
215 |
216 |
217 |
218 | Assets\
219 | Logo44x44.png
220 | true
221 |
222 |
223 |
224 |
225 | Assets\
226 | Logo150x150.png
227 | true
228 |
229 |
230 |
231 |
232 | Assets\
233 | Logo150x150.png
234 | true
235 |
236 |
237 |
238 |
239 | Assets\
240 | Logo150x150.png
241 | true
242 |
243 |
244 |
245 |
246 | Assets\
247 | Logo44x44.png
248 | true
249 |
250 |
251 |
252 |
253 | Assets\
254 | Logo150x150.png
255 | true
256 |
257 |
258 |
259 |
260 | Assets\
261 | Logo150x150.png
262 | true
263 |
264 |
265 |
266 |
267 | Assets\
268 | Logo44x44.png
269 | true
270 |
271 |
272 |
273 |
274 | Assets\
275 | Logo44x44.png
276 | true
277 |
278 |
279 |
280 |
281 | Assets\
282 | Logo150x150.png
283 | true
284 |
285 |
286 |
287 |
288 | Assets\
289 | Logo44x44.png
290 | true
291 |
292 |
293 |
294 |
295 | CHMer.exe
296 | true
297 |
298 |
299 |
300 |
301 | Assets\
302 | Logo44x44.png
303 | true
304 |
305 |
306 |
307 |
308 | CHMer.exe
309 | true
310 |
311 |
312 |
313 |
314 | CHMer.exe
315 | true
316 |
317 |
318 |
319 |
320 | 1
321 |
322 |
323 | Contents\MacOS
324 | 1
325 |
326 |
327 | 0
328 |
329 |
330 |
331 |
332 | classes
333 | 1
334 |
335 |
336 | classes
337 | 1
338 |
339 |
340 |
341 |
342 | res\xml
343 | 1
344 |
345 |
346 | res\xml
347 | 1
348 |
349 |
350 |
351 |
352 | library\lib\armeabi-v7a
353 | 1
354 |
355 |
356 |
357 |
358 | library\lib\armeabi
359 | 1
360 |
361 |
362 | library\lib\armeabi
363 | 1
364 |
365 |
366 |
367 |
368 | library\lib\armeabi-v7a
369 | 1
370 |
371 |
372 |
373 |
374 | library\lib\mips
375 | 1
376 |
377 |
378 | library\lib\mips
379 | 1
380 |
381 |
382 |
383 |
384 | library\lib\armeabi-v7a
385 | 1
386 |
387 |
388 | library\lib\arm64-v8a
389 | 1
390 |
391 |
392 |
393 |
394 | library\lib\armeabi-v7a
395 | 1
396 |
397 |
398 |
399 |
400 | res\drawable
401 | 1
402 |
403 |
404 | res\drawable
405 | 1
406 |
407 |
408 |
409 |
410 | res\values
411 | 1
412 |
413 |
414 | res\values
415 | 1
416 |
417 |
418 |
419 |
420 | res\values-v21
421 | 1
422 |
423 |
424 | res\values-v21
425 | 1
426 |
427 |
428 |
429 |
430 | res\values
431 | 1
432 |
433 |
434 | res\values
435 | 1
436 |
437 |
438 |
439 |
440 | res\drawable
441 | 1
442 |
443 |
444 | res\drawable
445 | 1
446 |
447 |
448 |
449 |
450 | res\drawable-xxhdpi
451 | 1
452 |
453 |
454 | res\drawable-xxhdpi
455 | 1
456 |
457 |
458 |
459 |
460 | res\drawable-ldpi
461 | 1
462 |
463 |
464 | res\drawable-ldpi
465 | 1
466 |
467 |
468 |
469 |
470 | res\drawable-mdpi
471 | 1
472 |
473 |
474 | res\drawable-mdpi
475 | 1
476 |
477 |
478 |
479 |
480 | res\drawable-hdpi
481 | 1
482 |
483 |
484 | res\drawable-hdpi
485 | 1
486 |
487 |
488 |
489 |
490 | res\drawable-xhdpi
491 | 1
492 |
493 |
494 | res\drawable-xhdpi
495 | 1
496 |
497 |
498 |
499 |
500 | res\drawable-mdpi
501 | 1
502 |
503 |
504 | res\drawable-mdpi
505 | 1
506 |
507 |
508 |
509 |
510 | res\drawable-hdpi
511 | 1
512 |
513 |
514 | res\drawable-hdpi
515 | 1
516 |
517 |
518 |
519 |
520 | res\drawable-xhdpi
521 | 1
522 |
523 |
524 | res\drawable-xhdpi
525 | 1
526 |
527 |
528 |
529 |
530 | res\drawable-xxhdpi
531 | 1
532 |
533 |
534 | res\drawable-xxhdpi
535 | 1
536 |
537 |
538 |
539 |
540 | res\drawable-xxxhdpi
541 | 1
542 |
543 |
544 | res\drawable-xxxhdpi
545 | 1
546 |
547 |
548 |
549 |
550 | res\drawable-small
551 | 1
552 |
553 |
554 | res\drawable-small
555 | 1
556 |
557 |
558 |
559 |
560 | res\drawable-normal
561 | 1
562 |
563 |
564 | res\drawable-normal
565 | 1
566 |
567 |
568 |
569 |
570 | res\drawable-large
571 | 1
572 |
573 |
574 | res\drawable-large
575 | 1
576 |
577 |
578 |
579 |
580 | res\drawable-xlarge
581 | 1
582 |
583 |
584 | res\drawable-xlarge
585 | 1
586 |
587 |
588 |
589 |
590 | res\values
591 | 1
592 |
593 |
594 | res\values
595 | 1
596 |
597 |
598 |
599 |
600 | 1
601 |
602 |
603 | Contents\MacOS
604 | 1
605 |
606 |
607 | 0
608 |
609 |
610 |
611 |
612 | Contents\MacOS
613 | 1
614 | .framework
615 |
616 |
617 | Contents\MacOS
618 | 1
619 | .framework
620 |
621 |
622 | 0
623 |
624 |
625 |
626 |
627 | 1
628 | .dylib
629 |
630 |
631 | 1
632 | .dylib
633 |
634 |
635 | 1
636 | .dylib
637 |
638 |
639 | Contents\MacOS
640 | 1
641 | .dylib
642 |
643 |
644 | Contents\MacOS
645 | 1
646 | .dylib
647 |
648 |
649 | 0
650 | .dll;.bpl
651 |
652 |
653 |
654 |
655 | 1
656 | .dylib
657 |
658 |
659 | 1
660 | .dylib
661 |
662 |
663 | 1
664 | .dylib
665 |
666 |
667 | Contents\MacOS
668 | 1
669 | .dylib
670 |
671 |
672 | Contents\MacOS
673 | 1
674 | .dylib
675 |
676 |
677 | 0
678 | .bpl
679 |
680 |
681 |
682 |
683 | 0
684 |
685 |
686 | 0
687 |
688 |
689 | 0
690 |
691 |
692 | 0
693 |
694 |
695 | 0
696 |
697 |
698 | Contents\Resources\StartUp\
699 | 0
700 |
701 |
702 | Contents\Resources\StartUp\
703 | 0
704 |
705 |
706 | 0
707 |
708 |
709 |
710 |
711 | 1
712 |
713 |
714 | 1
715 |
716 |
717 | 1
718 |
719 |
720 |
721 |
722 | 1
723 |
724 |
725 | 1
726 |
727 |
728 | 1
729 |
730 |
731 |
732 |
733 | 1
734 |
735 |
736 | 1
737 |
738 |
739 | 1
740 |
741 |
742 |
743 |
744 | 1
745 |
746 |
747 | 1
748 |
749 |
750 | 1
751 |
752 |
753 |
754 |
755 | 1
756 |
757 |
758 | 1
759 |
760 |
761 | 1
762 |
763 |
764 |
765 |
766 | 1
767 |
768 |
769 | 1
770 |
771 |
772 | 1
773 |
774 |
775 |
776 |
777 | 1
778 |
779 |
780 | 1
781 |
782 |
783 | 1
784 |
785 |
786 |
787 |
788 | 1
789 |
790 |
791 | 1
792 |
793 |
794 | 1
795 |
796 |
797 |
798 |
799 | 1
800 |
801 |
802 | 1
803 |
804 |
805 | 1
806 |
807 |
808 |
809 |
810 | 1
811 |
812 |
813 | 1
814 |
815 |
816 | 1
817 |
818 |
819 |
820 |
821 | 1
822 |
823 |
824 | 1
825 |
826 |
827 | 1
828 |
829 |
830 |
831 |
832 | 1
833 |
834 |
835 | 1
836 |
837 |
838 | 1
839 |
840 |
841 |
842 |
843 | 1
844 |
845 |
846 | 1
847 |
848 |
849 | 1
850 |
851 |
852 |
853 |
854 | 1
855 |
856 |
857 | 1
858 |
859 |
860 | 1
861 |
862 |
863 |
864 |
865 | 1
866 |
867 |
868 | 1
869 |
870 |
871 | 1
872 |
873 |
874 |
875 |
876 | 1
877 |
878 |
879 | 1
880 |
881 |
882 | 1
883 |
884 |
885 |
886 |
887 | 1
888 |
889 |
890 | 1
891 |
892 |
893 | 1
894 |
895 |
896 |
897 |
898 | 1
899 |
900 |
901 | 1
902 |
903 |
904 | 1
905 |
906 |
907 |
908 |
909 | 1
910 |
911 |
912 | 1
913 |
914 |
915 | 1
916 |
917 |
918 |
919 |
920 | 1
921 |
922 |
923 | 1
924 |
925 |
926 | 1
927 |
928 |
929 |
930 |
931 | 1
932 |
933 |
934 | 1
935 |
936 |
937 | 1
938 |
939 |
940 |
941 |
942 | 1
943 |
944 |
945 | 1
946 |
947 |
948 | 1
949 |
950 |
951 |
952 |
953 | 1
954 |
955 |
956 | 1
957 |
958 |
959 | 1
960 |
961 |
962 |
963 |
964 | 1
965 |
966 |
967 | 1
968 |
969 |
970 | 1
971 |
972 |
973 |
974 |
975 | 1
976 |
977 |
978 | 1
979 |
980 |
981 | 1
982 |
983 |
984 |
985 |
986 | 1
987 |
988 |
989 | 1
990 |
991 |
992 | 1
993 |
994 |
995 |
996 |
997 | 1
998 |
999 |
1000 | 1
1001 |
1002 |
1003 | 1
1004 |
1005 |
1006 |
1007 |
1008 | 1
1009 |
1010 |
1011 | 1
1012 |
1013 |
1014 | 1
1015 |
1016 |
1017 |
1018 |
1019 | 1
1020 |
1021 |
1022 | 1
1023 |
1024 |
1025 |
1026 |
1027 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
1028 | 1
1029 |
1030 |
1031 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
1032 | 1
1033 |
1034 |
1035 |
1036 |
1037 | 1
1038 |
1039 |
1040 | 1
1041 |
1042 |
1043 |
1044 |
1045 | ..\
1046 | 1
1047 |
1048 |
1049 | ..\
1050 | 1
1051 |
1052 |
1053 |
1054 |
1055 | 1
1056 |
1057 |
1058 | 1
1059 |
1060 |
1061 | 1
1062 |
1063 |
1064 |
1065 |
1066 | 1
1067 |
1068 |
1069 | 1
1070 |
1071 |
1072 | 1
1073 |
1074 |
1075 |
1076 |
1077 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
1078 | 1
1079 |
1080 |
1081 |
1082 |
1083 | ..\
1084 | 1
1085 |
1086 |
1087 | ..\
1088 | 1
1089 |
1090 |
1091 |
1092 |
1093 | Contents
1094 | 1
1095 |
1096 |
1097 | Contents
1098 | 1
1099 |
1100 |
1101 |
1102 |
1103 | Contents\Resources
1104 | 1
1105 |
1106 |
1107 | Contents\Resources
1108 | 1
1109 |
1110 |
1111 |
1112 |
1113 | library\lib\armeabi-v7a
1114 | 1
1115 |
1116 |
1117 | library\lib\arm64-v8a
1118 | 1
1119 |
1120 |
1121 | 1
1122 |
1123 |
1124 | 1
1125 |
1126 |
1127 | 1
1128 |
1129 |
1130 | 1
1131 |
1132 |
1133 | Contents\MacOS
1134 | 1
1135 |
1136 |
1137 | Contents\MacOS
1138 | 1
1139 |
1140 |
1141 | 0
1142 |
1143 |
1144 |
1145 |
1146 | library\lib\armeabi-v7a
1147 | 1
1148 |
1149 |
1150 |
1151 |
1152 | 1
1153 |
1154 |
1155 | 1
1156 |
1157 |
1158 |
1159 |
1160 | Assets
1161 | 1
1162 |
1163 |
1164 | Assets
1165 | 1
1166 |
1167 |
1168 |
1169 |
1170 | Assets
1171 | 1
1172 |
1173 |
1174 | Assets
1175 | 1
1176 |
1177 |
1178 |
1179 |
1180 |
1181 |
1182 |
1183 |
1184 |
1185 |
1186 |
1187 |
1188 |
1189 |
1190 | 12
1191 |
1192 |
1193 |
1194 |
1195 |
1196 |
--------------------------------------------------------------------------------
/CHMer.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/CHMer.res
--------------------------------------------------------------------------------
/HTMLTools.pas:
--------------------------------------------------------------------------------
1 | unit HTMLTools;
2 |
3 | interface
4 |
5 | function GetTagText(html, tag: String; Convert: Boolean = True): String;
6 | function FromHTML(html: String): String;
7 | function ToHTML(S: String; WithoutFrasl: Boolean = False): String;
8 |
9 | implementation
10 |
11 | uses
12 | System.SysUtils;
13 |
14 | const
15 | codes = 234;
16 |
17 | HTML_codes: array [1..codes] of Integer = (
18 | 34, 47, 60, 62, 130, 132, 134, 135, 137, 139, 145, 146, 147, 148, 153, 155, 160, 161, 162, 163, 164, 165, 166,
19 | 167, 168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189,
20 | 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212,
21 | 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235,
22 | 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255, 402, 913, 914,
23 | 915, 916, 917, 918, 919, 920, 921, 922, 923, 924, 925, 926, 927, 928, 929, 931, 932, 933, 934, 935, 936, 937, 945,
24 | 946, 947, 948, 949, 950, 951, 952, 953, 954, 955, 956, 957, 958, 959, 960, 961, 962, 963, 964, 965, 966, 967, 968,
25 | 969, 977, 978, 982, 8226, 8230, 8242, 8243, 8254, 8465, 8472, 8476, 8501, 8592, 8593, 8594, 8595, 8596, 8629, 8656,
26 | 8657, 8658, 8659, 8660, 8704, 8706, 8707, 8709, 8711, 8712, 8713, 8715, 8719, 8721, 8722, 8727, 8730, 8733, 8734,
27 | 8736, 8743, 8744, 8745, 8746, 8747, 8756, 8764, 8773, 8776, 8800, 8801, 8804, 8805, 8834, 8835, 8836, 8838, 8839,
28 | 8853, 8855, 8869, 8901, 8968, 8969, 8970, 8971, 9001, 9002, 9674, 9824, 9827, 9829, 9830
29 | );
30 |
31 | HTML_signs: array [1..codes] of String = (
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 | function GetTagText(html, tag: String; Convert: Boolean = True): String;
57 | var
58 | i: Integer;
59 | LowerHTML: String;
60 | begin
61 | Result := '';
62 |
63 | tag := AnsiLowerCase(tag);
64 | LowerHTML := AnsiLowerCase(html);
65 |
66 | i := Pos('', LowerHTML);
67 | if i < 1 then
68 | Exit;
69 |
70 | SetLength(html, i - 1);
71 | SetLength(LowerHTML, i - 1);
72 |
73 | i := Pos('<' + tag + '>', LowerHTML);
74 | if i < 1 then
75 | Exit;
76 |
77 | Delete(html, 1, i + Length(tag) + 1);
78 |
79 | if Convert then
80 | html := FromHTML(html);
81 |
82 | Result := html;
83 | end;
84 |
85 | function FromHTML(html: String): String;
86 | var
87 | i: Integer;
88 | begin
89 | Result := html;
90 |
91 | if Pos('&', Result) > 0 then
92 | begin
93 | for i := 1 to codes do
94 | Result := StringReplace(Result, HTML_signs[i], Char(HTML_codes[i]), [rfReplaceAll]);
95 | Result := StringReplace(Result, '&', Char(38), [rfReplaceAll]);
96 | end;
97 | end;
98 |
99 | function ToHTML(S: String; WithoutFrasl: Boolean = False): String;
100 | var
101 | i: Integer;
102 | begin
103 | Result := S;
104 |
105 | Result := StringReplace(Result, Char(38), '&', [rfReplaceAll]);
106 | for i := 1 to codes do
107 | Result := StringReplace(Result, Char(HTML_codes[i]), HTML_signs[i], [rfReplaceAll]);
108 |
109 | if WithoutFrasl then
110 | Result := StringReplace(Result, '⁄', '/', [rfReplaceAll]);
111 | end;
112 |
113 | end.
114 |
115 |
--------------------------------------------------------------------------------
/HyperParse.pas:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/HyperParse.pas
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Mozilla Public License Version 2.0
2 | ==================================
3 |
4 | 1. Definitions
5 | --------------
6 |
7 | 1.1. "Contributor"
8 | means each individual or legal entity that creates, contributes to
9 | the creation of, or owns Covered Software.
10 |
11 | 1.2. "Contributor Version"
12 | means the combination of the Contributions of others (if any) used
13 | by a Contributor and that particular Contributor's Contribution.
14 |
15 | 1.3. "Contribution"
16 | means Covered Software of a particular Contributor.
17 |
18 | 1.4. "Covered Software"
19 | means Source Code Form to which the initial Contributor has attached
20 | the notice in Exhibit A, the Executable Form of such Source Code
21 | Form, and Modifications of such Source Code Form, in each case
22 | including portions thereof.
23 |
24 | 1.5. "Incompatible With Secondary Licenses"
25 | means
26 |
27 | (a) that the initial Contributor has attached the notice described
28 | in Exhibit B to the Covered Software; or
29 |
30 | (b) that the Covered Software was made available under the terms of
31 | version 1.1 or earlier of the License, but not also under the
32 | terms of a Secondary License.
33 |
34 | 1.6. "Executable Form"
35 | means any form of the work other than Source Code Form.
36 |
37 | 1.7. "Larger Work"
38 | means a work that combines Covered Software with other material, in
39 | a separate file or files, that is not Covered Software.
40 |
41 | 1.8. "License"
42 | means this document.
43 |
44 | 1.9. "Licensable"
45 | means having the right to grant, to the maximum extent possible,
46 | whether at the time of the initial grant or subsequently, any and
47 | all of the rights conveyed by this License.
48 |
49 | 1.10. "Modifications"
50 | means any of the following:
51 |
52 | (a) any file in Source Code Form that results from an addition to,
53 | deletion from, or modification of the contents of Covered
54 | Software; or
55 |
56 | (b) any new file in Source Code Form that contains any Covered
57 | Software.
58 |
59 | 1.11. "Patent Claims" of a Contributor
60 | means any patent claim(s), including without limitation, method,
61 | process, and apparatus claims, in any patent Licensable by such
62 | Contributor that would be infringed, but for the grant of the
63 | License, by the making, using, selling, offering for sale, having
64 | made, import, or transfer of either its Contributions or its
65 | Contributor Version.
66 |
67 | 1.12. "Secondary License"
68 | means either the GNU General Public License, Version 2.0, the GNU
69 | Lesser General Public License, Version 2.1, the GNU Affero General
70 | Public License, Version 3.0, or any later versions of those
71 | licenses.
72 |
73 | 1.13. "Source Code Form"
74 | means the form of the work preferred for making modifications.
75 |
76 | 1.14. "You" (or "Your")
77 | means an individual or a legal entity exercising rights under this
78 | License. For legal entities, "You" includes any entity that
79 | controls, is controlled by, or is under common control with You. For
80 | purposes of this definition, "control" means (a) the power, direct
81 | or indirect, to cause the direction or management of such entity,
82 | whether by contract or otherwise, or (b) ownership of more than
83 | fifty percent (50%) of the outstanding shares or beneficial
84 | ownership of such entity.
85 |
86 | 2. License Grants and Conditions
87 | --------------------------------
88 |
89 | 2.1. Grants
90 |
91 | Each Contributor hereby grants You a world-wide, royalty-free,
92 | non-exclusive license:
93 |
94 | (a) under intellectual property rights (other than patent or trademark)
95 | Licensable by such Contributor to use, reproduce, make available,
96 | modify, display, perform, distribute, and otherwise exploit its
97 | Contributions, either on an unmodified basis, with Modifications, or
98 | as part of a Larger Work; and
99 |
100 | (b) under Patent Claims of such Contributor to make, use, sell, offer
101 | for sale, have made, import, and otherwise transfer either its
102 | Contributions or its Contributor Version.
103 |
104 | 2.2. Effective Date
105 |
106 | The licenses granted in Section 2.1 with respect to any Contribution
107 | become effective for each Contribution on the date the Contributor first
108 | distributes such Contribution.
109 |
110 | 2.3. Limitations on Grant Scope
111 |
112 | The licenses granted in this Section 2 are the only rights granted under
113 | this License. No additional rights or licenses will be implied from the
114 | distribution or licensing of Covered Software under this License.
115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a
116 | Contributor:
117 |
118 | (a) for any code that a Contributor has removed from Covered Software;
119 | or
120 |
121 | (b) for infringements caused by: (i) Your and any other third party's
122 | modifications of Covered Software, or (ii) the combination of its
123 | Contributions with other software (except as part of its Contributor
124 | Version); or
125 |
126 | (c) under Patent Claims infringed by Covered Software in the absence of
127 | its Contributions.
128 |
129 | This License does not grant any rights in the trademarks, service marks,
130 | or logos of any Contributor (except as may be necessary to comply with
131 | the notice requirements in Section 3.4).
132 |
133 | 2.4. Subsequent Licenses
134 |
135 | No Contributor makes additional grants as a result of Your choice to
136 | distribute the Covered Software under a subsequent version of this
137 | License (see Section 10.2) or under the terms of a Secondary License (if
138 | permitted under the terms of Section 3.3).
139 |
140 | 2.5. Representation
141 |
142 | Each Contributor represents that the Contributor believes its
143 | Contributions are its original creation(s) or it has sufficient rights
144 | to grant the rights to its Contributions conveyed by this License.
145 |
146 | 2.6. Fair Use
147 |
148 | This License is not intended to limit any rights You have under
149 | applicable copyright doctrines of fair use, fair dealing, or other
150 | equivalents.
151 |
152 | 2.7. Conditions
153 |
154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
155 | in Section 2.1.
156 |
157 | 3. Responsibilities
158 | -------------------
159 |
160 | 3.1. Distribution of Source Form
161 |
162 | All distribution of Covered Software in Source Code Form, including any
163 | Modifications that You create or to which You contribute, must be under
164 | the terms of this License. You must inform recipients that the Source
165 | Code Form of the Covered Software is governed by the terms of this
166 | License, and how they can obtain a copy of this License. You may not
167 | attempt to alter or restrict the recipients' rights in the Source Code
168 | Form.
169 |
170 | 3.2. Distribution of Executable Form
171 |
172 | If You distribute Covered Software in Executable Form then:
173 |
174 | (a) such Covered Software must also be made available in Source Code
175 | Form, as described in Section 3.1, and You must inform recipients of
176 | the Executable Form how they can obtain a copy of such Source Code
177 | Form by reasonable means in a timely manner, at a charge no more
178 | than the cost of distribution to the recipient; and
179 |
180 | (b) You may distribute such Executable Form under the terms of this
181 | License, or sublicense it under different terms, provided that the
182 | license for the Executable Form does not attempt to limit or alter
183 | the recipients' rights in the Source Code Form under this License.
184 |
185 | 3.3. Distribution of a Larger Work
186 |
187 | You may create and distribute a Larger Work under terms of Your choice,
188 | provided that You also comply with the requirements of this License for
189 | the Covered Software. If the Larger Work is a combination of Covered
190 | Software with a work governed by one or more Secondary Licenses, and the
191 | Covered Software is not Incompatible With Secondary Licenses, this
192 | License permits You to additionally distribute such Covered Software
193 | under the terms of such Secondary License(s), so that the recipient of
194 | the Larger Work may, at their option, further distribute the Covered
195 | Software under the terms of either this License or such Secondary
196 | License(s).
197 |
198 | 3.4. Notices
199 |
200 | You may not remove or alter the substance of any license notices
201 | (including copyright notices, patent notices, disclaimers of warranty,
202 | or limitations of liability) contained within the Source Code Form of
203 | the Covered Software, except that You may alter any license notices to
204 | the extent required to remedy known factual inaccuracies.
205 |
206 | 3.5. Application of Additional Terms
207 |
208 | You may choose to offer, and to charge a fee for, warranty, support,
209 | indemnity or liability obligations to one or more recipients of Covered
210 | Software. However, You may do so only on Your own behalf, and not on
211 | behalf of any Contributor. You must make it absolutely clear that any
212 | such warranty, support, indemnity, or liability obligation is offered by
213 | You alone, and You hereby agree to indemnify every Contributor for any
214 | liability incurred by such Contributor as a result of warranty, support,
215 | indemnity or liability terms You offer. You may include additional
216 | disclaimers of warranty and limitations of liability specific to any
217 | jurisdiction.
218 |
219 | 4. Inability to Comply Due to Statute or Regulation
220 | ---------------------------------------------------
221 |
222 | If it is impossible for You to comply with any of the terms of this
223 | License with respect to some or all of the Covered Software due to
224 | statute, judicial order, or regulation then You must: (a) comply with
225 | the terms of this License to the maximum extent possible; and (b)
226 | describe the limitations and the code they affect. Such description must
227 | be placed in a text file included with all distributions of the Covered
228 | Software under this License. Except to the extent prohibited by statute
229 | or regulation, such description must be sufficiently detailed for a
230 | recipient of ordinary skill to be able to understand it.
231 |
232 | 5. Termination
233 | --------------
234 |
235 | 5.1. The rights granted under this License will terminate automatically
236 | if You fail to comply with any of its terms. However, if You become
237 | compliant, then the rights granted under this License from a particular
238 | Contributor are reinstated (a) provisionally, unless and until such
239 | Contributor explicitly and finally terminates Your grants, and (b) on an
240 | ongoing basis, if such Contributor fails to notify You of the
241 | non-compliance by some reasonable means prior to 60 days after You have
242 | come back into compliance. Moreover, Your grants from a particular
243 | Contributor are reinstated on an ongoing basis if such Contributor
244 | notifies You of the non-compliance by some reasonable means, this is the
245 | first time You have received notice of non-compliance with this License
246 | from such Contributor, and You become compliant prior to 30 days after
247 | Your receipt of the notice.
248 |
249 | 5.2. If You initiate litigation against any entity by asserting a patent
250 | infringement claim (excluding declaratory judgment actions,
251 | counter-claims, and cross-claims) alleging that a Contributor Version
252 | directly or indirectly infringes any patent, then the rights granted to
253 | You by any and all Contributors for the Covered Software under Section
254 | 2.1 of this License shall terminate.
255 |
256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all
257 | end user license agreements (excluding distributors and resellers) which
258 | have been validly granted by You or Your distributors under this License
259 | prior to termination shall survive termination.
260 |
261 | ************************************************************************
262 | * *
263 | * 6. Disclaimer of Warranty *
264 | * ------------------------- *
265 | * *
266 | * Covered Software is provided under this License on an "as is" *
267 | * basis, without warranty of any kind, either expressed, implied, or *
268 | * statutory, including, without limitation, warranties that the *
269 | * Covered Software is free of defects, merchantable, fit for a *
270 | * particular purpose or non-infringing. The entire risk as to the *
271 | * quality and performance of the Covered Software is with You. *
272 | * Should any Covered Software prove defective in any respect, You *
273 | * (not any Contributor) assume the cost of any necessary servicing, *
274 | * repair, or correction. This disclaimer of warranty constitutes an *
275 | * essential part of this License. No use of any Covered Software is *
276 | * authorized under this License except under this disclaimer. *
277 | * *
278 | ************************************************************************
279 |
280 | ************************************************************************
281 | * *
282 | * 7. Limitation of Liability *
283 | * -------------------------- *
284 | * *
285 | * Under no circumstances and under no legal theory, whether tort *
286 | * (including negligence), contract, or otherwise, shall any *
287 | * Contributor, or anyone who distributes Covered Software as *
288 | * permitted above, be liable to You for any direct, indirect, *
289 | * special, incidental, or consequential damages of any character *
290 | * including, without limitation, damages for lost profits, loss of *
291 | * goodwill, work stoppage, computer failure or malfunction, or any *
292 | * and all other commercial damages or losses, even if such party *
293 | * shall have been informed of the possibility of such damages. This *
294 | * limitation of liability shall not apply to liability for death or *
295 | * personal injury resulting from such party's negligence to the *
296 | * extent applicable law prohibits such limitation. Some *
297 | * jurisdictions do not allow the exclusion or limitation of *
298 | * incidental or consequential damages, so this exclusion and *
299 | * limitation may not apply to You. *
300 | * *
301 | ************************************************************************
302 |
303 | 8. Litigation
304 | -------------
305 |
306 | Any litigation relating to this License may be brought only in the
307 | courts of a jurisdiction where the defendant maintains its principal
308 | place of business and such litigation shall be governed by laws of that
309 | jurisdiction, without reference to its conflict-of-law provisions.
310 | Nothing in this Section shall prevent a party's ability to bring
311 | cross-claims or counter-claims.
312 |
313 | 9. Miscellaneous
314 | ----------------
315 |
316 | This License represents the complete agreement concerning the subject
317 | matter hereof. If any provision of this License is held to be
318 | unenforceable, such provision shall be reformed only to the extent
319 | necessary to make it enforceable. Any law or regulation which provides
320 | that the language of a contract shall be construed against the drafter
321 | shall not be used to construe this License against a Contributor.
322 |
323 | 10. Versions of the License
324 | ---------------------------
325 |
326 | 10.1. New Versions
327 |
328 | Mozilla Foundation is the license steward. Except as provided in Section
329 | 10.3, no one other than the license steward has the right to modify or
330 | publish new versions of this License. Each version will be given a
331 | distinguishing version number.
332 |
333 | 10.2. Effect of New Versions
334 |
335 | You may distribute the Covered Software under the terms of the version
336 | of the License under which You originally received the Covered Software,
337 | or under the terms of any subsequent version published by the license
338 | steward.
339 |
340 | 10.3. Modified Versions
341 |
342 | If you create software not governed by this License, and you want to
343 | create a new license for such software, you may create and use a
344 | modified version of this License if you rename the license and remove
345 | any references to the name of the license steward (except to note that
346 | such modified license differs from this License).
347 |
348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary
349 | Licenses
350 |
351 | If You choose to distribute Source Code Form that is Incompatible With
352 | Secondary Licenses under the terms of this version of the License, the
353 | notice described in Exhibit B of this License must be attached.
354 |
355 | Exhibit A - Source Code Form License Notice
356 | -------------------------------------------
357 |
358 | This Source Code Form is subject to the terms of the Mozilla Public
359 | License, v. 2.0. If a copy of the MPL was not distributed with this
360 | file, You can obtain one at http://mozilla.org/MPL/2.0/.
361 |
362 | If it is not possible or desirable to put the notice in a particular
363 | file, then You may include the notice in a location (such as a LICENSE
364 | file in a relevant directory) where a recipient would be likely to look
365 | for such a notice.
366 |
367 | You may add additional accurate notices of copyright ownership.
368 |
369 | Exhibit B - "Incompatible With Secondary Licenses" Notice
370 | ---------------------------------------------------------
371 |
372 | This Source Code Form is "Incompatible With Secondary Licenses", as
373 | defined by the Mozilla Public License, v. 2.0.
374 |
--------------------------------------------------------------------------------
/SystemUtils.pas:
--------------------------------------------------------------------------------
1 | unit SystemUtils;
2 |
3 | interface
4 |
5 | uses
6 | Classes, Vcl.StdCtrls;
7 |
8 | const
9 | eimShowStdOut = 1;
10 | eimShowStdErrIfErr = 2;
11 | eimShowStdErr = 4;
12 |
13 | function ExecInMemo(CommandLine, Dir: string; Memo: TMemo; Show: Integer; Debug: Boolean = False): Cardinal;
14 | function GetFileList(Path: String; Masks: array of String): TStringList;
15 | function GetLocaleName(Code, CodeType: Cardinal): String;
16 | function IntegerToHex(Value: Integer): string;
17 |
18 |
19 | implementation
20 |
21 | uses
22 | SysUtils, Windows, Vcl.Forms;
23 |
24 | function ExecInMemo(CommandLine, Dir: string; Memo: TMemo; Show: Integer; Debug: Boolean = False): Cardinal;
25 | const
26 | BufSize = 4096;
27 | var
28 | SA: TSecurityAttributes;
29 | PI: TProcessInformation;
30 | SI: TStartupInfo;
31 | hReadOut, hWriteOut, hReadErr, hWriteErr: NativeUInt;
32 | dwAvailOut, dwAvailErr: Cardinal;
33 | hsBuffOut, hsBuffErr: THandleStream;
34 | TempBuf: TStringList;
35 | StrOut, StrErr: TStringList;
36 | resMsg: Cardinal;
37 | begin
38 | //Init
39 | SA.nLength := SizeOf(SECURITY_ATTRIBUTES);
40 | SA.bInheritHandle := True;
41 | SA.lpSecurityDescriptor := nil;
42 |
43 | if not CreatePipe(hReadOut, hWriteOut, @SA, 0) then
44 | begin
45 | Result := 5;
46 | Memo.Lines.Add('ERROR: can''t create output pipe!');
47 | Exit;
48 | end;
49 |
50 | if not CreatePipe(hReadErr, hWriteErr, @SA, 0) then
51 | begin
52 | Result := 6;
53 | Memo.Lines.Add('ERROR: can''t create error pipe!');
54 | CloseHandle(hReadOut);
55 | CloseHandle(hWriteOut);
56 | Exit;
57 | end;
58 |
59 | ZeroMemory(@SI, SizeOf(TStartupInfo));
60 | SI.cb := SizeOf(TStartupInfo);
61 | SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
62 | if Debug then
63 | SI.wShowWindow := SW_NORMAL
64 | else
65 | SI.wShowWindow := SW_HIDE;
66 | SI.hStdOutput := hWriteOut;
67 | SI.hStdError := hWriteErr;
68 | SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
69 |
70 | StrOut := TStringList.Create;
71 | StrErr := TStringList.Create;
72 |
73 | //Starting up...
74 | if CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(Dir), SI, PI) then
75 | begin
76 | hsBuffOut := THandleStream.Create(hReadOut);
77 | hsBuffErr := THandleStream.Create(hReadErr);
78 | TempBuf := TStringList.Create;
79 |
80 | //Waiting...
81 | //WaitForSingleObject(PI.hProcess, INFINITE);
82 | //MsgWaitForMultipleObjects(1, PI.hProcess, False, INFINITE, QS_ALLINPUT);
83 | repeat
84 | TempBuf.Clear();
85 | if hsBuffOut.Size > 0 then
86 | TempBuf.LoadFromStream(hsBuffOut); //moving block to the buffer
87 | StrOut.AddStrings(TempBuf);
88 |
89 | TempBuf.Clear();
90 | if hsBuffErr.Size > 0 then
91 | TempBuf.LoadFromStream(hsBuffErr); //moving block to the buffer
92 | StrErr.AddStrings(TempBuf);
93 |
94 | //Waiting...
95 | //WaitForSingleObject(PI.hProcess, INFINITE);
96 | resMsg := MsgWaitForMultipleObjects(1, PI.hProcess, False, INFINITE, QS_ALLINPUT);
97 | //Is pipe empty ?
98 | PeekNamedPipe(hReadOut, nil, 0, nil, @dwAvailOut, nil);
99 | PeekNamedPipe(hReadErr, nil, 0, nil, @dwAvailErr, nil);
100 | Application.ProcessMessages;
101 | until (dwAvailOut = 0) and (dwAvailErr = 0) and (resMsg <> WAIT_OBJECT_0 + 1);
102 |
103 | GetExitCodeProcess(PI.hProcess, Result);
104 |
105 | if (Show and eimShowStdOut) > 0 then
106 | begin
107 | Memo.Lines.AddStrings(StrOut);
108 | Memo.Lines.Add('');
109 | Memo.SelStart := Length(Memo.Text);
110 | end;
111 | if ((Show and eimShowStdErr) > 0) or
112 | (((Show and eimShowStdErrIfErr) > 0) and (Result <> 0)) then
113 | begin
114 | Memo.Lines.AddStrings(StrErr);
115 | Memo.Lines.Add('');
116 | Memo.SelStart := Length(Memo.Text);
117 | end;
118 |
119 | CloseHandle(PI.hProcess);
120 | CloseHandle(PI.hThread);
121 |
122 | FreeAndNil(hsBuffOut);
123 | FreeAndNil(hsBuffErr);
124 | FreeAndNil(TempBuf);
125 | end
126 | else
127 | begin
128 | Result := 7;
129 | Memo.Lines.Add('ERROR: can''t start application!');
130 | end;
131 |
132 | FreeAndNil(StrOut);
133 | FreeAndNil(StrErr);
134 |
135 | CloseHandle(hReadOut);
136 | CloseHandle(hWriteOut);
137 | CloseHandle(hReadErr);
138 | CloseHandle(hWriteErr);
139 | end;
140 |
141 | function GetFileList(Path: String; Masks: array of String): TStringList;
142 | var
143 | i, iFind: Integer;
144 | FindRec: TSearchRec;
145 | begin
146 | Result := TStringList.Create;
147 | Result.Sorted := True;
148 | Result.Duplicates := dupIgnore;
149 |
150 | for i := 0 to Length(Masks) - 1 do
151 | begin
152 | iFind := FindFirst(Path + Masks[i], faAnyFile, FindRec);
153 |
154 | if iFind <> 0 then
155 | begin
156 | SysUtils.FindClose(FindRec);
157 | Continue;
158 | end;
159 |
160 | repeat
161 | if (FindRec.Attr <> faDirectory) then
162 | Result.Add(FindRec.Name);
163 | until FindNext(FindRec) <> 0;
164 |
165 | SysUtils.FindClose(FindRec);
166 | end;
167 |
168 | Result.Sort;
169 | end;
170 |
171 | function GetLocaleName(Code, CodeType: Cardinal): String;
172 | var
173 | Size: Integer;
174 | begin
175 | Result := '';
176 | Size := GetLocaleInfo(Code, CodeType, nil, 0);
177 |
178 | if Size < 1 then
179 | Exit;
180 |
181 | SetLength(Result, Size);
182 |
183 | GetLocaleInfo(Code, CodeType, @Result[1], Size);
184 |
185 | Result := Trim(Result);
186 | end;
187 |
188 | function IntegerToHex(Value: Integer): string;
189 | var
190 | len: Integer;
191 | i: Integer;
192 | begin
193 | Result := IntToHex(Value, 1);
194 |
195 | len := Length(Result);
196 |
197 | for i := 1 to len do
198 | if Result[i] <> '0' then
199 | begin
200 | Delete(Result, 1, i - 1);
201 | Break;
202 | end;
203 |
204 | Result := '0x' + Result;
205 | end;
206 |
207 | end.
208 |
209 |
--------------------------------------------------------------------------------
/latin1.pas:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/latin1.pas
--------------------------------------------------------------------------------
/readme.txt:
--------------------------------------------------------------------------------
1 | CHMer 1.0.15
2 | Copyright (C) 2019-2024 by Alexey Kolesnikov.
3 | Email: ak@blu-disc.net
4 | Website: https://github.com/AlekseyKolesnikov/CHMer
5 |
6 |
7 | A simple CHM creation tool.
8 |
9 | Requires:
10 | * Microsoft HTML Help Workshop (https://blu-disc.net/download/htmlhelp.exe)
11 |
12 | Uses:
13 | * SynEdit (https://github.com/SynEdit/SynEdit)
14 | * Rx Library (http://www.micrel.cz/RxLib/dfiles.htm)
15 | * HyperParse by Winston Kotzan (included)
16 |
17 | Features:
18 | * Update HTML titles with tree titles - scans all used htmls and replaces ... with the corresponding names of the content tree nodes.
19 | * Simple validation: checks for unused HTMLs and missed files.
20 | * Ctrl+Space in the HTML editor opens the context menu for inserting a tag/symbol.
21 |
--------------------------------------------------------------------------------
/screenshot.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/screenshot.png
--------------------------------------------------------------------------------
/source/chm.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/source/chm.ico
--------------------------------------------------------------------------------
/source/chm_150.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/source/chm_150.png
--------------------------------------------------------------------------------
/source/chm_32.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/source/chm_32.ico
--------------------------------------------------------------------------------
/source/chm_44.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AlekseyKolesnikov/CHMer/50c1dc3dbd6a5694df1311eeff2dec1ec68d7435/source/chm_44.png
--------------------------------------------------------------------------------
/uAddNewEmpty.dfm:
--------------------------------------------------------------------------------
1 | object frmAddNewEmpty: TfrmAddNewEmpty
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Create new empty HTML'
6 | ClientHeight = 155
7 | ClientWidth = 294
8 | Color = clBtnFace
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'Tahoma'
13 | Font.Style = []
14 | OldCreateOrder = False
15 | Position = poScreenCenter
16 | OnCreate = FormCreate
17 | DesignSize = (
18 | 294
19 | 155)
20 | PixelsPerInch = 96
21 | TextHeight = 13
22 | object Label1: TLabel
23 | Left = 8
24 | Top = 11
25 | Width = 20
26 | Height = 13
27 | Caption = 'Title'
28 | end
29 | object Label2: TLabel
30 | Left = 8
31 | Top = 38
32 | Width = 45
33 | Height = 13
34 | Caption = 'File name'
35 | end
36 | object btnOK: TButton
37 | Left = 130
38 | Top = 122
39 | Width = 75
40 | Height = 25
41 | Anchors = [akRight, akBottom]
42 | Caption = 'OK'
43 | Default = True
44 | ModalResult = 1
45 | TabOrder = 4
46 | end
47 | object btnCancel: TButton
48 | Left = 211
49 | Top = 122
50 | Width = 75
51 | Height = 25
52 | Anchors = [akRight, akBottom]
53 | Cancel = True
54 | Caption = 'Cancel'
55 | ModalResult = 2
56 | TabOrder = 5
57 | end
58 | object edTitle: TEdit
59 | Left = 59
60 | Top = 8
61 | Width = 227
62 | Height = 21
63 | Anchors = [akLeft, akTop, akRight]
64 | TabOrder = 0
65 | end
66 | object edFileName: TEdit
67 | Left = 59
68 | Top = 35
69 | Width = 227
70 | Height = 21
71 | Anchors = [akLeft, akTop, akRight]
72 | TabOrder = 1
73 | end
74 | object rgPosition: TRadioGroup
75 | Left = 8
76 | Top = 62
77 | Width = 278
78 | Height = 51
79 | Anchors = [akLeft, akTop, akRight]
80 | Caption = 'Add'
81 | Columns = 3
82 | ItemIndex = 1
83 | Items.Strings = (
84 | 'Before'
85 | 'After'
86 | 'Child')
87 | TabOrder = 2
88 | end
89 | object chbOpenEditor: TCheckBox
90 | Left = 8
91 | Top = 126
92 | Width = 97
93 | Height = 17
94 | Caption = 'Open in editor'
95 | TabOrder = 3
96 | end
97 | object fsLayout: TFormStorage
98 | IniFileName = 'SOFTWARE'
99 | IniSection = 'CHMer'
100 | Options = []
101 | StoredProps.Strings = (
102 | 'rgPosition.ItemIndex'
103 | 'chbOpenEditor.Checked')
104 | StoredValues = <>
105 | Left = 250
106 | Top = 71
107 | end
108 | end
109 |
--------------------------------------------------------------------------------
/uAddNewEmpty.pas:
--------------------------------------------------------------------------------
1 | unit uAddNewEmpty;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
7 | Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.Mask, Vcl.ExtCtrls, RxPlacemnt;
8 |
9 | type
10 | TfrmAddNewEmpty = class(TForm)
11 | btnOK: TButton;
12 | btnCancel: TButton;
13 | edTitle: TEdit;
14 | Label1: TLabel;
15 | Label2: TLabel;
16 | edFileName: TEdit;
17 | rgPosition: TRadioGroup;
18 | chbOpenEditor: TCheckBox;
19 | fsLayout: TFormStorage;
20 | procedure FormCreate(Sender: TObject);
21 | private
22 | { Private declarations }
23 | public
24 | { Public declarations }
25 | end;
26 |
27 | function InputNewEmpty(var Title: String; var FileName: String; var Position: Integer; var OpenEditor: Boolean): Boolean;
28 |
29 | implementation
30 |
31 | {$R *.dfm}
32 |
33 | function InputNewEmpty(var Title: String; var FileName: String; var Position: Integer; var OpenEditor: Boolean): Boolean;
34 | var
35 | frmAddNewEmpty: TfrmAddNewEmpty;
36 | begin
37 | frmAddNewEmpty := TfrmAddNewEmpty.Create(Application);
38 |
39 | Result := frmAddNewEmpty.ShowModal = mrOk;
40 |
41 | if Result then
42 | begin
43 | Title := frmAddNewEmpty.edTitle.Text;
44 | FileName := frmAddNewEmpty.edFileName.Text;
45 | Position := frmAddNewEmpty.rgPosition.ItemIndex;
46 | OpenEditor := frmAddNewEmpty.chbOpenEditor.Checked;
47 | end;
48 |
49 | frmAddNewEmpty.Free;
50 | end;
51 |
52 | procedure TfrmAddNewEmpty.FormCreate(Sender: TObject);
53 | begin
54 | fsLayout.UseRegistry := True;
55 | end;
56 |
57 | end.
58 |
--------------------------------------------------------------------------------
/uAddProperty.dfm:
--------------------------------------------------------------------------------
1 | object frmAddProperty: TfrmAddProperty
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Add property'
6 | ClientHeight = 155
7 | ClientWidth = 254
8 | Color = clBtnFace
9 | DoubleBuffered = True
10 | Font.Charset = DEFAULT_CHARSET
11 | Font.Color = clWindowText
12 | Font.Height = -11
13 | Font.Name = 'Tahoma'
14 | Font.Style = []
15 | OldCreateOrder = False
16 | Position = poScreenCenter
17 | DesignSize = (
18 | 254
19 | 155)
20 | PixelsPerInch = 96
21 | TextHeight = 13
22 | object Label1: TLabel
23 | Left = 8
24 | Top = 65
25 | Width = 27
26 | Height = 13
27 | Caption = 'Name'
28 | end
29 | object Label2: TLabel
30 | Left = 8
31 | Top = 92
32 | Width = 26
33 | Height = 13
34 | Caption = 'Value'
35 | end
36 | object rgSection: TRadioGroup
37 | Left = 8
38 | Top = 8
39 | Width = 238
40 | Height = 48
41 | Anchors = [akLeft, akTop, akRight]
42 | Caption = 'Section'
43 | Columns = 3
44 | ItemIndex = 0
45 | Items.Strings = (
46 | 'Project'
47 | 'Content'
48 | 'Keywords')
49 | TabOrder = 0
50 | end
51 | object edName: TEdit
52 | Left = 41
53 | Top = 62
54 | Width = 205
55 | Height = 21
56 | Anchors = [akLeft, akTop, akRight]
57 | TabOrder = 1
58 | OnChange = edNameChange
59 | end
60 | object edValue: TEdit
61 | Left = 41
62 | Top = 89
63 | Width = 205
64 | Height = 21
65 | Anchors = [akLeft, akTop, akRight]
66 | TabOrder = 2
67 | end
68 | object btnOK: TButton
69 | Left = 90
70 | Top = 122
71 | Width = 75
72 | Height = 25
73 | Anchors = [akRight, akBottom]
74 | Caption = 'OK'
75 | Default = True
76 | Enabled = False
77 | ModalResult = 1
78 | TabOrder = 3
79 | end
80 | object btnCancel: TButton
81 | Left = 171
82 | Top = 122
83 | Width = 75
84 | Height = 25
85 | Anchors = [akRight, akBottom]
86 | Cancel = True
87 | Caption = 'Cancel'
88 | ModalResult = 2
89 | TabOrder = 4
90 | end
91 | end
92 |
--------------------------------------------------------------------------------
/uAddProperty.pas:
--------------------------------------------------------------------------------
1 | unit uAddProperty;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
8 |
9 | type
10 | TfrmAddProperty = class(TForm)
11 | rgSection: TRadioGroup;
12 | edName: TEdit;
13 | edValue: TEdit;
14 | Label1: TLabel;
15 | Label2: TLabel;
16 | btnOK: TButton;
17 | btnCancel: TButton;
18 | procedure edNameChange(Sender: TObject);
19 | private
20 | { Private declarations }
21 | public
22 | { Public declarations }
23 | end;
24 |
25 | implementation
26 |
27 | {$R *.dfm}
28 |
29 | procedure TfrmAddProperty.edNameChange(Sender: TObject);
30 | begin
31 | btnOK.Enabled := Trim(edName.Text) <> '';
32 | end;
33 |
34 | end.
35 |
--------------------------------------------------------------------------------
/uEditFont.dfm:
--------------------------------------------------------------------------------
1 | object frmEditFont: TfrmEditFont
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Enter value'
6 | ClientHeight = 101
7 | ClientWidth = 394
8 | Color = clBtnFace
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'Tahoma'
13 | Font.Style = []
14 | OldCreateOrder = False
15 | Position = poScreenCenter
16 | OnCreate = FormCreate
17 | DesignSize = (
18 | 394
19 | 101)
20 | PixelsPerInch = 96
21 | TextHeight = 13
22 | object Label4: TLabel
23 | Left = 8
24 | Top = 11
25 | Width = 51
26 | Height = 13
27 | Caption = 'Font name'
28 | end
29 | object Label1: TLabel
30 | Left = 8
31 | Top = 38
32 | Width = 43
33 | Height = 13
34 | Caption = 'Font size'
35 | end
36 | object Label2: TLabel
37 | Left = 177
38 | Top = 38
39 | Width = 38
40 | Height = 13
41 | Caption = 'Charset'
42 | end
43 | object Label3: TLabel
44 | Left = 8
45 | Top = 63
46 | Width = 38
47 | Height = 13
48 | Caption = 'Preview'
49 | end
50 | object lbPreview: TLabel
51 | Left = 65
52 | Top = 63
53 | Width = 37
54 | Height = 13
55 | Caption = 'AaBbCc'
56 | end
57 | object cmbFontName: TComboBox
58 | Left = 65
59 | Top = 8
60 | Width = 321
61 | Height = 21
62 | Anchors = [akLeft, akTop, akRight]
63 | DropDownCount = 32
64 | TabOrder = 0
65 | end
66 | object btnOK: TButton
67 | Left = 230
68 | Top = 68
69 | Width = 75
70 | Height = 25
71 | Anchors = [akRight, akBottom]
72 | Caption = 'OK'
73 | Default = True
74 | ModalResult = 1
75 | TabOrder = 3
76 | ExplicitTop = 46
77 | end
78 | object btnCancel: TButton
79 | Left = 311
80 | Top = 68
81 | Width = 75
82 | Height = 25
83 | Anchors = [akRight, akBottom]
84 | Cancel = True
85 | Caption = 'Cancel'
86 | ModalResult = 2
87 | TabOrder = 4
88 | ExplicitTop = 46
89 | end
90 | object seFontSize: TSpinEdit
91 | Left = 65
92 | Top = 35
93 | Width = 100
94 | Height = 22
95 | MaxValue = 0
96 | MinValue = 0
97 | TabOrder = 1
98 | Value = 0
99 | end
100 | object cmbCharset: TComboBox
101 | Left = 221
102 | Top = 35
103 | Width = 165
104 | Height = 21
105 | Style = csDropDownList
106 | Anchors = [akLeft, akTop, akRight]
107 | DropDownCount = 32
108 | TabOrder = 2
109 | end
110 | end
111 |
--------------------------------------------------------------------------------
/uEditFont.pas:
--------------------------------------------------------------------------------
1 | unit uEditFont;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
7 | Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.Mask;
8 |
9 | type
10 | TfrmEditFont = class(TForm)
11 | cmbFontName: TComboBox;
12 | Label4: TLabel;
13 | btnOK: TButton;
14 | btnCancel: TButton;
15 | seFontSize: TSpinEdit;
16 | Label1: TLabel;
17 | cmbCharset: TComboBox;
18 | Label2: TLabel;
19 | Label3: TLabel;
20 | lbPreview: TLabel;
21 | procedure FormCreate(Sender: TObject);
22 | procedure OnFontChange(Sender: TObject);
23 | private
24 | { Private declarations }
25 | public
26 | { Public declarations }
27 | end;
28 |
29 | function InputFont(Title: String; var FontName: String; var FontSize: Integer; var Charset: Integer): Boolean;
30 |
31 | implementation
32 |
33 | {$R *.dfm}
34 |
35 | function InputFont(Title: String; var FontName: String; var FontSize: Integer; var Charset: Integer): Boolean;
36 | var
37 | frmEditFont: TfrmEditFont;
38 | begin
39 | frmEditFont := TfrmEditFont.Create(Application);
40 |
41 | frmEditFont.cmbFontName.ItemIndex := frmEditFont.cmbFontName.Items.IndexOf(FontName);
42 | if frmEditFont.cmbFontName.ItemIndex < 0 then
43 | frmEditFont.cmbFontName.Text := FontName;
44 |
45 | frmEditFont.seFontSize.Value := FontSize;
46 | frmEditFont.cmbCharset.ItemIndex := frmEditFont.cmbCharset.Items.IndexOfObject(Pointer(Charset));
47 |
48 | Result := frmEditFont.ShowModal = mrOk;
49 |
50 | if Result then
51 | begin
52 | FontName := frmEditFont.cmbFontName.Text;
53 | FontSize := frmEditFont.seFontSize.Value;
54 | Charset := Integer(Pointer(frmEditFont.cmbCharset.Items.Objects[frmEditFont.cmbCharset.ItemIndex]));
55 | end;
56 |
57 | frmEditFont.Free;
58 | end;
59 |
60 | procedure TfrmEditFont.FormCreate(Sender: TObject);
61 | begin
62 | cmbFontName.Items.AddStrings(Screen.Fonts);
63 |
64 | cmbCharset.Items.AddObject('ANSI_CHARSET', Pointer($00));
65 | cmbCharset.Items.AddObject('ARABIC_CHARSET', Pointer($B2));
66 | cmbCharset.Items.AddObject('BALTIC_CHARSET', Pointer($BA));
67 | cmbCharset.Items.AddObject('CHINESEBIG5_CHARSET', Pointer($88));
68 | cmbCharset.Items.AddObject('DEFAULT_CHARSET', Pointer($01));
69 | cmbCharset.Items.AddObject('EASTEUROPE_CHARSET', Pointer($EE));
70 | cmbCharset.Items.AddObject('GB2312_CHARSET', Pointer($86));
71 | cmbCharset.Items.AddObject('GREEK_CHARSET', Pointer($A1));
72 | cmbCharset.Items.AddObject('HANGUL_CHARSET', Pointer($81));
73 | cmbCharset.Items.AddObject('HEBREW_CHARSET', Pointer($B1));
74 | cmbCharset.Items.AddObject('JOHAB_CHARSET', Pointer($82));
75 | cmbCharset.Items.AddObject('MAC_CHARSET', Pointer($4D));
76 | cmbCharset.Items.AddObject('OEM_CHARSET', Pointer($FF));
77 | cmbCharset.Items.AddObject('RUSSIAN_CHARSET', Pointer($CC));
78 | cmbCharset.Items.AddObject('SHIFTJIS_CHARSET', Pointer($80));
79 | cmbCharset.Items.AddObject('SYMBOL_CHARSET', Pointer($02));
80 | cmbCharset.Items.AddObject('THAI_CHARSET', Pointer($DE));
81 | cmbCharset.Items.AddObject('TURKISH_CHARSET', Pointer($A2));
82 | cmbCharset.Items.AddObject('VIETNAMESE_CHARSET', Pointer($A3));
83 |
84 | cmbCharset.ItemIndex := 0;
85 |
86 | cmbFontName.OnChange := OnFontChange;
87 | seFontSize.OnChange := OnFontChange;
88 | cmbCharset.OnChange := OnFontChange;
89 | end;
90 |
91 | procedure TfrmEditFont.OnFontChange(Sender: TObject);
92 | begin
93 | lbPreview.Font.Name := cmbFontName.Text;
94 | lbPreview.Font.Size := seFontSize.Value;
95 | if cmbCharset.ItemIndex > -1 then
96 | lbPreview.Font.Charset := TFontCharset(Pointer(cmbCharset.Items.Objects[cmbCharset.ItemIndex]));
97 | end;
98 |
99 | end.
100 |
--------------------------------------------------------------------------------
/uEditValue.dfm:
--------------------------------------------------------------------------------
1 | object frmEditValue: TfrmEditValue
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Enter value'
6 | ClientHeight = 79
7 | ClientWidth = 394
8 | Color = clBtnFace
9 | Font.Charset = DEFAULT_CHARSET
10 | Font.Color = clWindowText
11 | Font.Height = -11
12 | Font.Name = 'Tahoma'
13 | Font.Style = []
14 | OldCreateOrder = False
15 | Position = poScreenCenter
16 | DesignSize = (
17 | 394
18 | 79)
19 | PixelsPerInch = 96
20 | TextHeight = 13
21 | object lbCaption: TLabel
22 | Left = 8
23 | Top = 11
24 | Width = 55
25 | Height = 13
26 | Caption = 'Enter value'
27 | end
28 | object edEdit: TMaskEdit
29 | Left = 72
30 | Top = 8
31 | Width = 314
32 | Height = 21
33 | Anchors = [akLeft, akTop, akRight]
34 | TabOrder = 0
35 | Text = ''
36 | Visible = False
37 | end
38 | object seInteger: TSpinEdit
39 | Left = 72
40 | Top = 8
41 | Width = 100
42 | Height = 22
43 | MaxValue = 0
44 | MinValue = 0
45 | TabOrder = 1
46 | Value = 0
47 | Visible = False
48 | end
49 | object cmbComboBox: TComboBox
50 | Left = 72
51 | Top = 8
52 | Width = 314
53 | Height = 21
54 | Style = csDropDownList
55 | Anchors = [akLeft, akTop, akRight]
56 | DropDownCount = 32
57 | TabOrder = 2
58 | Visible = False
59 | end
60 | object btnOK: TButton
61 | Left = 230
62 | Top = 46
63 | Width = 75
64 | Height = 25
65 | Anchors = [akRight, akBottom]
66 | Caption = 'OK'
67 | Default = True
68 | ModalResult = 1
69 | TabOrder = 3
70 | end
71 | object btnCancel: TButton
72 | Left = 311
73 | Top = 46
74 | Width = 75
75 | Height = 25
76 | Anchors = [akRight, akBottom]
77 | Cancel = True
78 | Caption = 'Cancel'
79 | ModalResult = 2
80 | TabOrder = 4
81 | end
82 | end
83 |
--------------------------------------------------------------------------------
/uEditValue.pas:
--------------------------------------------------------------------------------
1 | unit uEditValue;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
7 | Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.Mask;
8 |
9 | type
10 | TfrmEditValue = class(TForm)
11 | seInteger: TSpinEdit;
12 | cmbComboBox: TComboBox;
13 | lbCaption: TLabel;
14 | edEdit: TMaskEdit;
15 | btnOK: TButton;
16 | btnCancel: TButton;
17 | private
18 | { Private declarations }
19 | public
20 | { Public declarations }
21 | end;
22 |
23 | TInitListCallback = procedure(aList: TStrings);
24 | TDestroyListCallback = procedure(aList: TStrings; ItemIndex: Integer);
25 |
26 | function InputInteger(Title: String; var Value: Integer): Boolean;
27 | function InputList(Title: String; var Value: String; InitListCallback: TInitListCallback; DestroyListCallback: TDestroyListCallback): Boolean;
28 | function InputText(Title: String; var Value: String; Mask: String = ''): Boolean;
29 |
30 | implementation
31 |
32 | {$R *.dfm}
33 |
34 | function InputInteger(Title: String; var Value: Integer): Boolean;
35 | var
36 | frmEditValue: TfrmEditValue;
37 | begin
38 | frmEditValue := TfrmEditValue.Create(Application);
39 | frmEditValue.Caption := Title;
40 | frmEditValue.seInteger.Visible := True;
41 | frmEditValue.seInteger.Value := Value;
42 |
43 | Result := frmEditValue.ShowModal = mrOk;
44 |
45 | if Result then
46 | Value := frmEditValue.seInteger.Value;
47 |
48 | frmEditValue.Free;
49 | end;
50 |
51 | function InputList(Title: String; var Value: String; InitListCallback: TInitListCallback; DestroyListCallback: TDestroyListCallback): Boolean;
52 | var
53 | frmEditValue: TfrmEditValue;
54 | begin
55 | frmEditValue := TfrmEditValue.Create(Application);
56 | frmEditValue.Caption := Title;
57 | frmEditValue.cmbComboBox.Visible := True;
58 | InitListCallback(frmEditValue.cmbComboBox.Items);
59 | frmEditValue.cmbComboBox.ItemIndex := frmEditValue.cmbComboBox.Items.IndexOf(Value);
60 |
61 | Result := frmEditValue.ShowModal = mrOk;
62 |
63 | if Result then
64 | Value := frmEditValue.cmbComboBox.Text;
65 |
66 | if Assigned(DestroyListCallback) then
67 | DestroyListCallback(frmEditValue.cmbComboBox.Items, frmEditValue.cmbComboBox.ItemIndex);
68 |
69 | frmEditValue.Free;
70 | end;
71 |
72 | function InputText(Title: String; var Value: String; Mask: String = ''): Boolean;
73 | var
74 | frmEditValue: TfrmEditValue;
75 | begin
76 | frmEditValue := TfrmEditValue.Create(Application);
77 | frmEditValue.Caption := Title;
78 | frmEditValue.edEdit.Visible := True;
79 | frmEditValue.edEdit.EditMask := Mask;
80 | frmEditValue.edEdit.Text := Value;
81 |
82 | Result := frmEditValue.ShowModal = mrOk;
83 |
84 | if Result then
85 | Value := frmEditValue.edEdit.Text;
86 |
87 | frmEditValue.Free;
88 | end;
89 |
90 | end.
91 |
--------------------------------------------------------------------------------
/uHelpProject.pas:
--------------------------------------------------------------------------------
1 | unit uHelpProject;
2 |
3 | interface
4 |
5 | uses
6 | Classes, ComCtrls;
7 |
8 | type
9 | THHCType = (hhcProperties, hhcObject, hhcParameter, hhcWTF);
10 |
11 | TProject = class
12 | private
13 | FileHHC, FileHHK: String;
14 | ProjectItems: TTreeNodes;
15 |
16 | procedure LoadHHC(FileName: String);
17 | procedure LoadHHK(FileName: String);
18 | function LoadHHP(FileName: String): Boolean;
19 | public
20 | PrjDir, ProjectFile: String;
21 | Modified: Boolean;
22 |
23 | constructor Create(FileName: String; ProjectTree: TTreeNodes);
24 | destructor Destroy; override;
25 | procedure CreateEmptyProject;
26 | procedure Save(FileName: String = ''; AddContents: Boolean = False; AddIfEmpty: Boolean = False);
27 | end;
28 |
29 | TCHMData = class abstract
30 | function GetPropsCount: Integer; virtual; abstract;
31 | end;
32 |
33 | TProjectData = class(TCHMData)
34 | slProject, slContent, slKeyWords: TStringList;
35 |
36 | constructor Create;
37 | destructor Destroy; override;
38 | function GetPropsCount: Integer; override;
39 | end;
40 |
41 | TObjectData = class(TCHMData)
42 | Name, URL, ImageIndex: String;
43 | slKeyWords: TStringList;
44 |
45 | constructor Create;
46 | destructor Destroy; override;
47 | function GetPropsCount: Integer; override;
48 | end;
49 |
50 |
51 | implementation
52 |
53 | uses
54 | SysUtils, StrUtils, XMLDoc, Dialogs, IniFiles, HyperParse, HTMLTools;
55 |
56 | function GetTypeHHC(info: THtmlInfo): THHCType;
57 | var
58 | S: string;
59 | i: Integer;
60 | begin
61 | Result := hhcWTF;
62 |
63 | if (AnsiLowerCase(info.TagName) = 'param') then
64 | Result := hhcParameter;
65 |
66 | if (AnsiUpperCase(info.TagName) <> 'OBJECT') or (info.ParamCount < 1) then
67 | Exit;
68 |
69 | for i := 0 to info.ParamCount - 1 do
70 | if AnsiLowerCase(info.Params[i].Name) = 'type' then
71 | begin
72 | S := AnsiLowerCase(info.Params[i].Value);
73 |
74 | if Pos('text/site properties', S) > 0 then
75 | Result := hhcProperties
76 | else
77 | if Pos('text/sitemap', S) > 0 then
78 | Result := hhcObject;
79 |
80 | Break;
81 | end;
82 | end;
83 |
84 |
85 | { TProject }
86 |
87 | constructor TProject.Create(FileName: String; ProjectTree: TTreeNodes);
88 | begin
89 | inherited Create();
90 |
91 | ProjectItems := ProjectTree;
92 | ProjectFile := FileName;
93 |
94 | if FileName = '' then
95 | begin
96 | PrjDir := '';
97 | CreateEmptyProject;
98 | end
99 | else
100 | begin
101 | PrjDir := ExtractFilePath(FileName);
102 | if LoadHHP(FileName) then
103 | begin
104 | LoadHHC(PrjDir + FileHHC);
105 | LoadHHK(PrjDir + FileHHK);
106 | end;
107 | end;
108 |
109 | Modified := False;
110 | end;
111 |
112 | procedure TProject.CreateEmptyProject;
113 | var
114 | RootNode: TTreeNode;
115 | Data: TProjectData;
116 | begin
117 | RootNode := ProjectItems.AddChild(nil, 'Project properties');
118 | RootNode.ImageIndex := 43;
119 | RootNode.SelectedIndex := 43;
120 |
121 | Data := TProjectData.Create;
122 | RootNode.Data := Data;
123 |
124 | Data.slProject.AddPair('Compatibility', '1.1 or later');
125 | Data.slProject.AddPair('Compiled file', '');
126 | Data.slProject.AddPair('Contents file', '');
127 | Data.slProject.AddPair('Default font', ',8,0');
128 | Data.slProject.AddPair('Default topic', '');
129 | Data.slProject.AddPair('Full-text search', 'Yes');
130 | Data.slProject.AddPair('Index file', '');
131 | Data.slProject.AddPair('Language', '0x409 English (United States)');
132 | Data.slProject.AddPair('Title', '');
133 |
134 | Data.slContent.AddPair('FrameName', 'right');
135 | Data.slContent.AddPair('Font', ',8,0');
136 | Data.slContent.AddPair('ImageType', 'Book');
137 | Data.slContent.AddPair('Window Styles', '0x27');
138 | Data.slContent.AddPair('ExWindow Styles', '0x0');
139 |
140 | Data.slKeyWords.AddPair('Font', ',8,0');
141 | end;
142 |
143 | destructor TProject.Destroy;
144 | var
145 | i: Integer;
146 | begin
147 | if Assigned(ProjectItems) then
148 | begin
149 | for i := 0 to ProjectItems.Count - 1 do
150 | if Assigned(ProjectItems[i].Data) then
151 | begin
152 | TObject(ProjectItems[i].Data).Free;
153 | ProjectItems[i].Data := nil;
154 | end;
155 | end;
156 |
157 | inherited;
158 | end;
159 |
160 | procedure TProject.LoadHHC(FileName: String);
161 |
162 | function AddObject(RootNode: TTreeNode): TTreeNode;
163 | var
164 | Data: TObjectData;
165 | begin
166 | Result := ProjectItems.AddChild(RootNode, '-');
167 |
168 | Result.ImageIndex := 0;
169 | Result.SelectedIndex := 0;
170 |
171 | Data := TObjectData.Create;
172 | Result.Data := Data;
173 | end;
174 |
175 | procedure AddParameter(LastNode: TTreeNode; info: THtmlInfo);
176 | var
177 | i: Integer;
178 | sName, sValue: string;
179 | begin
180 | if not Assigned(LastNode) then
181 | Exit;
182 |
183 | sName := '';
184 | sValue := '';
185 |
186 | for i := 0 to info.ParamCount - 1 do
187 | begin
188 | if AnsiLowerCase(info.Params[i].Name) = 'name' then
189 | sName := info.Params[i].Value;
190 | if AnsiLowerCase(info.Params[i].Name) = 'value' then
191 | sValue := FromHTML(info.Params[i].Value);
192 | end;
193 |
194 | if sName <> '' then
195 | begin
196 | if LastNode = ProjectItems[0] then
197 | begin
198 | TProjectData(LastNode.Data).slContent.Add(sName + '=' + sValue);
199 | end
200 | else
201 | begin
202 | if sName = 'Name' then
203 | begin
204 | TObjectData(LastNode.Data).Name := sValue;
205 | LastNode.Text := sValue;
206 | end
207 | else
208 | if sName = 'Local' then
209 | begin
210 | TObjectData(LastNode.Data).URL := sValue
211 | end
212 | else
213 | if sName = 'ImageNumber' then
214 | try
215 | TObjectData(LastNode.Data).ImageIndex := sValue;
216 | LastNode.ImageIndex := StrToInt(sValue);
217 | LastNode.SelectedIndex := LastNode.ImageIndex;
218 | except
219 | end;
220 | end;
221 | end;
222 | end;
223 |
224 | var
225 | DomTree: THyperParse;
226 | i: Integer;
227 | hhcType: THHCType;
228 | LastNode, RootNode: TTreeNode;
229 | begin
230 | // ProjectItems[0] should exists - creates by LoadHHP
231 |
232 | LastNode := nil;
233 | RootNode := ProjectItems[0];
234 |
235 | DomTree := THyperParse.Create;
236 | DomTree.FileName := FileName;
237 | DomTree.Execute;
238 |
239 | for i := 0 to DomTree.Count - 1 do
240 | begin
241 | if AnsiUpperCase(DomTree.Item[i].TagName) = 'UL' then
242 | begin
243 | RootNode := LastNode;
244 | Continue;
245 | end;
246 |
247 | if (AnsiUpperCase(DomTree.Item[i].TagName) = '/UL') and Assigned(LastNode) then
248 | begin
249 | RootNode := RootNode.Parent;
250 | Continue;
251 | end;
252 |
253 | hhcType := GetTypeHHC(DomTree.Item[i]);
254 |
255 | case hhcType of
256 | hhcProperties: LastNode := ProjectItems[0];
257 | hhcObject: LastNode := AddObject(RootNode);
258 | hhcParameter: AddParameter(LastNode, DomTree.Item[i]);
259 | end;
260 | end;
261 |
262 | FreeAndNil(DomTree);
263 | end;
264 |
265 | procedure TProject.LoadHHK(FileName: String);
266 | var
267 | LastNode: TTreeNode;
268 | slParameters: TStringList;
269 | j: Integer;
270 |
271 | procedure AddParameter(info: THtmlInfo);
272 | var
273 | i: Integer;
274 | sName, sValue: string;
275 | begin
276 | sName := '';
277 | sValue := '';
278 |
279 | for i := 0 to info.ParamCount - 1 do
280 | begin
281 | if AnsiLowerCase(info.Params[i].Name) = 'name' then
282 | sName := AnsiLowerCase(info.Params[i].Value);
283 | if AnsiLowerCase(info.Params[i].Name) = 'value' then
284 | sValue := FromHTML(info.Params[i].Value);
285 | end;
286 |
287 | if LastNode = ProjectItems[0] then
288 | begin
289 | TProjectData(ProjectItems[0].Data).slKeyWords.Add(sName + '=' + sValue);
290 | Exit;
291 | end;
292 |
293 | if sName = 'local' then
294 | begin
295 | for i := 1 to ProjectItems.Count - 1 do
296 | if AnsiLowerCase(Trim(TObjectData(ProjectItems[i].Data).URL)) = AnsiLowerCase(Trim(sValue)) then
297 | begin
298 | LastNode := ProjectItems[i];
299 | Break;
300 | end;
301 |
302 | if not Assigned(LastNode) then
303 | ShowMessage('Node not found for ' + sValue);
304 | end
305 | else
306 | slParameters.Add(sValue);
307 | end;
308 |
309 | var
310 | DomTree: THyperParse;
311 | i: Integer;
312 | hhcType: THHCType;
313 | begin
314 | DomTree := THyperParse.Create;
315 | DomTree.FileName := FileName;
316 | DomTree.Execute;
317 |
318 | slParameters := TStringList.Create;
319 | LastNode := nil;
320 |
321 | for i := 0 to DomTree.Count - 1 do
322 | begin
323 | hhcType := GetTypeHHC(DomTree.Item[i]);
324 |
325 | if (AnsiUpperCase(DomTree.Item[i].TagName) = '/OBJECT') and Assigned(LastNode) and (LastNode <> ProjectItems[0]) then
326 | begin
327 | for j := 0 to slParameters.Count - 1 do
328 | if slParameters[j] <> TObjectData(LastNode.Data).Name then
329 | TObjectData(LastNode.Data).slKeyWords.Add(slParameters[j]);
330 |
331 | slParameters.Clear;
332 | Continue;
333 | end;
334 |
335 | case hhcType of
336 | hhcProperties: LastNode := ProjectItems[0];
337 | hhcObject: LastNode := nil;
338 | hhcParameter: AddParameter(DomTree.Item[i]);
339 | end;
340 |
341 | end;
342 |
343 | DomTree.Free;
344 | slParameters.Free;
345 | end;
346 |
347 | function TProject.LoadHHP(FileName: String): Boolean;
348 | var
349 | ini: TMemIniFile;
350 | RootNode: TTreeNode;
351 | Data: TProjectData;
352 | begin
353 | Result := False;
354 | ini := TMemIniFile.Create(FileName);
355 |
356 | FileHHC := ini.ReadString('OPTIONS', 'Contents file', ExtractFileName(ChangeFileExt(FileName, '.hhc')));
357 |
358 | if not FileExists(PrjDir + FileHHC) then
359 | begin
360 | FileHHC := '';
361 | PrjDir := '';
362 | FreeAndNil(ini);
363 | Exit;
364 | end;
365 |
366 | FileHHK := ini.ReadString('OPTIONS', 'Index file', ExtractFileName(ChangeFileExt(FileName, '.hhk')));
367 |
368 | RootNode := ProjectItems.AddChild(nil, 'Project properties');
369 | RootNode.ImageIndex := 43;
370 | RootNode.SelectedIndex := 43;
371 |
372 | Data := TProjectData.Create;
373 | RootNode.Data := Data;
374 |
375 | ini.ReadSectionValues('OPTIONS', Data.slProject);
376 |
377 | Data.slProject.Values['Contents file'] := FileHHC;
378 | Data.slProject.Values['Index file'] := FileHHK;
379 |
380 | FreeAndNil(ini);
381 | Result := True;
382 | end;
383 |
384 | procedure TProject.Save(FileName: String = ''; AddContents: Boolean = False; AddIfEmpty: Boolean = False);
385 | var
386 | slHHP, slHHC, slHHK: TStringList;
387 |
388 | procedure SaveNode(aNode: TTreeNode);
389 | var
390 | i: Integer;
391 | ObjectData: TObjectData;
392 | begin
393 | if aNode <> ProjectItems[0] then
394 | begin
395 | ObjectData := TObjectData(aNode.Data);
396 |
397 | slHHP.Add(ObjectData.URL);
398 |
399 | slHHC.Add('');
405 |
406 | for i := 0 to ObjectData.slKeyWords.Count - 1 do
407 | begin
408 | slHHK.Add('');
413 | end;
414 |
415 | if AddContents and ((not AddIfEmpty) or (ObjectData.slKeyWords.Count = 0)) then
416 | begin
417 | slHHK.Add('');
422 | end;
423 | end;
424 |
425 | if aNode.Count > 0 then
426 | begin
427 | slHHC.Add('');
428 | for i := 0 to aNode.Count - 1 do
429 | SaveNode(aNode.Item[i]);
430 | slHHC.Add('
');
431 | end;
432 | end;
433 |
434 | var
435 | ProjectData: TProjectData;
436 | i: Integer;
437 | begin
438 | if FileName <> '' then
439 | begin
440 | ProjectFile := FileName;
441 | PrjDir := ExtractFilePath(ProjectFile);
442 | end;
443 |
444 | if ProjectFile = '' then
445 | Exit;
446 |
447 | ProjectData := TProjectData(ProjectItems[0].Data);
448 |
449 | FileHHC := ProjectData.slProject.Values['Contents file'];
450 | if FileHHC = '' then
451 | begin
452 | FileHHC := ChangeFileExt(ExtractFileName(FileName), '.hhc');
453 | ProjectData.slProject.Values['Contents file'] := FileHHC;
454 | end;
455 |
456 | FileHHK := ProjectData.slProject.Values['Index file'];
457 | if FileHHK = '' then
458 | begin
459 | FileHHK := ChangeFileExt(ExtractFileName(FileName), '.hhk');
460 | ProjectData.slProject.Values['Index file'] := FileHHK;
461 | end;
462 |
463 | if FileName <> '' then
464 | begin
465 | if ProjectData.slProject.Values['Compiled file'] = '' then
466 | ProjectData.slProject.Values['Compiled file'] := ChangeFileExt(ExtractFileName(FileName), '.chm');
467 | if ProjectData.slProject.Values['Title'] = '' then
468 | ProjectData.slProject.Values['Title'] := ChangeFileExt(ExtractFileName(FileName), '');
469 | end;
470 |
471 | DeleteFile(ProjectFile);
472 |
473 | slHHP := TStringList.Create;
474 | slHHC := TStringList.Create;
475 | slHHK := TStringList.Create;
476 |
477 |
478 | slHHP.Add('[OPTIONS]');
479 | for i := 0 to ProjectData.slProject.Count - 1 do
480 | slHHP.Add(ProjectData.slProject.Names[i] + '=' + ProjectData.slProject.ValueFromIndex[i]);
481 |
482 |
483 | slHHC.Add('');
484 | slHHC.Add('');
485 | slHHC.Add('');
486 | slHHC.Add('');
487 | slHHC.Add('');
488 | slHHC.Add('');
489 | slHHC.Add('');
490 | slHHC.Add('');
496 |
497 |
498 | slHHK.Add('');
499 | slHHK.Add('');
500 | slHHK.Add('');
501 | slHHK.Add('');
502 | slHHK.Add('');
503 | slHHK.Add('');
504 | slHHK.Add('');
505 | slHHK.Add('');
511 |
512 |
513 | slHHP.Add('');
514 | slHHP.Add('[FILES]');
515 |
516 | slHHK.Add('');
517 | SaveNode(ProjectItems.GetFirstNode);
518 | slHHK.Add('
');
519 |
520 |
521 | slHHC.Add('');
522 | slHHC.Add('');
523 |
524 | slHHK.Add('');
525 | slHHK.Add('');
526 |
527 |
528 | slHHP.SaveToFile(ProjectFile);
529 | slHHC.SaveToFile(PrjDir + FileHHC);
530 | slHHK.SaveToFile(PrjDir + FileHHK);
531 |
532 |
533 | FreeAndNil(slHHC);
534 | FreeAndNil(slHHK);
535 | FreeAndNil(slHHP);
536 |
537 | Modified := False;
538 | end;
539 |
540 |
541 | { TProjectData }
542 |
543 | constructor TProjectData.Create;
544 | begin
545 | inherited;
546 |
547 | slProject := TStringList.Create;
548 | slContent := TStringList.Create;
549 | slKeyWords := TStringList.Create;
550 | end;
551 |
552 | destructor TProjectData.Destroy;
553 | begin
554 | FreeAndNil(slProject);
555 | FreeAndNil(slContent);
556 | FreeAndNil(slKeyWords);
557 |
558 | inherited;
559 | end;
560 |
561 | function TProjectData.GetPropsCount: Integer;
562 | begin
563 | Result := slProject.Count + slContent.Count + slKeyWords.Count;
564 | end;
565 |
566 |
567 | { TObjectData }
568 |
569 | constructor TObjectData.Create;
570 | begin
571 | inherited;
572 |
573 | Name := '';
574 | URL := '';
575 | ImageIndex := '';
576 |
577 | slKeyWords := TStringList.Create;
578 | end;
579 |
580 | destructor TObjectData.Destroy;
581 | begin
582 | FreeAndNil(slKeyWords);
583 |
584 | inherited;
585 | end;
586 |
587 | function TObjectData.GetPropsCount: Integer;
588 | begin
589 | Result := 3;
590 | end;
591 |
592 | end.
593 |
594 |
--------------------------------------------------------------------------------
/uMain.pas:
--------------------------------------------------------------------------------
1 | unit uMain;
2 |
3 | // TODO:
4 | // - input fields validation
5 | // - separate application and project settings
6 |
7 | interface
8 |
9 | uses
10 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ToolWin, ComCtrls, Grids, ImgList, OleCtrls,
11 | SHDocVw, StdCtrls, System.ImageList, Vcl.Menus, System.Actions, Vcl.ActnList, Vcl.ExtDlgs, RxPlacemnt, SynEdit, SynEditHighlighter,
12 | SynHighlighterHtml, SynEditMiscClasses, SynEditSearch, SynCompletionProposal, uHelpProject;
13 |
14 | type
15 | TAddFile = function (const FileName: String): TTreeNode of object;
16 |
17 | TfrmMain = class(TForm)
18 | pnLeft: TPanel;
19 | splVertical: TSplitter;
20 | pnRight: TPanel;
21 | pnProperties: TPanel;
22 | splHorizontalLeft: TSplitter;
23 | pnProjectTree: TPanel;
24 | pnInfo: TPanel;
25 | splHorizontalRight: TSplitter;
26 | pnData: TPanel;
27 | pcMainPages: TPageControl;
28 | tsPreview: TTabSheet;
29 | tsHTML: TTabSheet;
30 | tvProjectTree: TTreeView;
31 | sgProperties: TStringGrid;
32 | ilHelp: TImageList;
33 | wbBrowser: TWebBrowser;
34 | seHTML: TSynEdit;
35 | synHTMLSyn: TSynHTMLSyn;
36 | pnHTMLTop: TPanel;
37 | tbHTML: TToolBar;
38 | btnHTMLSave: TToolButton;
39 | pmProjectTree: TPopupMenu;
40 | miAddBefore: TMenuItem;
41 | miAddAfter: TMenuItem;
42 | miAddChild: TMenuItem;
43 | N1: TMenuItem;
44 | miDelete: TMenuItem;
45 | alActionList: TActionList;
46 | actProjectCreate: TAction;
47 | actProjectLoad: TAction;
48 | actProjectSave: TAction;
49 | actProjectCompile: TAction;
50 | actHTMLSave: TAction;
51 | ilNormal: TImageList;
52 | ilGrayed: TImageList;
53 | ilPopup: TImageList;
54 | dlgOpenProject: TOpenDialog;
55 | pmProperties: TPopupMenu;
56 | miPropertiesAdd: TMenuItem;
57 | miPropertiesDelete: TMenuItem;
58 | N2: TMenuItem;
59 | dlgOpenHTML: TOpenDialog;
60 | N3: TMenuItem;
61 | miMoveUp: TMenuItem;
62 | miMoveDown: TMenuItem;
63 | miLevelUp: TMenuItem;
64 | miLevelDown: TMenuItem;
65 | miLevelInside: TMenuItem;
66 | actAddBefore: TAction;
67 | actAddAfter: TAction;
68 | actAddChild: TAction;
69 | actMoveUp: TAction;
70 | actMoveDown: TAction;
71 | actLevelUp: TAction;
72 | actLevelDown: TAction;
73 | actLevelInside: TAction;
74 | actDelete: TAction;
75 | pnLeftToolbar: TPanel;
76 | tbLeftToolbar: TToolBar;
77 | btnAddBefore: TToolButton;
78 | btnAddAfter: TToolButton;
79 | btnAddChild: TToolButton;
80 | btnMoveUp: TToolButton;
81 | btnMoveDown: TToolButton;
82 | btnLevelUp: TToolButton;
83 | btnLevelDown: TToolButton;
84 | btnLevelInside: TToolButton;
85 | btnDelete: TToolButton;
86 | memInfo: TMemo;
87 | dlgOpenHHC: TOpenDialog;
88 | N4: TMenuItem;
89 | miExpandAll: TMenuItem;
90 | miCollapseAll: TMenuItem;
91 | actUpdateHTML: TAction;
92 | dlgSaveProject: TSaveDialog;
93 | fsLayout: TFormStorage;
94 | actCheckNotUsed: TAction;
95 | tbMain: TToolBar;
96 | btnProjectCreate: TToolButton;
97 | btnProjectLoad: TToolButton;
98 | btnProjectSave: TToolButton;
99 | ToolButton4: TToolButton;
100 | btnSettings: TToolButton;
101 | ToolButton3: TToolButton;
102 | btnUpdateHTML: TToolButton;
103 | btnCheckNotUsed: TToolButton;
104 | ToolButton2: TToolButton;
105 | btnProjectCompile: TToolButton;
106 | ilPopupDisabled: TImageList;
107 | memKeyWords: TMemo;
108 | splVerticalRight: TSplitter;
109 | lbKeywords: TLabel;
110 | btnEdit: TToolButton;
111 | actEditHTML: TAction;
112 | btnNewEmpty: TToolButton;
113 | actNewEmpty: TAction;
114 | cmbFindType: TComboBox;
115 | edFindText: TEdit;
116 | actFind: TAction;
117 | seSearch: TSynEditSearch;
118 | dlgFind: TFindDialog;
119 | dlgReplace: TReplaceDialog;
120 | btnFind: TToolButton;
121 | actHTMLFind: TAction;
122 | actHTMLReplace: TAction;
123 | pmSearch: TPopupMenu;
124 | miHTMLFind: TMenuItem;
125 | miHTMLReplace: TMenuItem;
126 | scTypes: TSynCompletionProposal;
127 | miNewEmptyHTML: TMenuItem;
128 | pmHTML: TPopupMenu;
129 | miAddImage: TMenuItem;
130 | miAddURL: TMenuItem;
131 | dlgOpenPicture: TOpenPictureDialog;
132 | miTags: TMenuItem;
133 | miTagP: TMenuItem;
134 | miTagBlockquote: TMenuItem;
135 | miTagH1: TMenuItem;
136 | miTagH2: TMenuItem;
137 | miTagH3: TMenuItem;
138 | miTagH4: TMenuItem;
139 | miTagUL: TMenuItem;
140 | miSymbol: TMenuItem;
141 | miSymbolSpace: TMenuItem;
142 | miSymbolQuote: TMenuItem;
143 | miSymbolApos: TMenuItem;
144 | miSymbolReg: TMenuItem;
145 | miSymbolCopy: TMenuItem;
146 | N5: TMenuItem;
147 | miFormats: TMenuItem;
148 | miBold: TMenuItem;
149 | miItalic: TMenuItem;
150 | miUnderline: TMenuItem;
151 | miSymbolRarr: TMenuItem;
152 | miSymbolLarr: TMenuItem;
153 | actCtrlSpace: TAction;
154 | btnCtrlSpace: TToolButton;
155 | miSymbolAmp: TMenuItem;
156 | procedure FormCreate(Sender: TObject);
157 | procedure tvProjectTreeChange(Sender: TObject; Node: TTreeNode);
158 | procedure actProjectLoadExecute(Sender: TObject);
159 | procedure actProjectSaveExecute(Sender: TObject);
160 | procedure actHTMLSaveExecute(Sender: TObject);
161 | procedure actProjectSaveUpdate(Sender: TObject);
162 | procedure memKeyWordsChange(Sender: TObject);
163 | procedure pmPropertiesPopup(Sender: TObject);
164 | procedure sgPropertiesDblClick(Sender: TObject);
165 | procedure miAddBeforeClick(Sender: TObject);
166 | procedure miAddAfterClick(Sender: TObject);
167 | procedure miAddChildClick(Sender: TObject);
168 | procedure miDeleteClick(Sender: TObject);
169 | procedure tvProjectTreeDeletion(Sender: TObject; Node: TTreeNode);
170 | procedure miMoveUpClick(Sender: TObject);
171 | procedure miMoveDownClick(Sender: TObject);
172 | procedure miLevelUpClick(Sender: TObject);
173 | procedure miLevelDownClick(Sender: TObject);
174 | procedure miLevelInsideClick(Sender: TObject);
175 | procedure actProjectCompileExecute(Sender: TObject);
176 | procedure miPropertiesAddClick(Sender: TObject);
177 | procedure miPropertiesDeleteClick(Sender: TObject);
178 | procedure miExpandAllClick(Sender: TObject);
179 | procedure miCollapseAllClick(Sender: TObject);
180 | procedure pmProjectTreePopup(Sender: TObject);
181 | procedure actUpdateHTMLExecute(Sender: TObject);
182 | procedure actProjectCreateExecute(Sender: TObject);
183 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
184 | procedure actCheckNotUsedExecute(Sender: TObject);
185 | procedure btnSettingsClick(Sender: TObject);
186 | procedure FormShow(Sender: TObject);
187 | procedure splVerticalRightMoved(Sender: TObject);
188 | procedure FormResize(Sender: TObject);
189 | procedure actEditHTMLExecute(Sender: TObject);
190 | procedure actNewEmptyExecute(Sender: TObject);
191 | procedure wbBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
192 | Headers: OleVariant; var Cancel: WordBool);
193 | procedure actFindExecute(Sender: TObject);
194 | procedure actFindUpdate(Sender: TObject);
195 | procedure fsLayoutRestorePlacement(Sender: TObject);
196 | procedure actHTMLFindExecute(Sender: TObject);
197 | procedure actHTMLReplaceExecute(Sender: TObject);
198 | procedure dlgFindFind(Sender: TObject);
199 | procedure dlgReplaceReplace(Sender: TObject);
200 | procedure miAddImageClick(Sender: TObject);
201 | procedure miAddURLClick(Sender: TObject);
202 | procedure miTagClick(Sender: TObject);
203 | procedure miTagULClick(Sender: TObject);
204 | procedure miSymbolClick(Sender: TObject);
205 | procedure miFormatClick(Sender: TObject);
206 | procedure actCtrlSpaceExecute(Sender: TObject);
207 | private
208 | { Private declarations }
209 | Project: TProject;
210 | SelectedObjectData: TObjectData;
211 | CurFileAge: TDateTime;
212 | DoNotNavigate: Boolean;
213 |
214 | function AddAfter(const FileName: string): TTreeNode;
215 | function AddBefore(const FileName: string): TTreeNode;
216 | function AddChild(const FileName: string): TTreeNode;
217 | procedure AddFiles(AddFile: TAddFile);
218 | procedure AddHTMLTag(FileName: string; WithText: Boolean; TagLeft, TagMiddle, TagRight: String);
219 | function AddObject(const FileName: string): TObjectData;
220 | function CloseProject: Boolean;
221 | function GetAddContents: Boolean;
222 | function GetAddIfEmpty: Boolean;
223 | function GetEditor: String;
224 | function GetHHC(Request: Boolean = True): String;
225 | function GetProjectDataList(var aName: string): TStringList;
226 | procedure InitProjectData(ProjectData: TProjectData);
227 | procedure LoadProject(const FileName: String);
228 | procedure PropertiesEditBoolean;
229 | procedure PropertiesEditDefaultTopic;
230 | procedure PropertiesEditFont;
231 | procedure PropertiesEditHex;
232 | procedure PropertiesEditImageIndex;
233 | procedure PropertiesEditLanguage;
234 | procedure PropertiesEditName;
235 | procedure PropertiesEditRootName;
236 | procedure PropertiesEditURL;
237 | procedure SaveSettingsHHC(hhc: String);
238 | procedure SelectTreeItemByUrl(URL: String);
239 | procedure ValidateSrcHref;
240 | procedure ValidateNotUsedHTMLs;
241 | public
242 | { Public declarations }
243 | end;
244 |
245 | var
246 | frmMain: TfrmMain;
247 |
248 | implementation
249 |
250 | {$R *.dfm}
251 |
252 | uses
253 | System.UITypes, System.RegularExpressions, StrUtils, Math, Registry, ShellAPI, SynEditTypes, SynEditTextBuffer, HTMLTools, SystemUtils,
254 | uSelectImage, uAddProperty, uEditValue, uEditFont, uSettings, uAddNewEmpty;
255 |
256 | const
257 | sContent = 'Content';
258 | sKeyWords = 'Keywords';
259 |
260 | sTitle = 'CHMer';
261 | sVersion = ' 1.0.15';
262 |
263 | function Spaces(count: Integer): String;
264 | var
265 | S: AnsiString;
266 | begin
267 | SetLength(S, Count);
268 | FillChar(S[1], count, 32);
269 | Result := string(S);
270 | end;
271 |
272 | procedure TfrmMain.actCheckNotUsedExecute(Sender: TObject);
273 | begin
274 | memInfo.Lines.Clear;
275 | ValidateNotUsedHTMLs;
276 | ValidateSrcHref;
277 | end;
278 |
279 | procedure TfrmMain.actCtrlSpaceExecute(Sender: TObject);
280 | var
281 | aPoint: TPoint;
282 | begin
283 | aPoint := seHTML.RowColumnToPixels(seHTML.DisplayXY);
284 | aPoint := seHTML.ClientToScreen(aPoint);
285 | pmHTML.Popup(aPoint.X, aPoint.Y);
286 | end;
287 |
288 | procedure TfrmMain.actEditHTMLExecute(Sender: TObject);
289 | var
290 | editor: string;
291 | begin
292 | editor := GetEditor;
293 |
294 | if editor = '' then
295 | begin
296 | ShowMessage('Editor not specified');
297 | btnSettings.Click;
298 |
299 | editor := GetEditor;
300 | if editor = '' then
301 | Exit;
302 | end;
303 |
304 | ShellExecute(0, nil, PWideChar(editor), PWideChar('"' + Project.PrjDir + SelectedObjectData.URL + '"'), PWideChar(Project.PrjDir), SW_SHOWNORMAL);
305 | end;
306 |
307 | procedure TfrmMain.actFindExecute(Sender: TObject);
308 | var
309 | iStart, iCurrent: Integer;
310 | CHMData: TCHMData;
311 | ObjectData: TObjectData;
312 | URL: String;
313 | Found: Boolean;
314 | slText: TStringList;
315 | begin
316 | if edFindText.Text = '' then
317 | Exit;
318 |
319 | if Assigned(tvProjectTree.Selected) then
320 | iStart := tvProjectTree.Selected.AbsoluteIndex
321 | else
322 | iStart := 0;
323 |
324 | Found := False;
325 |
326 | for iCurrent := iStart + 1 to tvProjectTree.Items.Count - 1 do
327 | begin
328 | CHMData := TCHMData(tvProjectTree.Items[iCurrent].Data);
329 |
330 | if CHMData is TProjectData then
331 | Continue;
332 |
333 | ObjectData := TObjectData(CHMData);
334 |
335 | if cmbFindType.ItemIndex = 0 then
336 | begin
337 | URL := AnsiLowerCase(ObjectData.URL);
338 |
339 | if Pos(AnsiLowerCase(edFindText.Text), URL) > 0 then
340 | begin
341 | tvProjectTree.Selected := tvProjectTree.Items[iCurrent];
342 | Found := True;
343 | Break;
344 | end;
345 | end
346 | else
347 | begin
348 | if FileExists(Project.PrjDir + ObjectData.URL) then
349 | begin
350 | slText := TStringList.Create;
351 | try
352 | slText.LoadFromFile(Project.PrjDir + ObjectData.URL);
353 |
354 | if (cmbFindType.ItemIndex = 1) and (Pos(edFindText.Text, slText.Text) > 0) or
355 | (cmbFindType.ItemIndex = 2) and (Pos(AnsiLowerCase(edFindText.Text), AnsiLowerCase(slText.Text)) > 0) then
356 | begin
357 | tvProjectTree.Selected := tvProjectTree.Items[iCurrent];
358 | Found := True;
359 | Break;
360 | end;
361 | except
362 | end;
363 | slText.Free;
364 | end;
365 | end;
366 | end;
367 |
368 | if not Found then
369 | ShowMessage('Not found.');
370 | end;
371 |
372 | procedure TfrmMain.actFindUpdate(Sender: TObject);
373 | begin
374 | actFind.Enabled := edFindText.Focused;
375 | end;
376 |
377 | procedure TfrmMain.actHTMLFindExecute(Sender: TObject);
378 | begin
379 | dlgFind.Execute;
380 | end;
381 |
382 | procedure TfrmMain.actHTMLReplaceExecute(Sender: TObject);
383 | begin
384 | dlgReplace.Execute;
385 | end;
386 |
387 | procedure TfrmMain.actHTMLSaveExecute(Sender: TObject);
388 | begin
389 | if (not Assigned(Project)) or (not Assigned(SelectedObjectData)) then
390 | Exit;
391 |
392 | seHTML.Lines.SaveToFile(Project.PrjDir + SelectedObjectData.URL);
393 | FileAge(Project.PrjDir + SelectedObjectData.URL, CurFileAge);
394 | wbBrowser.Refresh;
395 | seHTML.Modified := False;
396 | end;
397 |
398 | procedure TfrmMain.actNewEmptyExecute(Sender: TObject);
399 | var
400 | Title, FileName, Ext: String;
401 | Position: Integer;
402 | OpenEditor: Boolean;
403 | slHTML: TStringList;
404 | aNode: TTreeNode;
405 | begin
406 | if InputNewEmpty(Title, FileName, Position, OpenEditor) then
407 | begin
408 | FileName := Trim(FileName);
409 | if FileName = '' then
410 | begin
411 | ShowMessage('You should specify the file name.');
412 | Exit;
413 | end;
414 |
415 | Ext := AnsiLowerCase(ExtractFileExt(FileName));
416 | if (Ext <> '.html') and (Ext <> '.htm') then
417 | Ext := '.html';
418 | FileName := ChangeFileExt(FileName, Ext);
419 |
420 | slHTML := TStringList.Create;
421 |
422 | slHTML.Add('');
423 | slHTML.Add('');
424 | slHTML.Add(' ');
425 | slHTML.Add(' ');
426 | slHTML.Add(' ' + ToHTML(Title) + '');
427 | slHTML.Add(' ');
428 | slHTML.Add('');
429 | slHTML.Add(' ');
430 | slHTML.Add(' ');
431 | slHTML.Add('');
432 |
433 | try
434 | slHTML.SaveToFile(Project.PrjDir + FileName, TEncoding.UTF8);
435 | except
436 | ShowMessage('Error saving file');
437 | slHTML.Free;
438 | Exit;
439 | end;
440 |
441 | slHTML.Free;
442 |
443 | if (Position = 0) and actAddBefore.Enabled then
444 | aNode := AddBefore(Project.PrjDir + FileName)
445 | else
446 | if (Position = 1) and actAddAfter.Enabled then
447 | aNode := AddAfter(Project.PrjDir + FileName)
448 | else
449 | aNode := AddChild(Project.PrjDir + FileName);
450 |
451 | if OpenEditor and Assigned(aNode) then
452 | begin
453 | tvProjectTree.Selected := aNode;
454 | Project.Modified := True;
455 | actEditHTMLExecute(Sender);
456 | end;
457 | end;
458 | end;
459 |
460 | procedure TfrmMain.actProjectCompileExecute(Sender: TObject);
461 | var
462 | hhc, S: string;
463 | begin
464 | hhc := GetHHC;
465 |
466 | if hhc = '' then
467 | Exit;
468 |
469 | memInfo.Lines.Clear;
470 |
471 | actProjectSaveExecute(nil); // forces AddContents on/off
472 |
473 | try
474 | btnProjectCompile.Down := True;
475 | Screen.Cursor := crAppStart;
476 | ExecInMemo(hhc + ' ' + Project.ProjectFile, ExtractFileDir(hhc), memInfo, eimShowStdOut or eimShowStdErr);
477 | finally
478 | Screen.Cursor := crDefault;
479 | btnProjectCompile.Down := False;
480 | end;
481 |
482 | S := Trim(memInfo.Lines.Text);
483 |
484 | while Pos(#$D#$A#$D#$A, S) > 0 do
485 | S := StringReplace(S, #$D#$A#$D#$A, #$D#$A, [rfReplaceAll]);
486 |
487 | memInfo.Lines.Clear;
488 | memInfo.Lines.Add(S);
489 | end;
490 |
491 | procedure TfrmMain.actProjectCreateExecute(Sender: TObject);
492 | begin
493 | if not CloseProject then
494 | Exit;
495 |
496 | Project := TProject.Create('', tvProjectTree.Items);
497 |
498 | actProjectSaveExecute(nil);
499 |
500 | if Project.ProjectFile = '' then
501 | begin
502 | Project.Modified := False;
503 | CloseProject;
504 | Exit;
505 | end;
506 |
507 | tvProjectTree.Selected := tvProjectTree.Items[0];
508 |
509 | Self.Caption := sTitle + sVersion + ': ' + ExtractFileName(Project.ProjectFile);
510 | Application.Title := sTitle + ': ' + ExtractFileName(Project.ProjectFile);
511 | end;
512 |
513 | procedure TfrmMain.actProjectLoadExecute(Sender: TObject);
514 | begin
515 | if dlgOpenProject.Execute then
516 | LoadProject(dlgOpenProject.FileName);
517 | end;
518 |
519 | procedure TfrmMain.actProjectSaveExecute(Sender: TObject);
520 | var
521 | ProjectData: TProjectData;
522 | AddContents, AddIfEmpty: Boolean;
523 | begin
524 | if not Assigned(Project) then
525 | Exit;
526 |
527 | if Project.ProjectFile = '' then
528 | if not dlgSaveProject.Execute then
529 | Exit;
530 |
531 | AddContents := GetAddContents;
532 | AddIfEmpty := GetAddIfEmpty;
533 |
534 | if Project.ProjectFile = '' then
535 | Project.Save(dlgSaveProject.FileName, AddContents, AddIfEmpty)
536 | else
537 | Project.Save('', AddContents, AddIfEmpty);
538 |
539 | if tvProjectTree.Selected = tvProjectTree.Items[0] then
540 | begin
541 | ProjectData := TProjectData(tvProjectTree.Selected.Data);
542 |
543 | sgProperties.RowCount := ProjectData.GetPropsCount + 1;
544 | InitProjectData(ProjectData);
545 | end;
546 | end;
547 |
548 | procedure TfrmMain.actProjectSaveUpdate(Sender: TObject);
549 | var
550 | CHMData: TCHMData;
551 | aFileAge: TDateTime;
552 | ProjectTreeFocused, EditorFocused: Boolean;
553 | begin
554 | ProjectTreeFocused := tvProjectTree.Focused;
555 | EditorFocused := seHTML.Focused;
556 |
557 | actHTMLSave.Enabled := seHTML.Modified;
558 | actProjectSave.Enabled := Assigned(Project) and Project.Modified;
559 | actProjectCompile.Enabled := Assigned(Project);
560 | actUpdateHTML.Enabled := Assigned(Project);
561 | actCheckNotUsed.Enabled := Assigned(Project) and (Project.ProjectFile <> '');
562 |
563 | actEditHTML.Enabled := Assigned(Project) and Assigned(SelectedObjectData);
564 |
565 | actAddBefore.Enabled := ProjectTreeFocused and actEditHTML.Enabled;
566 | actAddAfter.Enabled := actAddBefore.Enabled;
567 |
568 | actAddChild.Enabled := ProjectTreeFocused and Assigned(Project);
569 | actNewEmpty.Enabled := actAddChild.Enabled;
570 |
571 | actDelete.Enabled := actAddBefore.Enabled;
572 |
573 | actMoveUp.Enabled := actAddBefore.Enabled and (tvProjectTree.Selected.GetPrev <> tvProjectTree.Items[0]) and (tvProjectTree.Selected.getPrevSibling <> nil);
574 | actMoveDown.Enabled := actAddBefore.Enabled and (tvProjectTree.Selected.getNextSibling <> nil);
575 | actLevelUp.Enabled := actAddBefore.Enabled and (tvProjectTree.Selected.Parent <> tvProjectTree.Items[0]);
576 | actLevelDown.Enabled := actAddBefore.Enabled and (tvProjectTree.Selected.getPrevSibling <> nil);
577 |
578 | actLevelInside.Enabled := actMoveDown.Enabled;
579 |
580 | actHTMLFind.Enabled := pcMainPages.ActivePage = tsHTML;
581 | actHTMLReplace.Enabled := actHTMLFind.Enabled;
582 |
583 | miAddImage.Enabled := EditorFocused;
584 | miAddURL.Enabled := EditorFocused;
585 | miTagP.Enabled := EditorFocused;
586 | miTagBlockquote.Enabled := EditorFocused;
587 | miTagH1.Enabled := EditorFocused;
588 | miTagH2.Enabled := EditorFocused;
589 | miTagH3.Enabled := EditorFocused;
590 | miTagH4.Enabled := EditorFocused;
591 | miTagUL.Enabled := EditorFocused;
592 | miSymbolQuote.Enabled := EditorFocused;
593 | miSymbolRarr.Enabled := EditorFocused;
594 | miBold.Enabled := EditorFocused;
595 | miItalic.Enabled := EditorFocused;
596 | miUnderline.Enabled := EditorFocused;
597 |
598 | // Monitor file changes in external application
599 |
600 | if not Assigned(Project) then
601 | Exit;
602 |
603 | if not Assigned(tvProjectTree.Selected) then
604 | Exit;
605 |
606 | CHMData := TCHMData(tvProjectTree.Selected.Data);
607 |
608 | if CHMData is TProjectData then
609 | Exit;
610 |
611 | SelectedObjectData := TObjectData(CHMData);
612 |
613 | FileAge(Project.PrjDir + SelectedObjectData.URL, aFileAge);
614 | if aFileAge <> CurFileAge then
615 | begin
616 | CurFileAge := aFileAge;
617 | //memInfo.Lines.Add('Reloading ' + Project.PrjDir + SelectedObjectData.URL + '...');
618 | wbBrowser.Navigate(Project.PrjDir + SelectedObjectData.URL, navNoHistory or navNoReadFromCache or navNoWriteToCache);
619 | seHTML.Lines.LoadFromFile(Project.PrjDir + SelectedObjectData.URL);
620 | end;
621 | end;
622 |
623 | procedure TfrmMain.actUpdateHTMLExecute(Sender: TObject);
624 | var
625 | i: Integer;
626 | ObjectData: TObjectData;
627 | slHTML: TStringList;
628 | S: string;
629 | begin
630 | if MessageDlg('Update HTML titles to the tree titles?', mtConfirmation, mbYesNo, 0) <> mrYes then
631 | Exit;
632 |
633 | slHTML := TStringList.Create;
634 | Screen.Cursor := crAppStart;
635 | btnUpdateHTML.Down := True;
636 |
637 | try
638 | for i := 1 to tvProjectTree.Items.Count - 1 do
639 | begin
640 | ObjectData := TObjectData(tvProjectTree.Items[i].Data);
641 | if FileExists(Project.PrjDir + ObjectData.URL) then
642 | begin
643 | slHTML.LoadFromFile(Project.PrjDir + ObjectData.URL);
644 | S := GetTagText(slHTML.Text, 'title', False);
645 | if S <> '' then
646 | begin
647 | slHTML.Text := StringReplace(slHTML.Text, '' + S + '', '' + ToHTML(ObjectData.Name, True) + '', [rfIgnoreCase]);
648 | slHTML.SaveToFile(Project.PrjDir + ObjectData.URL);
649 | end;
650 | end
651 | else
652 | ShowMessage('File "' + ObjectData.URL + '" not found!');
653 | end;
654 | finally
655 | btnUpdateHTML.Down := False;
656 | Screen.Cursor := crDefault;
657 | slHTML.Free;
658 | end;
659 | end;
660 |
661 | function TfrmMain.AddAfter(const FileName: string): TTreeNode;
662 | var
663 | DataObject: TObjectData;
664 | begin
665 | DataObject := AddObject(FileName);
666 |
667 | Result := tvProjectTree.Selected.getNextSibling;
668 |
669 | if Assigned(Result) then
670 | Result := tvProjectTree.Items.Insert(Result, DataObject.Name)
671 | else
672 | Result := tvProjectTree.Items.Add(tvProjectTree.Selected, DataObject.Name);
673 |
674 | Result.Data := DataObject;
675 | Result.ImageIndex := 11;
676 | Result.SelectedIndex := 11;
677 | end;
678 |
679 | function TfrmMain.AddBefore(const FileName: string): TTreeNode;
680 | var
681 | DataObject: TObjectData;
682 | begin
683 | DataObject := AddObject(FileName);
684 |
685 | Result := tvProjectTree.Items.Insert(tvProjectTree.Selected, DataObject.Name);
686 |
687 | Result.Data := DataObject;
688 | Result.ImageIndex := 11;
689 | Result.SelectedIndex := 11;
690 | end;
691 |
692 | function TfrmMain.AddChild(const FileName: string): TTreeNode;
693 | var
694 | DataObject: TObjectData;
695 | begin
696 | DataObject := AddObject(FileName);
697 |
698 | if (not tvProjectTree.Selected.HasChildren) and (tvProjectTree.Selected <> tvProjectTree.Items[0]) then
699 | begin
700 | TObjectData(tvProjectTree.Selected.Data).ImageIndex := '1';
701 | tvProjectTree.Selected.ImageIndex := 1;
702 | tvProjectTree.Selected.SelectedIndex := 1;
703 | end;
704 |
705 | Result := tvProjectTree.Items.AddChild(tvProjectTree.Selected, DataObject.Name);
706 | Result.Data := DataObject;
707 | Result.ImageIndex := 11;
708 | Result.SelectedIndex := 11;
709 | end;
710 |
711 | procedure TfrmMain.AddFiles(AddFile: TAddFile);
712 | var
713 | aNode: TTreeNode;
714 | i: Integer;
715 | begin
716 | try
717 | dlgOpenHTML.Options := dlgOpenHTML.Options + [ofAllowMultiSelect];
718 |
719 | if dlgOpenHTML.Execute then
720 | begin
721 | aNode := tvProjectTree.Selected;
722 |
723 | for i := 0 to dlgOpenHTML.Files.Count - 1 do
724 | aNode := AddFile(dlgOpenHTML.Files[i]);
725 |
726 | tvProjectTree.Selected := aNode;
727 | Project.Modified := True;
728 | end;
729 | finally
730 | dlgOpenHTML.Options := dlgOpenHTML.Options - [ofAllowMultiSelect];
731 | end;
732 | end;
733 |
734 | procedure TfrmMain.AddHTMLTag(FileName: string; WithText: Boolean; TagLeft, TagMiddle, TagRight: String);
735 | var
736 | aStart, anEnd: Integer;
737 | txt: String;
738 | begin
739 | aStart := Min(seHTML.SelStart, seHTML.SelEnd);
740 | anEnd := Max(seHTML.SelStart, seHTML.SelEnd);
741 | txt := Copy(seHTML.Text, aStart + 1, anEnd - aStart);
742 |
743 | if txt <> '' then
744 | seHTML.UndoList.AddChange(crDelete, seHTML.CharIndexToRowCol(aStart), seHTML.CharIndexToRowCol(anEnd), txt,
745 | seHTML.ActiveSelectionMode);
746 |
747 | if FileName <> '' then
748 | begin
749 | FileName := StringReplace(FileName, Project.PrjDir, '', [rfIgnoreCase]);
750 | if FileName[1] = '\' then
751 | Delete(FileName, 1, 1);
752 | end;
753 |
754 | if not WithText then
755 | txt := '';
756 |
757 | seHTML.InsertBlock(seHTML.CharIndexToRowCol(aStart), seHTML.CharIndexToRowCol(anEnd),
758 | PWideChar(TagLeft + FileName + TagMiddle + txt + TagRight), True);
759 |
760 | if WithText and (txt = '') then
761 | seHTML.CaretX := seHTML.CaretX - Length(TagRight);
762 | end;
763 |
764 | function TfrmMain.AddObject(const FileName: string): TObjectData;
765 | var
766 | slHTML: TStringList;
767 | aName: string;
768 | begin
769 | slHTML := TStringList.Create;
770 |
771 | Result := TObjectData.Create;
772 | Result.URL := ExtractFileName(FileName);
773 | Result.ImageIndex := '11';
774 |
775 | slHTML.LoadFromFile(FileName);
776 |
777 | aName := GetTagText(slHTML.Text, 'title');
778 | if aName = '' then
779 | aName := GetTagText(slHTML.Text, 'h1');
780 | if aName = '' then
781 | aName := GetTagText(slHTML.Text, 'h2');
782 |
783 | Result.Name := aName;
784 |
785 | slHTML.Free;
786 | end;
787 |
788 | procedure TfrmMain.btnSettingsClick(Sender: TObject);
789 | var
790 | frmSettings: TfrmSettings;
791 | reg: TRegIniFile;
792 | begin
793 | frmSettings := TfrmSettings.Create(Self);
794 | frmSettings.edHHC.FileName := GetHHC(False);
795 | frmSettings.edEditor.FileName := GetEditor;
796 | frmSettings.chbAddContents.Checked := GetAddContents;
797 | frmSettings.chbAddIfEmpty.Checked := GetAddIfEmpty;
798 | frmSettings.edTabSize.Value := seHTML.TabWidth;
799 |
800 | if frmSettings.ShowModal = mrOk then
801 | begin
802 | seHTML.TabWidth := frmSettings.edTabSize.Value;
803 | reg := TRegIniFile.Create;
804 | reg.RootKey := HKEY_CURRENT_USER;
805 |
806 | if reg.OpenKey('Software\CHMer', True) then
807 | begin
808 | reg.WriteString('', 'HHC', frmSettings.edHHC.FileName);
809 | reg.WriteString('', 'Editor', frmSettings.edEditor.FileName);
810 | reg.WriteBool('', 'AddContents', frmSettings.chbAddContents.Checked);
811 | reg.WriteBool('', 'AddIfEmpty', frmSettings.chbAddIfEmpty.Checked);
812 | reg.WriteInteger('', 'TabSize', frmSettings.edTabSize.Value);
813 | end;
814 |
815 | reg.Free;
816 | end;
817 |
818 | frmSettings.Free;
819 | end;
820 |
821 | function TfrmMain.CloseProject: Boolean;
822 | var
823 | i: Integer;
824 | begin
825 | Result := False;
826 |
827 | if Assigned(Project) and Project.Modified then
828 | begin
829 | i := MessageDlg('Project was modified. Save?', mtConfirmation, mbYesNoCancel, 0);
830 |
831 | if i = mrCancel then
832 | Exit;
833 |
834 | if i = mrYes then
835 | Project.Save;
836 | end;
837 |
838 | SelectedObjectData := nil;
839 | tvProjectTree.Selected := nil;
840 | Result := True;
841 |
842 | if Assigned(Project) then
843 | FreeAndNil(Project);
844 |
845 | tvProjectTree.Items.Clear;
846 | wbBrowser.Navigate('about:blank');
847 | seHTML.Lines.Clear;
848 | memKeyWords.OnChange := nil;
849 | memKeyWords.Lines.Clear;
850 | memKeyWords.OnChange := memKeyWordsChange;
851 |
852 | Self.Caption := sTitle + sVersion;
853 | Application.Title := sTitle;
854 | end;
855 |
856 | procedure TfrmMain.dlgFindFind(Sender: TObject);
857 | var
858 | Options: TSynSearchOptions;
859 | begin
860 | Options := [];
861 | if not (frDown in dlgFind.Options) then
862 | Include(Options, ssoBackwards);
863 | if frMatchCase in dlgFind.Options then
864 | Include(Options, ssoMatchCase);
865 | if frWholeWord in dlgFind.Options then
866 | Include(Options, ssoWholeWord);
867 | if seHTML.SearchReplace(dlgFind.FindText, dlgFind.FindText, Options) = 0 then
868 | ShowMessage('Not found.');
869 | end;
870 |
871 | procedure TfrmMain.dlgReplaceReplace(Sender: TObject);
872 | var
873 | Options: TSynSearchOptions;
874 | begin
875 | if (frReplace in dlgReplace.Options) then
876 | Options := [ssoPrompt, ssoReplace]
877 | else
878 | Options := [];
879 | if (frReplaceAll in dlgReplace.Options) then
880 | Include(Options, ssoReplaceAll);
881 |
882 | if not (frDown in dlgReplace.Options) then
883 | Include(Options, ssoBackwards);
884 | if frMatchCase in dlgReplace.Options then
885 | Include(Options, ssoMatchCase);
886 | if frWholeWord in dlgReplace.Options then
887 | Include(Options, ssoWholeWord);
888 | if seHTML.SearchReplace(dlgReplace.FindText, dlgReplace.ReplaceText, Options) = 0 then
889 | ShowMessage('Not found.');
890 | end;
891 |
892 | procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
893 | begin
894 | CanClose := CloseProject;
895 | end;
896 |
897 | procedure TfrmMain.FormCreate(Sender: TObject);
898 | var
899 | reg: TRegIniFile;
900 | begin
901 | Self.Caption := sTitle + sVersion;
902 | Application.Title := sTitle;
903 | fsLayout.UseRegistry := True;
904 | pcMainPages.ActivePageIndex := 0;
905 |
906 | Project := nil;
907 |
908 | SelectedObjectData := nil;
909 |
910 | sgProperties.Cells[0, 0] := '[properties]';
911 |
912 | CurFileAge := 0;
913 | DoNotNavigate := False;
914 |
915 | reg := TRegIniFile.Create;
916 | reg.RootKey := HKEY_CURRENT_USER;
917 |
918 | if reg.OpenKeyReadOnly('Software\CHMer') then
919 | seHTML.TabWidth := reg.ReadInteger('', 'TabSize', seHTML.TabWidth);
920 |
921 | reg.Free;
922 | end;
923 |
924 | procedure TfrmMain.FormResize(Sender: TObject);
925 | begin
926 | splVerticalRightMoved(Sender);
927 | end;
928 |
929 | procedure TfrmMain.FormShow(Sender: TObject);
930 | begin
931 | Self.OnShow := nil;
932 | if (ParamCount > 0) and (FileExists(ParamStr(1))) then
933 | LoadProject(ParamStr(1));
934 | end;
935 |
936 | procedure TfrmMain.fsLayoutRestorePlacement(Sender: TObject);
937 | begin
938 | splVerticalRightMoved(Sender);
939 | end;
940 |
941 | function TfrmMain.GetAddContents: Boolean;
942 | var
943 | reg: TRegIniFile;
944 | begin
945 | Result := False;
946 |
947 | reg := TRegIniFile.Create;
948 |
949 | reg.RootKey := HKEY_CURRENT_USER;
950 |
951 | if reg.OpenKeyReadOnly('Software\CHMer') then
952 | Result := reg.ReadBool('', 'AddContents', False);
953 |
954 | reg.Free;
955 | end;
956 |
957 | function TfrmMain.GetAddIfEmpty: Boolean;
958 | var
959 | reg: TRegIniFile;
960 | begin
961 | Result := False;
962 |
963 | reg := TRegIniFile.Create;
964 |
965 | reg.RootKey := HKEY_CURRENT_USER;
966 |
967 | if reg.OpenKeyReadOnly('Software\CHMer') then
968 | Result := reg.ReadBool('', 'AddIfEmpty', False);
969 |
970 | reg.Free;
971 | end;
972 |
973 | function TfrmMain.GetEditor: String;
974 | var
975 | reg: TRegIniFile;
976 | begin
977 | Result := '';
978 | reg := TRegIniFile.Create;
979 |
980 | reg.RootKey := HKEY_CURRENT_USER;
981 | if reg.OpenKeyReadOnly('Software\CHMer') then
982 | begin
983 | Result := reg.ReadString('', 'Editor', '');
984 | if (Result <> '') and FileExists(Result) then
985 | begin
986 | reg.Free;
987 | Exit;
988 | end;
989 | reg.CloseKey;
990 | end;
991 | reg.Free;
992 | end;
993 |
994 | function TfrmMain.GetHHC(Request: Boolean = True): String;
995 | var
996 | reg: TRegIniFile;
997 | begin
998 | reg := TRegIniFile.Create;
999 |
1000 | reg.RootKey := HKEY_CURRENT_USER;
1001 | if reg.OpenKeyReadOnly('Software\CHMer') then
1002 | begin
1003 | Result := reg.ReadString('', 'HHC', '');
1004 | if (Result <> '') and FileExists(Result) then
1005 | begin
1006 | reg.Free;
1007 | Exit;
1008 | end;
1009 | reg.CloseKey;
1010 | end;
1011 |
1012 | Result := ExtractFilePath(Application.ExeName) + 'hhc.exe';
1013 | if FileExists(Result) then
1014 | begin
1015 | reg.Free;
1016 | SaveSettingsHHC(Result);
1017 | Exit;
1018 | end;
1019 |
1020 | reg.RootKey := HKEY_LOCAL_MACHINE;
1021 | if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\HTML Help Workshop') then
1022 | begin
1023 | Result := reg.ReadString('', 'UninstallString', '');
1024 | if Result <> '' then
1025 | begin
1026 | Result := ExtractFilePath(Result) + 'hhc.exe';
1027 | if FileExists(Result) then
1028 | begin
1029 | reg.Free;
1030 | SaveSettingsHHC(Result);
1031 | Exit;
1032 | end;
1033 | end;
1034 | reg.CloseKey;
1035 | end;
1036 |
1037 | reg.RootKey := HKEY_CURRENT_USER;
1038 | if reg.OpenKeyReadOnly('Software\Microsoft\HTML Help Workshop') then
1039 | begin
1040 | Result := reg.ReadString('', 'InstallDir', '');
1041 | if Result <> '' then
1042 | begin
1043 | Result := Result + '\hhc.exe';
1044 | if FileExists(Result) then
1045 | begin
1046 | reg.Free;
1047 | SaveSettingsHHC(Result);
1048 | Exit;
1049 | end;
1050 | end;
1051 | reg.CloseKey;
1052 | end;
1053 |
1054 | reg.Free;
1055 |
1056 | if Request and dlgOpenHHC.Execute then
1057 | begin
1058 | Result := dlgOpenHHC.FileName;
1059 | if FileExists(Result) then
1060 | begin
1061 | SaveSettingsHHC(Result);
1062 | Exit;
1063 | end;
1064 | end;
1065 |
1066 | Result := '';
1067 | end;
1068 |
1069 | function TfrmMain.GetProjectDataList(var aName: string): TStringList;
1070 | var
1071 | ProjectData: TProjectData;
1072 | begin
1073 | ProjectData := TProjectData(tvProjectTree.Selected.Data);
1074 |
1075 | if Copy(aName, 1, 8) = sContent + ':' then
1076 | begin
1077 | Result := ProjectData.slContent;
1078 | Delete(aName, 1, 9);
1079 | end
1080 | else if Copy(aName, 1, 9) = sKeyWords + ':' then
1081 | begin
1082 | Result := ProjectData.slKeyWords;
1083 | Delete(aName, 1, 10);
1084 | end
1085 | else
1086 | Result := ProjectData.slProject;
1087 | end;
1088 |
1089 | procedure TfrmMain.InitProjectData(ProjectData: TProjectData);
1090 |
1091 | procedure AddData(slData: TStringList; Prefix: String = ''; Offset: Integer = 0);
1092 | var
1093 | i: Integer;
1094 | begin
1095 | if Prefix <> '' then
1096 | Prefix := Prefix + ': ';
1097 |
1098 | for i := 0 to slData.Count - 1 do
1099 | begin
1100 | sgProperties.Cells[0, i + 1 + Offset] := Prefix + slData.Names[i];
1101 | sgProperties.Cells[1, i + 1 + Offset] := slData.ValueFromIndex[i];
1102 | end;
1103 | end;
1104 |
1105 | begin
1106 | AddData(ProjectData.slProject);
1107 | AddData(ProjectData.slContent, sContent, ProjectData.slProject.Count);
1108 | AddData(ProjectData.slKeyWords, sKeywords, ProjectData.slProject.Count + ProjectData.slContent.Count);
1109 | end;
1110 |
1111 | procedure TfrmMain.LoadProject(const FileName: String);
1112 | begin
1113 | if not CloseProject then
1114 | Exit;
1115 |
1116 | Project := TProject.Create(FileName, tvProjectTree.Items);
1117 |
1118 | if tvProjectTree.Items.Count > 0 then
1119 | begin
1120 | tvProjectTree.Items[0].Expand(False);
1121 | tvProjectTree.Selected := tvProjectTree.Items[0];
1122 | end;
1123 |
1124 | Self.Caption := sTitle + sVersion + ': ' + ExtractFileName(FileName);
1125 | Application.Title := sTitle + ': ' + ExtractFileName(FileName);
1126 | end;
1127 |
1128 | procedure TfrmMain.memKeyWordsChange(Sender: TObject);
1129 | begin
1130 | if Assigned(SelectedObjectData) then
1131 | begin
1132 | SelectedObjectData.slKeyWords.Text := memKeyWords.Lines.Text;
1133 | Project.Modified := True;
1134 | end;
1135 | end;
1136 |
1137 | procedure TfrmMain.miAddAfterClick(Sender: TObject);
1138 | begin
1139 | AddFiles(AddAfter);
1140 | end;
1141 |
1142 | procedure TfrmMain.miAddBeforeClick(Sender: TObject);
1143 | begin
1144 | AddFiles(AddBefore);
1145 | end;
1146 |
1147 | procedure TfrmMain.miAddChildClick(Sender: TObject);
1148 | begin
1149 | tvProjectTree.Selected.Expand(False);
1150 | AddFiles(AddChild);
1151 | end;
1152 |
1153 | procedure TfrmMain.miAddImageClick(Sender: TObject);
1154 | begin
1155 | if not dlgOpenPicture.Execute then
1156 | Exit;
1157 |
1158 | AddHTMLTag(dlgOpenPicture.FileName, False, '
');
1159 | end;
1160 |
1161 | procedure TfrmMain.miAddURLClick(Sender: TObject);
1162 | begin
1163 | dlgOpenHTML.Options := dlgOpenHTML.Options - [ofAllowMultiSelect];
1164 |
1165 | if not dlgOpenHTML.Execute then
1166 | Exit;
1167 |
1168 | AddHTMLTag(dlgOpenHTML.FileName, True, '', '');
1169 | end;
1170 |
1171 | procedure TfrmMain.miCollapseAllClick(Sender: TObject);
1172 | begin
1173 | tvProjectTree.Items[0].Collapse(True);
1174 | end;
1175 |
1176 | procedure TfrmMain.miDeleteClick(Sender: TObject);
1177 | begin
1178 | if not Assigned(SelectedObjectData) then
1179 | Exit;
1180 |
1181 | if MessageDlg('Remove node "' + SelectedObjectData.Name + '"' + IfThen(tvProjectTree.Selected.HasChildren, ' with all subnodes') + '?',
1182 | mtConfirmation, mbYesNo, 0) = mrYes then
1183 | begin
1184 | if tvProjectTree.Selected.HasChildren then
1185 | tvProjectTree.Selected.DeleteChildren;
1186 | tvProjectTree.Selected.Delete;
1187 | Project.Modified := True;
1188 | end;
1189 | end;
1190 |
1191 | procedure TfrmMain.miExpandAllClick(Sender: TObject);
1192 | begin
1193 | tvProjectTree.Items[0].Expand(True);
1194 | end;
1195 |
1196 | procedure TfrmMain.miFormatClick(Sender: TObject);
1197 | var
1198 | tag: string;
1199 | begin
1200 | tag := Char(TMenuItem(Sender).Tag);
1201 | AddHTMLTag('', True, '<' + tag + '>', '', '');
1202 | end;
1203 |
1204 | procedure TfrmMain.miLevelDownClick(Sender: TObject);
1205 | var
1206 | aNode: TTreeNode;
1207 | HasChildren: Boolean;
1208 | begin
1209 | aNode := tvProjectTree.Selected.getPrevSibling;
1210 | if not Assigned(aNode) then
1211 | Exit;
1212 |
1213 | HasChildren := aNode.HasChildren;
1214 |
1215 | tvProjectTree.Selected.MoveTo(aNode, naAddChildFirst);
1216 |
1217 | if not HasChildren then
1218 | begin
1219 | aNode.ImageIndex := 1;
1220 | aNode.SelectedIndex := 1;
1221 | end;
1222 |
1223 | Project.Modified := True;
1224 | end;
1225 |
1226 | procedure TfrmMain.miLevelInsideClick(Sender: TObject);
1227 | var
1228 | aNode: TTreeNode;
1229 | HasChildren: Boolean;
1230 | begin
1231 | aNode := tvProjectTree.Selected.getNextSibling;
1232 | if not Assigned(aNode) then
1233 | Exit;
1234 |
1235 | HasChildren := aNode.HasChildren;
1236 |
1237 | tvProjectTree.Selected.MoveTo(aNode, naAddChildFirst);
1238 |
1239 | if not HasChildren then
1240 | begin
1241 | aNode.ImageIndex := 1;
1242 | aNode.SelectedIndex := 1;
1243 | end;
1244 |
1245 | Project.Modified := True;
1246 | end;
1247 |
1248 | procedure TfrmMain.miLevelUpClick(Sender: TObject);
1249 | var
1250 | aNode: TTreeNode;
1251 | begin
1252 | aNode := tvProjectTree.Selected.Parent;
1253 | if (not Assigned(aNode)) or (aNode = tvProjectTree.Items[0]) then
1254 | Exit;
1255 |
1256 | tvProjectTree.Selected.MoveTo(aNode, naInsert);
1257 |
1258 | if (not aNode.HasChildren) and (not tvProjectTree.Selected.HasChildren) then
1259 | begin
1260 | aNode.ImageIndex := tvProjectTree.Selected.ImageIndex;
1261 | aNode.SelectedIndex := tvProjectTree.Selected.SelectedIndex;
1262 | end;
1263 |
1264 | Project.Modified := True;
1265 | end;
1266 |
1267 | procedure TfrmMain.miMoveDownClick(Sender: TObject);
1268 | var
1269 | aNode, bNode: TTreeNode;
1270 | begin
1271 | aNode := tvProjectTree.Selected.getNextSibling;
1272 | if not Assigned(aNode) then
1273 | Exit;
1274 |
1275 | bNode := aNode.getNextSibling;
1276 | if Assigned(bNode) then
1277 | tvProjectTree.Selected.MoveTo(bNode, naInsert)
1278 | else
1279 | tvProjectTree.Selected.MoveTo(aNode, naAdd);
1280 |
1281 | Project.Modified := True;
1282 | end;
1283 |
1284 | procedure TfrmMain.miMoveUpClick(Sender: TObject);
1285 | var
1286 | aNode: TTreeNode;
1287 | begin
1288 | aNode := tvProjectTree.Selected.getPrevSibling;
1289 | if not Assigned(aNode) then
1290 | Exit;
1291 |
1292 | tvProjectTree.Selected.MoveTo(aNode, naInsert);
1293 | Project.Modified := True;
1294 | end;
1295 |
1296 | procedure TfrmMain.miPropertiesAddClick(Sender: TObject);
1297 | var
1298 | frmAddProperty: TfrmAddProperty;
1299 | slList: TStringList;
1300 | ProjectData: TProjectData;
1301 | begin
1302 | frmAddProperty := TfrmAddProperty.Create(Self);
1303 |
1304 | if frmAddProperty.ShowModal = mrOk then
1305 | begin
1306 | ProjectData := TProjectData(tvProjectTree.Selected.Data);
1307 |
1308 | case frmAddProperty.rgSection.ItemIndex of
1309 | 0: slList := ProjectData.slProject;
1310 | 1: slList := ProjectData.slContent;
1311 | else slList := ProjectData.slKeyWords;
1312 | end;
1313 |
1314 | slList.AddPair(Trim(frmAddProperty.edName.Text), Trim(frmAddProperty.edValue.Text));
1315 | sgProperties.RowCount := ProjectData.GetPropsCount + 1;
1316 | InitProjectData(ProjectData);
1317 | Project.Modified := True;
1318 | end;
1319 |
1320 | FreeAndNil(frmAddProperty);
1321 | end;
1322 |
1323 | procedure TfrmMain.miPropertiesDeleteClick(Sender: TObject);
1324 | var
1325 | value, aName: string;
1326 | ProjectData: TProjectData;
1327 | slList: TStringList;
1328 | begin
1329 | if not Assigned(Project) then
1330 | Exit;
1331 |
1332 | aName := sgProperties.Cells[0, sgProperties.Row];
1333 |
1334 | if MessageDlg('Remove "' + aName + '"?', mtConfirmation, mbYesNo, 0) = mrYes then
1335 | begin
1336 | ProjectData := TProjectData(tvProjectTree.Selected.Data);
1337 |
1338 | value := sgProperties.Cells[1, sgProperties.Row];
1339 |
1340 | slList := GetProjectDataList(aName);
1341 |
1342 | slList.Delete(slList.IndexOfName(aName));
1343 | sgProperties.RowCount := ProjectData.GetPropsCount + 1;
1344 | InitProjectData(ProjectData);
1345 | Project.Modified := True;
1346 | end;
1347 | end;
1348 |
1349 | procedure TfrmMain.miSymbolClick(Sender: TObject);
1350 | begin
1351 | AddHTMLTag('', False, '&' + StringReplace(TMenuItem(Sender).Caption, '&', '', []) + ';', '', '');
1352 | end;
1353 |
1354 | procedure TfrmMain.miTagClick(Sender: TObject);
1355 | var
1356 | tag: string;
1357 | begin
1358 | tag := StringReplace(TMenuItem(Sender).Caption, '&', '', []);
1359 | AddHTMLTag('', True, '<' + tag + '>', '', '');
1360 | end;
1361 |
1362 | procedure TfrmMain.miTagULClick(Sender: TObject);
1363 | var
1364 | aStart, anEnd: Integer;
1365 | XY: TBufferCoord;
1366 | txt: String;
1367 | begin
1368 | aStart := Min(seHTML.SelStart, seHTML.SelEnd);
1369 | anEnd := Max(seHTML.SelStart, seHTML.SelEnd);
1370 | txt := Copy(seHTML.Text, aStart + 1, anEnd - aStart);
1371 |
1372 | if txt <> '' then
1373 | seHTML.UndoList.AddChange(crDelete, seHTML.CharIndexToRowCol(aStart), seHTML.CharIndexToRowCol(anEnd), txt,
1374 | seHTML.ActiveSelectionMode);
1375 |
1376 | XY := seHTML.CaretXY;
1377 | seHTML.InsertLine(XY, XY, PWideChar(#13#10), True);
1378 | seHTML.InsertLine(XY, XY, PWideChar(#13#10), True);
1379 | seHTML.SetCaretAndSelection(XY, XY, XY);
1380 | seHTML.InsertBlock(XY, XY, PWideChar(''), True);
1381 | end;
1382 |
1383 | procedure TfrmMain.pmProjectTreePopup(Sender: TObject);
1384 | begin
1385 | miExpandAll.Visible := Assigned(Project) and (tvProjectTree.Selected = tvProjectTree.Items[0]);
1386 | miCollapseAll.Visible := miExpandAll.Visible;
1387 | end;
1388 |
1389 | procedure TfrmMain.pmPropertiesPopup(Sender: TObject);
1390 | begin
1391 | miPropertiesAdd.Enabled := Assigned(Project) and (tvProjectTree.Selected = tvProjectTree.Items[0]);
1392 | miPropertiesDelete.Enabled := miPropertiesAdd.Enabled;
1393 | end;
1394 |
1395 | procedure InitListBoolean(aList: TStrings);
1396 | begin
1397 | aList.Add('Yes');
1398 | aList.Add('No');
1399 | end;
1400 |
1401 | procedure TfrmMain.PropertiesEditBoolean;
1402 | var
1403 | value, aName: string;
1404 | slList: TStringList;
1405 | begin
1406 | value := sgProperties.Cells[1, sgProperties.Row];
1407 |
1408 | if InputList(sgProperties.Cells[0, sgProperties.Row], value, InitListBoolean, nil) then
1409 | begin
1410 | sgProperties.Cells[1, sgProperties.Row] := value;
1411 |
1412 | aName := sgProperties.Cells[0, sgProperties.Row];
1413 | slList := GetProjectDataList(aName);
1414 | slList.Values[aName] := value;
1415 |
1416 | Project.Modified := True;
1417 | end;
1418 | end;
1419 |
1420 | procedure TfrmMain.PropertiesEditDefaultTopic;
1421 | var
1422 | ProjectData: TProjectData;
1423 | begin
1424 | dlgOpenHTML.FileName := Project.PrjDir + sgProperties.Cells[1, sgProperties.Row];
1425 | if dlgOpenHTML.Execute then
1426 | begin
1427 | sgProperties.Cells[1, sgProperties.Row] := ExtractFileName(dlgOpenHTML.FileName);
1428 | ProjectData := TProjectData(tvProjectTree.Selected.Data);
1429 | ProjectData.slProject.Values[sgProperties.Cells[0, sgProperties.Row]] := sgProperties.Cells[1, sgProperties.Row];
1430 | Project.Modified := True;
1431 | end;
1432 | end;
1433 |
1434 | procedure TfrmMain.PropertiesEditFont;
1435 | var
1436 | FontName, aName, value: string;
1437 | FontSize, Charset, i: Integer;
1438 | slList: TStringList;
1439 | begin
1440 | FontName := '';
1441 | FontSize := 8;
1442 | Charset := 0;
1443 |
1444 | value := sgProperties.Cells[1, sgProperties.Row];
1445 | i := Pos(',', value);
1446 | if i > 0 then
1447 | begin
1448 | FontName := Copy(value, 1, i - 1);
1449 | Delete(value, 1, i);
1450 | end;
1451 | i := Pos(',', value);
1452 | if i > 0 then
1453 | try
1454 | FontSize := StrToInt(Trim(Copy(value, 1, i - 1)));
1455 | Delete(value, 1, i);
1456 | Charset := StrToInt(Trim(value));
1457 | except
1458 | end;
1459 |
1460 | if InputFont('Fonts', FontName, FontSize, Charset) then
1461 | begin
1462 | value := FontName + ',' + IntToStr(FontSize) + ',' + IntToStr(Charset);
1463 | sgProperties.Cells[1, sgProperties.Row] := value;
1464 |
1465 | aName := sgProperties.Cells[0, sgProperties.Row];
1466 | slList := GetProjectDataList(aName);
1467 | slList.Values[aName] := value;
1468 |
1469 | Project.Modified := True;
1470 | end;
1471 | end;
1472 |
1473 | procedure TfrmMain.PropertiesEditHex;
1474 | var
1475 | value, aName: string;
1476 | intValue: Integer;
1477 | slList: TStringList;
1478 | begin
1479 | value := StringReplace(sgProperties.Cells[1, sgProperties.Row], '0x', '$', [rfIgnoreCase]);
1480 | try
1481 | intValue := StrToInt(value);
1482 | except
1483 | intValue := 0;
1484 | end;
1485 |
1486 | if InputInteger(sgProperties.Cells[0, sgProperties.Row], intValue) then
1487 | begin
1488 | value := IntegerToHex(intValue);
1489 | sgProperties.Cells[1, sgProperties.Row] := value;
1490 |
1491 | aName := sgProperties.Cells[0, sgProperties.Row];
1492 | slList := GetProjectDataList(aName);
1493 | slList.Values[aName] := value;
1494 |
1495 | Project.Modified := True;
1496 | end;
1497 | end;
1498 |
1499 | procedure TfrmMain.PropertiesEditImageIndex;
1500 | var
1501 | value: string;
1502 | ImageIndex: Integer;
1503 | begin
1504 | value := sgProperties.Cells[1, sgProperties.Row];
1505 | try
1506 | ImageIndex := StrToInt(value);
1507 | except
1508 | ImageIndex := -1;
1509 | end;
1510 |
1511 | ImageIndex := GetImageIndex(ImageIndex);
1512 |
1513 | if ImageIndex > -1 then
1514 | begin
1515 | value := IntToStr(ImageIndex);
1516 | sgProperties.Cells[1, sgProperties.Row] := value;
1517 | SelectedObjectData.ImageIndex := value;
1518 | tvProjectTree.Selected.ImageIndex := ImageIndex;
1519 | tvProjectTree.Selected.SelectedIndex := ImageIndex;
1520 | Project.Modified := True;
1521 | end;
1522 | end;
1523 |
1524 | procedure InitListLanguage(aList: TStrings);
1525 | var
1526 | i: Integer;
1527 | S: string;
1528 | stringList: TStringList;
1529 | begin
1530 | for i := $401 to 65536 do
1531 | begin
1532 | S := GetLocaleName(i, LOCALE_SLOCALIZEDDISPLAYNAME);
1533 | if (S <> '') and (aList.IndexOf(S) < 0) then
1534 | aList.AddObject(S, Pointer(i));
1535 | end;
1536 |
1537 | stringList := TStringList.Create;
1538 | try
1539 | stringList.Assign(aList);
1540 | stringList.Sort;
1541 | aList.Assign(stringList);
1542 | finally
1543 | stringList.Free;
1544 | end;
1545 | end;
1546 |
1547 | var
1548 | iSelectedLangCode: Integer;
1549 |
1550 | procedure DestroyListLanguage(aList: TStrings; ItemIndex: Integer);
1551 | begin
1552 | if ItemIndex > -1 then
1553 | iSelectedLangCode := Integer(Pointer(aList.Objects[ItemIndex]));
1554 | end;
1555 |
1556 | procedure TfrmMain.PropertiesEditLanguage;
1557 | var
1558 | value, aName: string;
1559 | i: Integer;
1560 | slList: TStringList;
1561 | begin
1562 | value := Trim(sgProperties.Cells[1, sgProperties.Row]);
1563 |
1564 | i := Pos(' ', value);
1565 | if i > 0 then
1566 | begin
1567 | Delete(value, 1, i);
1568 | value := Trim(value);
1569 | end;
1570 | iSelectedLangCode := 0;
1571 |
1572 | if InputList(sgProperties.Cells[0, sgProperties.Row], value, InitListLanguage, DestroyListLanguage) then
1573 | begin
1574 | sgProperties.Cells[1, sgProperties.Row] := IntegerToHex(iSelectedLangCode) + ' ' + value;
1575 |
1576 | aName := sgProperties.Cells[0, sgProperties.Row];
1577 | slList := GetProjectDataList(aName);
1578 | slList.Values[aName] := sgProperties.Cells[1, sgProperties.Row];
1579 |
1580 | Project.Modified := True;
1581 | end;
1582 | end;
1583 |
1584 | procedure TfrmMain.PropertiesEditName;
1585 | var
1586 | value: string;
1587 | begin
1588 | value := sgProperties.Cells[1, sgProperties.Row];
1589 | if InputQuery(sgProperties.Cells[0, sgProperties.Row], 'Value', value) then
1590 | begin
1591 | sgProperties.Cells[1, sgProperties.Row] := value;
1592 | sgProperties.Cells[1, 0] := '[' + value + ']';
1593 | SelectedObjectData.Name := value;
1594 | tvProjectTree.Selected.Text := value;
1595 | Project.Modified := True;
1596 | end;
1597 | end;
1598 |
1599 | procedure TfrmMain.PropertiesEditRootName;
1600 | var
1601 | value, aName: string;
1602 | slList: TStringList;
1603 | begin
1604 | value := sgProperties.Cells[1, sgProperties.Row];
1605 |
1606 | if InputQuery(sgProperties.Cells[0, sgProperties.Row], 'Value', value) then
1607 | begin
1608 | sgProperties.Cells[1, sgProperties.Row] := value;
1609 |
1610 | aName := sgProperties.Cells[0, sgProperties.Row];
1611 | slList := GetProjectDataList(aName);
1612 | slList.Values[aName] := value;
1613 |
1614 | Project.Modified := True;
1615 | end;
1616 | end;
1617 |
1618 | procedure TfrmMain.PropertiesEditURL;
1619 | begin
1620 | dlgOpenHTML.FileName := Project.PrjDir + sgProperties.Cells[1, sgProperties.Row];
1621 |
1622 | if dlgOpenHTML.Execute then
1623 | begin
1624 | SelectedObjectData.URL := ExtractFileName(dlgOpenHTML.FileName);
1625 | wbBrowser.Navigate(Project.PrjDir + SelectedObjectData.URL, navNoHistory or navNoReadFromCache or navNoWriteToCache);
1626 | seHTML.Lines.LoadFromFile(Project.PrjDir + SelectedObjectData.URL);
1627 | sgProperties.Cells[1, sgProperties.Row] := SelectedObjectData.URL;
1628 | Project.Modified := True;
1629 | end;
1630 | end;
1631 |
1632 | procedure TfrmMain.SaveSettingsHHC(hhc: String);
1633 | var
1634 | reg: TRegIniFile;
1635 | begin
1636 | reg := TRegIniFile.Create;
1637 |
1638 | reg.RootKey := HKEY_CURRENT_USER;
1639 |
1640 | if reg.OpenKey('Software\CHMer', True) then
1641 | reg.WriteString('', 'HHC', hhc);
1642 |
1643 | reg.Free;
1644 | end;
1645 |
1646 | procedure TfrmMain.SelectTreeItemByUrl(URL: String);
1647 | var
1648 | iItem: Integer;
1649 | CHMData: TCHMData;
1650 | ObjectData: TObjectData;
1651 | begin
1652 | for iItem := 0 to tvProjectTree.Items.Count - 1 do
1653 | begin
1654 | CHMData := TCHMData(tvProjectTree.Items[iItem].Data);
1655 |
1656 | if CHMData is TProjectData then
1657 | Continue;
1658 |
1659 | ObjectData := TObjectData(CHMData);
1660 | if Pos(AnsiLowerCase(ObjectData.URL), AnsiLowerCase(URL)) > 0 then
1661 | begin
1662 | if tvProjectTree.Selected <> tvProjectTree.Items[iItem] then
1663 | tvProjectTree.Selected := tvProjectTree.Items[iItem];
1664 |
1665 | Exit;
1666 | end;
1667 | end;
1668 | end;
1669 |
1670 | procedure TfrmMain.sgPropertiesDblClick(Sender: TObject);
1671 | var
1672 | propertyName: string;
1673 | begin
1674 | if not Assigned(Project) then
1675 | Exit;
1676 |
1677 | propertyName := AnsiLowerCase(sgProperties.Cells[0, sgProperties.Row]);
1678 | if Assigned(SelectedObjectData) then
1679 | begin
1680 | if propertyName = 'local' then
1681 | PropertiesEditURL
1682 | else
1683 | if propertyName = 'imageindex' then
1684 | PropertiesEditImageIndex
1685 | else
1686 | if propertyName = 'name' then
1687 | PropertiesEditName
1688 | end
1689 | else
1690 | begin
1691 | if propertyName = 'default topic' then
1692 | PropertiesEditDefaultTopic
1693 | else
1694 | if (propertyName = 'default font') or (Pos(': font', propertyName) > 0) then
1695 | PropertiesEditFont
1696 | else
1697 | if (Pos('window styles', propertyName) > 0) or (Pos('exwindow styles', propertyName) > 0) then
1698 | PropertiesEditHex
1699 | else
1700 | if (propertyName = 'display compile progress') or (propertyName = 'full-text search') then
1701 | PropertiesEditBoolean
1702 | else
1703 | if propertyName = 'language' then
1704 | PropertiesEditLanguage
1705 | else
1706 | PropertiesEditRootName
1707 | end;
1708 | end;
1709 |
1710 | procedure TfrmMain.splVerticalRightMoved(Sender: TObject);
1711 | begin
1712 | lbKeywords.Left := splVerticalRight.Left + 5;
1713 | edFindText.Left := splVerticalRight.Left - 2 - edFindText.Width;
1714 | cmbFindType.Left := edFindText.Left - cmbFindType.Width - 2;
1715 | pcMainPages.Refresh;
1716 | end;
1717 |
1718 | procedure TfrmMain.tvProjectTreeChange(Sender: TObject; Node: TTreeNode);
1719 | var
1720 | ProjectData: TProjectData;
1721 | CHMData: TCHMData;
1722 | begin
1723 | if not Assigned(Project) then
1724 | Exit;
1725 |
1726 | if not Assigned(tvProjectTree.Selected) then
1727 | Exit;
1728 |
1729 | if actHTMLSave.Enabled and Assigned(SelectedObjectData) then
1730 | begin
1731 | if MessageDlg('Save "' + SelectedObjectData.URL + '"?', mtConfirmation, mbYesNo, 0) = mrYes then
1732 | actHTMLSave.Execute;
1733 | end;
1734 |
1735 | ProjectData := nil;
1736 | SelectedObjectData := nil;
1737 |
1738 | CHMData := TCHMData(tvProjectTree.Selected.Data);
1739 |
1740 | if CHMData is TProjectData then
1741 | ProjectData := TProjectData(CHMData)
1742 | else
1743 | SelectedObjectData := TObjectData(CHMData);
1744 |
1745 | sgProperties.RowCount := CHMData.GetPropsCount + 1;
1746 |
1747 | sgProperties.Cells[1, 0] := '[' + tvProjectTree.Selected.Text + ']';
1748 |
1749 | sgProperties.FixedRows := 1;
1750 | if not DoNotNavigate then
1751 | wbBrowser.Navigate('about:blank');
1752 |
1753 | seHTML.Lines.Clear;
1754 | memKeyWords.OnChange := nil;
1755 | memKeyWords.Lines.Clear;
1756 | memKeyWords.OnChange := memKeyWordsChange;
1757 |
1758 | seHTML.Modified := False;
1759 |
1760 | if CHMData is TProjectData then
1761 | begin
1762 | InitProjectData(ProjectData);
1763 | end
1764 | else
1765 | begin
1766 | sgProperties.Cells[0, 1] := 'Name';
1767 | sgProperties.Cells[1, 1] := SelectedObjectData.Name;
1768 |
1769 | sgProperties.Cells[0, 2] := 'Local';
1770 | sgProperties.Cells[1, 2] := SelectedObjectData.URL;
1771 |
1772 | sgProperties.Cells[0, 3] := 'ImageIndex';
1773 | sgProperties.Cells[1, 3] := SelectedObjectData.ImageIndex;
1774 |
1775 | DoNotNavigate := True;
1776 | wbBrowser.Navigate(Project.PrjDir + SelectedObjectData.URL, navNoHistory or navNoReadFromCache or navNoWriteToCache);
1777 |
1778 | seHTML.Lines.LoadFromFile(Project.PrjDir + SelectedObjectData.URL);
1779 | FileAge(Project.PrjDir + SelectedObjectData.URL, CurFileAge);
1780 |
1781 | memKeyWords.OnChange := nil;
1782 | memKeyWords.Lines.Text := SelectedObjectData.slKeyWords.Text;
1783 | memKeyWords.OnChange := memKeyWordsChange;
1784 | end;
1785 | end;
1786 |
1787 | procedure TfrmMain.tvProjectTreeDeletion(Sender: TObject; Node: TTreeNode);
1788 | begin
1789 | if Assigned(Node.Data) then
1790 | TCHMData(Node.Data).Free;
1791 | end;
1792 |
1793 | procedure TfrmMain.ValidateSrcHref;
1794 | var
1795 | ObjectData: TObjectData;
1796 | slHTML: TStringList;
1797 | rxRef: TRegEx;
1798 | i, j, k: Integer;
1799 | S, sRef: string;
1800 | matches: TMatchCollection;
1801 | begin
1802 | slHTML := TStringList.Create;
1803 | rxRef := TRegEx.Create('src="([^"]+)"|href="([^"]+)"');
1804 |
1805 | for i := 1 to tvProjectTree.Items.Count - 1 do
1806 | begin
1807 | ObjectData := TObjectData(tvProjectTree.Items[i].Data);
1808 |
1809 | if FileExists(Project.PrjDir + ObjectData.URL) then
1810 | begin
1811 | slHTML.LoadFromFile(Project.PrjDir + ObjectData.URL);
1812 |
1813 | for j := 0 to slHTML.Count - 1 do
1814 | slHTML[j] := AnsiLowerCase(Trim(slHTML[j]));
1815 |
1816 | S := StringReplace(slHTML.Text, #13#10, ' ', [rfReplaceAll]);
1817 | S := StringReplace(S, #13, ' ', [rfReplaceAll]);
1818 | S := StringReplace(S, #10, ' ', [rfReplaceAll]);
1819 | S := StringReplace(S, '''', '"', [rfReplaceAll]);
1820 |
1821 | while Pos(' ', S) > 0 do
1822 | S := StringReplace(S, ' ', ' ', [rfReplaceAll]);
1823 |
1824 | S := StringReplace(S, ' src =', ' src=', [rfReplaceAll]);
1825 | S := StringReplace(S, ' href =', ' href=', [rfReplaceAll]);
1826 | S := StringReplace(S, '= "', '="', [rfReplaceAll]);
1827 |
1828 | matches := rxRef.Matches(S);
1829 |
1830 | for j := 0 to matches.Count - 1 do
1831 | begin
1832 | sRef := matches[j].Value;
1833 | k := Pos('"', sRef);
1834 | Delete(sRef, 1, k);
1835 | SetLength(sRef, Length(sRef) - 1);
1836 |
1837 | if (Pos('://', sRef) > 0) or (Pos('mailto:', sRef) > 0) then
1838 | Continue;
1839 |
1840 | sRef := StringReplace(sRef, '/', '\', [rfReplaceAll]);
1841 |
1842 | k := Pos('#', sRef);
1843 | if k > 0 then
1844 | SetLength(sRef, k - 1);
1845 |
1846 | if not FileExists(Project.PrjDir + sRef) then
1847 | memInfo.Lines.Add(ObjectData.URL + ': missed file ' + sRef);
1848 | end;
1849 | end;
1850 | end;
1851 |
1852 | slHTML.Free;
1853 | end;
1854 |
1855 | procedure TfrmMain.ValidateNotUsedHTMLs;
1856 | var
1857 | slFiles, slFilesBackup: TStringList;
1858 | i, j: Integer;
1859 | ObjectData: TObjectData;
1860 | begin
1861 | if (not Assigned(Project)) or (Project.PrjDir = '') then
1862 | Exit;
1863 |
1864 | slFiles := GetFileList(Project.PrjDir, ['*.html', '*.htm']);
1865 | slFilesBackup := TStringList.Create;
1866 | slFilesBackup.Text := slFiles.Text;
1867 |
1868 | for i := 1 to tvProjectTree.Items.Count - 1 do
1869 | begin
1870 | ObjectData := TObjectData(tvProjectTree.Items[i].Data);
1871 | if ObjectData.URL <> '' then
1872 | begin
1873 | j := slFiles.IndexOf(Trim(ObjectData.URL));
1874 | if j < 0 then
1875 | begin
1876 | if slFilesBackup.IndexOf(Trim(ObjectData.URL)) > -1 then
1877 | memInfo.Lines.Add('File is used twice: ' + ObjectData.URL)
1878 | else
1879 | memInfo.Lines.Add('File not found: ' + ObjectData.URL);
1880 | end
1881 | else
1882 | slFiles.Delete(j);
1883 | end;
1884 | end;
1885 |
1886 | for i := 0 to slFiles.Count - 1 do
1887 | memInfo.Lines.Add('File not used: ' + slFiles[i]);
1888 |
1889 | slFiles.Free;
1890 | slFilesBackup.Free;
1891 | end;
1892 |
1893 | procedure TfrmMain.wbBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
1894 | Headers: OleVariant; var Cancel: WordBool);
1895 | var
1896 | FileName: String;
1897 | i: Integer;
1898 | begin
1899 | if (URL = 'about:blank') or (Copy(URL, 1, 6) = 'ftp://') or (Copy(URL, 1, 7) = 'http://') or (Copy(URL, 1, 8) = 'https://') then Exit;
1900 |
1901 | if DoNotNavigate then
1902 | begin
1903 | DoNotNavigate := False;
1904 | Exit;
1905 | end;
1906 |
1907 | FileName := StringReplace(URL, 'file:///', '', [rfIgnoreCase]);
1908 | FileName := StringReplace(FileName, '/', '\', [rfReplaceAll]);
1909 | FileName := StringReplace(FileName, '%20', ' ', [rfReplaceAll]); // I think we need to go deeper, but where?
1910 |
1911 | i := Pos('#', FileName);
1912 | if i > 0 then SetLength(FileName, i - 1);
1913 |
1914 | if FileExists(FileName) then
1915 | try
1916 | DoNotNavigate := True;
1917 | SelectTreeItemByUrl(FileName);
1918 | finally
1919 | DoNotNavigate := False;
1920 | end;
1921 | end;
1922 |
1923 | end.
1924 |
1925 |
--------------------------------------------------------------------------------
/uSelectImage.dfm:
--------------------------------------------------------------------------------
1 | object frmSelectImage: TfrmSelectImage
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Select image'
6 | ClientHeight = 345
7 | ClientWidth = 542
8 | Color = clBtnFace
9 | DoubleBuffered = True
10 | Font.Charset = DEFAULT_CHARSET
11 | Font.Color = clWindowText
12 | Font.Height = -11
13 | Font.Name = 'Tahoma'
14 | Font.Style = []
15 | OldCreateOrder = False
16 | Position = poScreenCenter
17 | OnCreate = FormCreate
18 | DesignSize = (
19 | 542
20 | 345)
21 | PixelsPerInch = 96
22 | TextHeight = 13
23 | object lvIcons: TListView
24 | Left = 0
25 | Top = 0
26 | Width = 542
27 | Height = 302
28 | Align = alTop
29 | Columns = <>
30 | LargeImages = frmMain.ilHelp
31 | TabOrder = 0
32 | OnDblClick = lvIconsDblClick
33 | end
34 | object btnOK: TButton
35 | Left = 378
36 | Top = 312
37 | Width = 75
38 | Height = 25
39 | Anchors = [akRight, akBottom]
40 | Caption = 'OK'
41 | Default = True
42 | ModalResult = 1
43 | TabOrder = 1
44 | end
45 | object btnCancel: TButton
46 | Left = 459
47 | Top = 312
48 | Width = 75
49 | Height = 25
50 | Anchors = [akRight, akBottom]
51 | Cancel = True
52 | Caption = 'Cancel'
53 | ModalResult = 2
54 | TabOrder = 2
55 | end
56 | end
57 |
--------------------------------------------------------------------------------
/uSelectImage.pas:
--------------------------------------------------------------------------------
1 | unit uSelectImage;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, uMain;
8 |
9 | type
10 | TfrmSelectImage = class(TForm)
11 | lvIcons: TListView;
12 | btnOK: TButton;
13 | btnCancel: TButton;
14 | procedure FormCreate(Sender: TObject);
15 | procedure lvIconsDblClick(Sender: TObject);
16 | private
17 | { Private declarations }
18 | public
19 | { Public declarations }
20 | end;
21 |
22 | function GetImageIndex(ImageIndex: Integer): Integer;
23 |
24 | implementation
25 |
26 | {$R *.dfm}
27 |
28 | function GetImageIndex(ImageIndex: Integer): Integer;
29 | var
30 | frmSelectImage: TfrmSelectImage;
31 | begin
32 | Result := -1;
33 |
34 | frmSelectImage := TfrmSelectImage.Create(frmMain);
35 |
36 | if ImageIndex > -1 then
37 | frmSelectImage.lvIcons.Selected := frmSelectImage.lvIcons.Items[ImageIndex];
38 |
39 | if frmSelectImage.ShowModal = mrOk then
40 | Result := frmSelectImage.lvIcons.Items.IndexOf(frmSelectImage.lvIcons.Selected);
41 |
42 | FreeAndNil(frmSelectImage);
43 | end;
44 |
45 |
46 | procedure TfrmSelectImage.FormCreate(Sender: TObject);
47 | var
48 | i: Integer;
49 | Item: TListItem;
50 | begin
51 | for i := 0 to 42 do
52 | begin
53 | Item := lvIcons.Items.Add;
54 | Item.Caption := IntToStr(i);
55 | Item.ImageIndex := i;
56 | end;
57 | end;
58 |
59 | procedure TfrmSelectImage.lvIconsDblClick(Sender: TObject);
60 | begin
61 | ModalResult := mrOk;
62 | end;
63 |
64 | end.
65 |
--------------------------------------------------------------------------------
/uSettings.dfm:
--------------------------------------------------------------------------------
1 | object frmSettings: TfrmSettings
2 | Left = 0
3 | Top = 0
4 | BorderStyle = bsDialog
5 | Caption = 'Settings'
6 | ClientHeight = 145
7 | ClientWidth = 426
8 | Color = clBtnFace
9 | DoubleBuffered = True
10 | Font.Charset = DEFAULT_CHARSET
11 | Font.Color = clWindowText
12 | Font.Height = -11
13 | Font.Name = 'Tahoma'
14 | Font.Style = []
15 | OldCreateOrder = False
16 | Position = poScreenCenter
17 | DesignSize = (
18 | 426
19 | 145)
20 | PixelsPerInch = 96
21 | TextHeight = 13
22 | object Label1: TLabel
23 | Left = 8
24 | Top = 11
25 | Width = 68
26 | Height = 13
27 | Caption = 'HHC.exe path'
28 | end
29 | object Label2: TLabel
30 | Left = 8
31 | Top = 38
32 | Width = 53
33 | Height = 13
34 | Caption = 'Editor path'
35 | end
36 | object Label3: TLabel
37 | Left = 8
38 | Top = 88
39 | Width = 39
40 | Height = 13
41 | Caption = 'Tab size'
42 | end
43 | object edHHC: TFilenameEdit
44 | Left = 82
45 | Top = 8
46 | Width = 336
47 | Height = 21
48 | Filter = 'HHC.exe (hhc.exe)|hhc.exe'
49 | Anchors = [akLeft, akTop, akRight]
50 | NumGlyphs = 1
51 | TabOrder = 0
52 | Text = ''
53 | end
54 | object chbAddContents: TCheckBox
55 | Left = 8
56 | Top = 62
57 | Width = 246
58 | Height = 17
59 | Caption = 'Add names from the content tree to keywords'
60 | TabOrder = 2
61 | end
62 | object btnOK: TButton
63 | Left = 262
64 | Top = 112
65 | Width = 75
66 | Height = 25
67 | Anchors = [akRight, akBottom]
68 | Caption = 'OK'
69 | Default = True
70 | ModalResult = 1
71 | TabOrder = 5
72 | ExplicitTop = 90
73 | end
74 | object btnCancel: TButton
75 | Left = 343
76 | Top = 112
77 | Width = 75
78 | Height = 25
79 | Anchors = [akRight, akBottom]
80 | Cancel = True
81 | Caption = 'Cancel'
82 | ModalResult = 2
83 | TabOrder = 6
84 | ExplicitTop = 90
85 | end
86 | object chbAddIfEmpty: TCheckBox
87 | Left = 253
88 | Top = 62
89 | Width = 172
90 | Height = 17
91 | Caption = 'only if the keywords are empty'
92 | TabOrder = 3
93 | end
94 | object edEditor: TFilenameEdit
95 | Left = 82
96 | Top = 35
97 | Width = 336
98 | Height = 21
99 | Filter = 'Executables (*.exe)|*.exe'
100 | Anchors = [akLeft, akTop, akRight]
101 | NumGlyphs = 1
102 | TabOrder = 1
103 | Text = ''
104 | end
105 | object edTabSize: TSpinEdit
106 | Left = 82
107 | Top = 85
108 | Width = 63
109 | Height = 22
110 | MaxValue = 10
111 | MinValue = 1
112 | TabOrder = 4
113 | Value = 2
114 | end
115 | end
116 |
--------------------------------------------------------------------------------
/uSettings.pas:
--------------------------------------------------------------------------------
1 | unit uSettings;
2 |
3 | interface
4 |
5 | uses
6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Mask, RxToolEdit, Vcl.StdCtrls, Vcl.Samples.Spin;
8 |
9 | type
10 | TfrmSettings = class(TForm)
11 | Label1: TLabel;
12 | edHHC: TFilenameEdit;
13 | chbAddContents: TCheckBox;
14 | btnOK: TButton;
15 | btnCancel: TButton;
16 | chbAddIfEmpty: TCheckBox;
17 | edEditor: TFilenameEdit;
18 | Label2: TLabel;
19 | edTabSize: TSpinEdit;
20 | Label3: TLabel;
21 | private
22 | { Private declarations }
23 | public
24 | { Public declarations }
25 | end;
26 |
27 | implementation
28 |
29 | {$R *.dfm}
30 |
31 | end.
32 |
--------------------------------------------------------------------------------