This repository has been archived by the owner on Feb 26, 2023. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathDMBGlobals.bas
3586 lines (2947 loc) · 133 KB
/
DMBGlobals.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Attribute VB_Name = "DMBGlobals"
Option Explicit
Global USER As String
Global COMPANY As String
Global DMBPSN As String
Global USERSN As String
Global ORDERNUMBER As String
Global DoSilentValidation As Boolean
Global Const CacheSignature = 1122
Global ResellerID As String
Global ResellerInfo() As String
Global InitDone As Boolean
Global IsDebug As Boolean
Global IsTBMapSel As Boolean
Global frmErrDlgIsVisible As Boolean
Global Const SupportedImageFiles = "Supported Image Files (*.jpg;*.gif;*.png)|*.jpg;*.gif;*.png;|All Files (*.*)|*.*"
Global Const SupportedCursorFiles = "Supported Cursor Files (*.cur;*.csr;*.ani)|*.cur;*.csr;*.ani|All Files (*.*)|*.*"
Global Const SupportedImageFilesFlash = "Supported Image Files (*.jpg;*.gif;*.png)|*.jpg;*.gif;*.png;|Macromedia Flash Movies (*.swf)|*.swf|All Files (*.*)|*.*"
Global Const SupportedHTMLDocs = "HTML Documents (*.htm;*.html;*.asp;*.aspx;*.ascx;*.php;*.php3;*.shtml;*.jsp;*.dwt;*.cfm;*.master)|*.htm;*.html;*.asp;*.aspx;*.ascx;*.php;*.php3;*.shtml;*.dwt;*.cfm;*.master|All Files (*.*)|*.*"
Global Const SupportedCSSDocs = "HyperText StyleSheets (*.css)|*.css|All Files (*.*)|*.*"
Global Const SupportedImportDocs = "hierMenus 4 (HM_Arrays.js)|HM_Arrays.js|hierMenus (hierArrays.js)|hierArrays.js|AllWebMenus (*.awm)|*.awm|All Files (*.*)|*.*"
Global Const SupportedAudioFiles = "Wav Files (*.wav)|*.wav|All Files (*.*)|*.*"
Public TemplateCommand As MenuCmd
Public TemplateGroup As MenuGrp
Public dmbClipboard As ClipboardDef
Public FramesInfo As FramesInfoDef
Public Sections() As Section
Public LocalizedStr() As String
Public engLocalizedStr() As String
Public NullFont As tFont
Public InMapMode As Boolean
Public DontRefreshMap As Boolean
Public KeepExpansions As Boolean
Public LastSelNode As String
Public SelSecProjects() As String
Public SelSecProjectsTitles() As String
Public Enum SecProjModeConstants
spmcFromInstallMenus = 0
spmcFromStdDlg = 1
spmcUndefined = 999
End Enum
Public SecProjMode As SecProjModeConstants
Public Enum LinkVerifyModeConstants
spmcManual = 0
spmcAuto = 1
End Enum
Public LinkVerifyMode As LinkVerifyModeConstants
Public Enum ProjectPropertiesPageConstants
pppcGeneral = 0
pppcConfig = 1
pppcGlobal = 2
pppcAdvanced = 3
End Enum
Public ProjectPropertiesPage As ProjectPropertiesPageConstants
Public Enum TBEPageConstants
tbepcGeneral = 0
tbepcAppearance = 1
tbepcPositioning = 2
tbepcEffects = 3
tbepcAdvanced = 4
End Enum
Public TBEPage As TBEPageConstants
Public Going2Upgrade As Boolean
Public dlFileName As String
Public AutoHotSpot As Boolean
Public SelColor As Long
Public SelColor_CanBeTransparent As Boolean
Public UsedColors() As Long
Public SimonFile As String
Public cSep As String
Public ff As Integer
Public HSCanceled As Boolean
Public SelImgName As String
Public AbortCompileDlg As Boolean
Public ImportProjectFileName As String
Public ppSelConfig As Integer
Public IsReplacing As Boolean
Public PreviewIsOn As Boolean
Public MenusFrame As Integer
Public NagScreenIsVisible As Boolean
Public IsFPAddIn As Boolean
Public curOffsetStr As String
Public nwdPar As String
#If ISCOMP = 0 Then
Public TipsSys As CTips
Public wbLivePreview As WebBrowser
Public LivePreviewCharset As String
#End If
Public Enum PreviewModeConstants
pmcNormal = 0
pmcSitemap = 1
End Enum
Public PreviewMode As PreviewModeConstants
Public Type SelImageDef
Picture As IPictureDisp
FileName As String
IsResource As Boolean
IsValid As Boolean
SupportsFlash As Boolean
LimitToCursors As Boolean
End Type
Public SelImage As SelImageDef
Public Type UndoState
FileName As String
Description As String
End Type
Public UndoStates() As UndoState
Public CurState As Integer
Public Enum SelRedoUndoConstants
[sUndo]
[sRedo]
[sCancel]
End Enum
Public SelRedoUndo As SelRedoUndoConstants
Public SelRedoUndoCount As Integer
Public Type SelFontDef
Name As String
Italic As Boolean
Bold As Boolean
Underline As Boolean
Size As Integer
IsValid As Boolean
IsSubst As Boolean
Shadow As tFontShadow
End Type
Public SelFont As SelFontDef
Private OriginalConfig As Integer
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const LVM_FIRST = &H1000
Public Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55
Public Const LVS_EX_FULLROWSELECT = &H20
Public Const LVSCW_AUTOSIZE = -1
Public Const LVSCW_AUTOSIZE_USEHEADER = -2
Public Const LVM_SETCOLUMNWIDTH As Long = &H101E
Public Const HDS_BUTTONS = &H2
Public Const LVM_GETHEADER = (LVM_FIRST + 31)
Public Const GWL_STYLE = (-16)
Public Const CB_GETLBTEXTLEN = &H149
Public Const CB_SHOWDROPDOWN = &H14F
Public Const CB_GETDROPPEDWIDTH = &H15F
Public Const CB_SETDROPPEDWIDTH = &H160
Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
bottom As Long
End Type
Public Const BDR_INNER = &HC
Public Const BDR_OUTER = &H3
Public Const BDR_RAISED = &H5
Public Const BDR_RAISEDINNER = &H4
Public Const BDR_RAISEDOUTER = &H1
Public Const BDR_SUNKEN = &HA
Public Const BDR_SUNKENINNER = &H8
Public Const BDR_SUNKENOUTER = &H2
Public Const BF_ADJUST = &H2000 ' Calculate the space left over.
Public Const BF_BOTTOM = &H8
Public Const BF_LEFT = &H1
Public Const BF_RIGHT = &H4
Public Const BF_TOP = &H2
Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Public Const BF_DIAGONAL = &H10
Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Public Const BF_FLAT = &H4000 ' For flat rather than 3-D borders.
Public Const BF_MIDDLE = &H800 ' Fill in the middle.
Public Const BF_MONO = &H8000 ' For monochrome borders.
Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Public Const BF_SOFT = &H1000 ' Use for softer buttons.
Public Declare Function DrawEdge Lib "user32" (ByVal hDc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
'Private Type MIMECPINFO
' dwFlags As Long
' uiCodePage As Integer
' uiFamilyCodePage As Integer
' wszDescription As String * 255
' wszWebCharSet As String * 255
' wszHeaderCharset As String * 255
' wszBodyCharset As String * 255
' wszFixedWidthFont As String * 255
' wszProportionalFonts As String * 255
'End Type
Private Declare Function LcidToRfc1766 Lib "mlang.dll" Alias "LcidToRfc1766A" (ByVal uiCodePage As Long, ByRef pszRfc1766 As String, ByRef nChar As Integer) As Long
Public Type CodePagesDef
CodePage As String
WebCharset As String
Description As String
End Type
Public cs() As CodePagesDef
#If STANDALONE = 0 Then
Public ftpUserName As String
Public ftpPassword As String
Public Function GetAppTypeName() As String
Select Case GetAppType
Case "DEV"
GetAppTypeName = "<developers' edition>"
Case "STD"
GetAppTypeName = "Standard Edition"
Case "LIT"
GetAppTypeName = "LITE"
End Select
End Function
Public Function GetAppType() As String
#If LITE = 0 Then
#If DEVVER = 1 Then
GetAppType = "DEV"
#Else
GetAppType = "STD"
#End If
#Else
GetAppType = "LIT"
#End If
End Function
#If ISCOMP = 0 Then
Public Sub LoadUnicodeTool()
On Error Resume Next
RunShellExecute "open", "dmbUnicodeCaption.exe", "", Long2Short(AppPath), 1
End Sub
Public Sub PopulateBorderStyleCombo(cmb As ComboBox)
With cmb
.Clear
.AddItem GetLocalizedStr(110)
.AddItem GetLocalizedStr(430)
.AddItem GetLocalizedStr(431)
.AddItem GetLocalizedStr(670)
.AddItem GetLocalizedStr(671)
.AddItem "Dotted"
.AddItem "Dashed"
End With
End Sub
Public Function GetSysCharsets() As CodePagesDef()
Dim i As Long
Dim j As Long
Dim CodePage As String
Dim WebCharset As String
Dim Desc As String
Static cs() As CodePagesDef
Dim tmp As CodePagesDef
On Error Resume Next
ReDim cs(0)
i = 0
Do
CodePage = EnumSubKeys(HKEY_CLASSES_ROOT, "MIME\Database\Codepage", i)
If LenB(CodePage) <> 0 Then
WebCharset = QueryValue(HKEY_CLASSES_ROOT, "MIME\Database\Codepage\" + CodePage, "WebCharset")
If LenB(WebCharset) = 0 Then
WebCharset = QueryValue(HKEY_CLASSES_ROOT, "MIME\Database\Codepage\" + CodePage, "BodyCharset")
Desc = QueryValue(HKEY_CLASSES_ROOT, "MIME\Database\Codepage\" + CodePage, "Description")
Else
Desc = QueryValue(HKEY_CLASSES_ROOT, "MIME\Database\Codepage\" + CodePage, "Description")
End If
If InStr(Desc, "@") > 0 Then
' We must be under Vista...
Desc = String(255, vbNullChar)
Dim n As Integer
If LcidToRfc1766(CLng(CodePage), Desc, n) = 0 Then
Desc = Mid(Desc, 1, n)
Else
Desc = WebCharset
End If
End If
If LenB(WebCharset) <> 0 Then
ReDim Preserve cs(UBound(cs) + 1)
With cs(UBound(cs))
.CodePage = CodePage
.Description = Desc
.WebCharset = WebCharset
End With
End If
i = i + 1
Else
Exit Do
End If
Loop
For i = 1 To UBound(cs)
For j = 1 To UBound(cs)
If cs(j).Description > cs(i).Description Then
tmp = cs(j)
cs(j) = cs(i)
cs(i) = tmp
End If
Next j
Next i
GetSysCharsets = cs
End Function
#End If
Public Function strGetSupportedHTMLDocs() As String
strGetSupportedHTMLDocs = Split(Replace(UCase(SupportedHTMLDocs), "*.", vbNullString), "|")(1)
End Function
Public Function Hex2Dec(h As String) As Long
On Error Resume Next
If LenB(h) = 0 Then h = 0
Hex2Dec = CLng("&H" & h)
End Function
Public Function SaveProject(IsState As Boolean) As Boolean
Dim i As Integer
Dim ff As Integer
Dim sStr As String
Dim k As Integer
Dim c As Integer
Dim g As Integer
Dim t As Integer
On Error GoTo ReportError
If Not IsState Then
If LCase(GetFileExtension(Project.FileName)) <> "dmb" Then
Project.FileName = GetFilePath(Project.FileName) + GetFileName(Project.FileName, True) + ".dmb"
End If
If Not RemoveReadOnly(Project.FileName) Then
MsgBox "The project could not be saved because its marked Read Only", vbCritical + vbOKOnly, "Error Saving Project"
SaveProject = False
Exit Function
End If
End If
ff = FreeFile
Open Project.FileName For Output As ff
With Project
sStr = .Name + _
cSep & Abs(.SEOTweak) & _
cSep & .UserConfigs(0).CompiledPath & _
cSep & .UserConfigs(0).HotSpotEditor.HotSpotsFile & _
cSep & .FX & _
cSep & .NodeExpStatus & _
cSep & .ToolBar.BorderColor & _
cSep & .CodeOptimization & _
cSep & Abs(.UserConfigs(0).HotSpotEditor.MakeBackup) & _
cSep & GetCurProjectVersion & _
cSep & Abs(.UserConfigs(0).Frames.UseFrames) & _
cSep & .AddIn.Name & _
cSep & .UserConfigs(0).Frames.FramesFile & _
cSep & .UserConfigs(0).RootWeb & _
cSep & .SelChangeDelay & _
cSep & GenExpHTMLString & _
cSep & 0 & cSep & 0 & cSep & 0 & _
cSep & 0 & cSep & 0 & cSep & 0 & _
cSep & 0 & cSep & 0 & cSep & 0 & _
cSep & 0 & cSep & 0 & cSep & 0 & _
cSep & 0
'sStr = sStr + _
cSep & .FTP.FTPAddress & _
cSep & .FTP.UserName & _
cSep & "" & _
cSep & .FTP.ProxyAddress & _
cSep & .FTP.ProxyPort & _
cSep & .FTP.RemoteInfo4FTP & _
cSep & .UserConfigs(0).ImagesPath & _
cSep & .JSFileName & _
cSep & UBound(.UserConfigs) & _
cSep & .DefaultConfig
sStr = sStr + _
cSep & .UserConfigs(0).FTP & _
cSep & vbNullString & _
cSep & Abs(.UseGZIP) & _
cSep & .BlinkSpeed & _
cSep & .BlinkEffect & _
cSep & .CustomOffsets & _
cSep & .UserConfigs(0).ImagesPath & _
cSep & .JSFileName & _
cSep & UBound(.UserConfigs) & _
cSep & .DefaultConfig
For i = 1 To UBound(.UserConfigs)
With .UserConfigs(i)
sStr = sStr + _
cSep & .Name & _
cSep & .Description & _
cSep & .CompiledPath & _
cSep & .Type & _
cSep & .RootWeb & _
cSep & .ImagesPath & _
cSep & Abs(.OptmizePaths) & _
cSep & .FTP & _
cSep & .Frames.FramesFile & _
cSep & vbNullString & _
cSep & Abs(.Frames.UseFrames) & _
cSep & .HotSpotEditor.HotSpotsFile & _
cSep & Abs(.HotSpotEditor.MakeBackup) & _
cSep & .LocalInfo4RemoteConfig
End With
Next i
sStr = sStr & cSep & .UnfoldingSound.onmouseover
sStr = sStr & cSep & .MenusOffset.RootMenusX
sStr = sStr & cSep & .MenusOffset.RootMenusY
sStr = sStr & cSep & .MenusOffset.SubMenusX
sStr = sStr & cSep & .MenusOffset.SubMenusY
sStr = sStr & cSep & Abs(.LotusDominoSupport)
#If DEVVER = 1 Then
sStr = sStr & cSep & Abs(.GenDynAPI)
#Else
sStr = sStr & cSep & 0
#End If
sStr = sStr & cSep & Abs(.CompileIECode)
sStr = sStr & cSep & Abs(.CompileNSCode)
sStr = sStr & cSep & Abs(.CompilehRefFile)
sStr = sStr & cSep & Join(.SecondaryProjects, "|")
sStr = sStr & cSep & .FontSubstitutions
sStr = sStr & cSep & Abs(.DoFormsTweak)
sStr = sStr & cSep & .StatusTextDisplay
sStr = sStr & cSep & Abs(.KeyboardSupport)
sStr = sStr & cSep & Abs(.RemoveImageAutoPosCode)
sStr = sStr & cSep & .RootMenusDelay
sStr = sStr & cSep & .AnimSpeed
sStr = sStr & cSep & .HideDelay
sStr = sStr & cSep & .SubMenusDelay
sStr = sStr & cSep & Abs(.DWSupport)
sStr = sStr & cSep & Abs(.NS4ClipBug)
sStr = sStr & cSep & ctcCDROM
sStr = sStr & cSep & Abs(.AutoSelFunction)
sStr = sStr & cSep & Abs(.ImageReadySupport)
sStr = sStr & cSep & .DXFilter
With .AutoScroll
sStr = sStr + cSep & .maxHeight
sStr = sStr + cSep & .nColor
sStr = sStr + cSep & .hColor
sStr = sStr + cSep & .DnImage.NormalImage
sStr = sStr + cSep & .DnImage.HoverImage
sStr = sStr + cSep & .DnImage.w
sStr = sStr + cSep & .DnImage.h
sStr = sStr + cSep & .UpImage.NormalImage
sStr = sStr + cSep & .UpImage.HoverImage
sStr = sStr + cSep & .margin
sStr = sStr + cSep & Abs(.onmouseover)
sStr = sStr + cSep & .FXhColor
sStr = sStr + cSep & .FXnColor
sStr = sStr + cSep & .FXNormal
sStr = sStr + cSep & .FXOver
sStr = sStr + cSep & .FXSize
End With
For i = 1 To 50 - 16
sStr = sStr & cSep & vbNullString
Next i
sStr = sStr & cSep & Abs(UBound(Project.Toolbars))
For i = 1 To UBound(.Toolbars)
With .Toolbars(i)
sStr = sStr & cSep & .Alignment
sStr = sStr & cSep & .BackColor
sStr = sStr & cSep & .bOrder
sStr = sStr & cSep & .BorderColor
sStr = sStr & cSep & .ContentsMarginH
sStr = sStr & cSep & .ContentsMarginV
sStr = sStr & cSep & .CustX
sStr = sStr & cSep & .CustY
sStr = sStr & cSep & Abs(.FollowHScroll)
If .FollowVScroll = False And .SmartScrolling = False Then sStr = sStr & cSep & 0
If .FollowVScroll = True And .SmartScrolling = False Then sStr = sStr & cSep & 1
If .FollowVScroll = True And .SmartScrolling = True Then sStr = sStr & cSep & 2
If .FollowVScroll = False And .SmartScrolling = True Then sStr = sStr & cSep & 3
sStr = sStr & cSep & Join(.Groups, "|")
sStr = sStr & cSep & .Height
sStr = sStr & cSep & .Image
sStr = sStr & cSep & Abs(.JustifyHotSpots)
sStr = sStr & cSep & .OffsetH
sStr = sStr & cSep & .OffsetV
sStr = sStr & cSep & .Name
sStr = sStr & cSep & .Separation
sStr = sStr & cSep & .Spanning
sStr = sStr & cSep & .Style
sStr = sStr & cSep & .Width
sStr = sStr & cSep & .AttachTo + "|" & .AttachToAlignment
sStr = sStr & cSep & .Condition
sStr = sStr & cSep & .BorderStyle
sStr = sStr & cSep & .DropShadowColor
sStr = sStr & cSep & .DropShadowSize
sStr = sStr & cSep & .Transparency
sStr = sStr & cSep & Abs(.IsTemplate)
sStr = sStr & cSep & Abs(.AttachToAutoResize)
sStr = sStr & cSep & Abs(.Compile)
sStr = sStr & cSep & .Radius.TopLeft
sStr = sStr & cSep & .Radius.TopRight
sStr = sStr & cSep & .Radius.BottomLeft
sStr = sStr & cSep & .Radius.BottomRight
End With
Next i
Print #ff, sStr
End With
t = UBound(MenuGrps) + UBound(MenuCmds)
For g = 1 To UBound(MenuGrps)
If Not IsState Then
k = k + 1: FloodPanel.Value = k / t * 100
End If
Print #ff, "[G]" + GetGrpParams(MenuGrps(g))
For c = 1 To UBound(MenuCmds)
With MenuCmds(c)
If .parent = g Then
If Not IsState Then
k = k + 1: FloodPanel.Value = k / t * 100
End If
Print #ff, "[C] " + GetCmdParams(MenuCmds(c))
End If
End With
Next c
Next g
SaveProject = True
ExitSub:
Close #ff
FloodPanel.Value = 0
Exit Function
ReportError:
SaveProject = False
MsgBox "An error has occured while saving the project" + vbCrLf + "Error (" & Err.number & "): " & Err.Description, vbCritical + vbOKOnly, "Error Saving Project"
GoTo ExitSub
End Function
Public Function SubMenuOf(g As Integer) As Integer
Dim i As Integer
For i = 1 To UBound(MenuCmds)
With MenuCmds(i).Actions
If .onclick.Type = atcCascade And .onclick.TargetMenu = g Then
SubMenuOf = i
Exit Function
End If
If .onmouseover.Type = atcCascade And .onmouseover.TargetMenu = g Then
SubMenuOf = i
Exit Function
End If
If .OnDoubleClick.Type = atcCascade And .OnDoubleClick.TargetMenu = g Then
SubMenuOf = i
Exit Function
End If
End With
Next i
End Function
Public Function GenExpHTMLPref(c As String, ProjectName As String, ProjectFileName As String) As ExportHTMLDef
Dim p() As String
On Error Resume Next
If InStr(c, "|") Then
p = Split(c, "|")
With GenExpHTMLPref
.CollapsedImage = p(0)
.CommandClass = p(1)
.CreateTree = -Val(p(2))
.CSSFile = p(3)
.Description = p(4)
.ExpandedImage = p(5)
.GroupClass = p(6)
.HTMLFileName = p(7)
.IconHeight = Val(p(8))
.IconWidth = Val(p(9))
.Identation = Val(p(10))
.ImagesPath = p(11)
.NormalImage = p(12)
.Style = Val(p(13))
.Title = p(14)
.ExpItemsHaveLinks = -Val(p(15))
.SingleSelect = -Val(p(16))
.IncludeExpCol = -Val(p(17))
.ExpAllStr = p(18)
.ColAllStr = p(19)
.ExpColPlacement = p(20)
If UBound(p) > 20 Then
.XHTMLCompliant = -Val(p(21))
End If
End With
Else
With GenExpHTMLPref
.CollapsedImage = AppPath + "exhtml\c.gif"
.CommandClass = vbNullString
.CreateTree = False
.CSSFile = vbNullString
#If ISCOMP = 0 Or STANDALONE = 1 Then
.Description = "<small>DHTML Menu Builder " + DMBVersion + "</small>"
#Else
.Description = "<small>DHTML Menu Builder Wizard</small>"
#End If
.ExpandedImage = AppPath + "exhtml\o.gif"
.GroupClass = vbNullString
.HTMLFileName = GetFilePath(ProjectFileName) + GetFileName(ProjectFileName) + ".htm"
.IconHeight = 16
.IconWidth = 16
.Identation = 20
.ImagesPath = "%%PROJECT%%"
.NormalImage = AppPath + "exhtml\s.gif"
.Style = ascProject
.Title = ProjectName
.ExpItemsHaveLinks = False
.SingleSelect = False
.IncludeExpCol = False
.ExpAllStr = "Expand All"
.ColAllStr = "Collapse All"
.ExpColPlacement = ecpcBottom
.XHTMLCompliant = False
End With
End If
End Function
Private Function GenExpHTMLString() As String
With Project.ExportHTMLParams
GenExpHTMLString = .CollapsedImage & "|" & _
.CommandClass & "|" & _
Abs(.CreateTree) & "|" & _
.CSSFile & "|" & _
.Description & "|" & _
.ExpandedImage & "|" & _
.GroupClass & "|" & _
.HTMLFileName & "|" & _
.IconHeight & "|" & _
.IconWidth & "|" & _
.Identation & "|" & _
.ImagesPath & "|" & _
.NormalImage & "|" & _
.Style & "|" & _
.Title & "|" & _
Abs(.ExpItemsHaveLinks) & "|" & _
Abs(.SingleSelect) & "|" & _
Abs(.IncludeExpCol) & "|" & _
.ExpAllStr & "|" & _
.ColAllStr & "|" & _
.ExpColPlacement & "|" & _
Abs(.XHTMLCompliant)
End With
End Function
#End If
Public Function AddTrailingSlash(ByVal Path As String, Slash As String) As String
If Right$(Path, 1) <> Slash And LenB(Path) <> 0 Then Path = Path + Slash
AddTrailingSlash = Path
End Function
Public Function GetTEMPPath() As String
Dim TempPath As String
TempPath = Environ("TEMP")
If LenB(TempPath) = 0 Then TempPath = Environ("TMP")
If LenB(TempPath) = 0 Then TempPath = AppPath
If InStr(TempPath, ";") > 0 Then TempPath = Split(TempPath, ";")(0)
TempPath = AddTrailingSlash(TempPath, "\")
GetTEMPPath = TempPath
End Function
Public Sub TileImage(ImagePath As String, trg As PictureBox, Optional PreventTile As Boolean)
Dim x As Long
Dim y As Long
Dim Src As PictureBox
Dim f As Integer
Dim IsAutoRedraw As Boolean
Set Src = frmMain.picRsc
f = 1
If trg.ScaleMode = vbPixels Then f = 15
trg.Picture = LoadPicture()
IsAutoRedraw = trg.AutoRedraw
trg.AutoRedraw = True
If ImagePath <> "picRsc" Then
If IsFlash(ImagePath) Then
Src.Picture = LoadResPicture(200, vbResIcon)
Else
'If IsANI(ImagePath) Then
' src.Picture = LoadResPicture(201, vbResIcon)
'Else
Src.Picture = LoadPictureRes(ImagePath)
'End If
End If
End If
If Src <> 0 Then
If PreventTile Then
trg.PaintPicture Src, 0, 0
Else
For x = 0 To trg.Width Step Src.Width / f
For y = 0 To trg.Height Step Src.Height / f
trg.PaintPicture Src, x, y
'BitBlt trg.hDC, x, Y, src.Width, src.Height, src.hDC, 0, 0, vbSrcCopy
Next y
Next x
End If
End If
trg.AutoRedraw = IsAutoRedraw
End Sub
Public Sub SetTemplateDefaults()
nwdPar = "NewWindow" + _
cSep + "0" + _
cSep + "0" + _
cSep + "400" + _
cSep + "400" + _
cSep + "1" + _
cSep + "0" + _
cSep + "1" + _
cSep + "0" + _
cSep + "1" + _
cSep + "1" + _
cSep + "1" + _
cSep + "1" + _
cSep + "1" + _
cSep + "1"
With TemplateCommand
.Name = vbNullString
.caption = vbNullString
.WinStatus = vbNullString
.nBackColor = &HE0E0E0
.nTextColor = &H0
.hBackColor = &H947A4E
.hTextColor = &HFFFFFF
.iCursor.cType = iccDefault
.iCursor.CFile = vbNullString
.parent = 0
.Trigger = ByClicking
.NormalFont.FontName = "Tahoma"
.NormalFont.FontSize = 11
.NormalFont.FontBold = False
.NormalFont.FontItalic = False
.NormalFont.FontUnderline = False
.HoverFont.FontName = "Tahoma"
.HoverFont.FontSize = 11
.HoverFont.FontBold = False
.HoverFont.FontItalic = False
.HoverFont.FontUnderline = False
.Actions.onclick.TargetFrame = "_self"
.Actions.onclick.Type = atcURL
.Actions.onclick.url = vbNullString
.Actions.onclick.WindowOpenParams = nwdPar
.Actions.onmouseover.TargetFrame = "_self"
.Actions.onmouseover.Type = atcNone
.Actions.onmouseover.url = vbNullString
.Actions.onmouseover.WindowOpenParams = nwdPar
.Actions.OnDoubleClick.TargetFrame = "_self"
.Actions.OnDoubleClick.Type = atcNone
.Actions.OnDoubleClick.url = vbNullString
.Actions.OnDoubleClick.WindowOpenParams = nwdPar
.Alignment = tacLeft
.disabled = False
.LeftImage.h = 0
.LeftImage.w = 0
.LeftImage.HoverImage = vbNullString
.LeftImage.NormalImage = vbNullString
.RightImage.h = 0
.RightImage.w = 0
.RightImage.HoverImage = vbNullString
.RightImage.NormalImage = vbNullString
.BackImage.NormalImage = vbNullString
.BackImage.HoverImage = vbNullString
.BackImage.Tile = True
.BackImage.AllowCrop = True
.Sound.onmouseover = vbNullString
.Sound.onclick = vbNullString
.SeparatorPercent = 80
.CmdsFXNormal = cfxcNone
.CmdsFXOver = cfxcNone
.CmdsFXSize = 1
.CmdsMarginX = 6
.CmdsMarginY = 3
.CmdsFXnColor = -2
.CmdsFXhColor = -2
With .Radius
.TopLeft = 0
.TopRight = 0
.BottomLeft = 0
.BottomRight = 0
End With
.xData = vbNullString
.Compile = True
End With
With TemplateGroup
.Name = vbNullString
.bColor = &H808080
.Corners.leftCorner = &H808080
.Corners.topCorner = &H808080
.Corners.rightCorner = &H808080
.Corners.bottomCorner = &H808080
.Actions.onclick.Type = atcNone
.Actions.onclick.TargetMenu = 0
.Actions.onclick.url = vbNullString
.Actions.onclick.TargetFrame = "_self"
.Actions.onclick.WindowOpenParams = nwdPar
.Actions.onmouseover.Type = atcNone
.Actions.onmouseover.TargetMenu = 0
.Actions.onmouseover.url = vbNullString
.Actions.onmouseover.TargetFrame = "_self"
.Actions.onmouseover.WindowOpenParams = nwdPar
.Actions.OnDoubleClick.Type = atcNone
.Actions.OnDoubleClick.TargetMenu = 0
.Actions.OnDoubleClick.url = vbNullString
.Actions.OnDoubleClick.TargetFrame = "_self"
.Actions.OnDoubleClick.WindowOpenParams = nwdPar
.frameBorder = 1
.DefNormalFont.FontBold = False
.DefNormalFont.FontItalic = False
.DefNormalFont.FontName = "Tahoma"
.DefNormalFont.FontSize = 11
.DefNormalFont.FontUnderline = False
.DefHoverFont = .DefNormalFont
.x = 0
.y = 0
.Leading = 1
.Image = vbNullString
.Alignment = gacBottomLeft
.CmdsFXNormal = cfxcNone
.CmdsFXOver = cfxcNone
.CmdsFXSize = 1
.CmdsMarginX = 6
.CmdsMarginY = 3
.CmdsFXnColor = -2
.CmdsFXhColor = -2
.DropShadowSize = 0
.DropShadowColor = &H999999
.Transparency = 0
.iCursor.cType = iccDefault
.iCursor.CFile = vbNullString
.fWidth = 0
.CaptionAlignment = tacCenter
.hBackColor = &H947A4E
.hTextColor = &HFFFFFF
.nBackColor = &HE0E0E0
.nTextColor = &H0
.disabled = False
.caption = vbNullString
.WinStatus = vbNullString
.ContentsMarginH = 0
.ContentsMarginV = 0
.HSImage = vbNullString
.IsContext = False
.Sound.onmouseover = vbNullString
.Sound.onclick = vbNullString
.AlignmentStyle = ascVertical
.xData = vbNullString
.CornersImages.gcTopLeft = vbNullString
.CornersImages.gcTopCenter = vbNullString
.CornersImages.gcTopRight = vbNullString
.CornersImages.gcLeft = vbNullString
.CornersImages.gcRight = vbNullString
.CornersImages.gcBottomLeft = vbNullString
.CornersImages.gcBottomCenter = vbNullString
.CornersImages.gcBottomRight = vbNullString
.BorderStyle = cfxcNone
With .scrolling
.UpImage.NormalImage = AppPath + "exhtml\aup_b.gif"
.UpImage.HoverImage = AppPath + "exhtml\aup_w.gif"
.DnImage.NormalImage = AppPath + "exhtml\adn_b.gif"
.DnImage.HoverImage = AppPath + "exhtml\adn_w.gif"
.FXhColor = &H0
.FXnColor = &H0
.FXNormal = cfxcNone
.FXOver = cfxcNone
.FXSize = 1
.hColor = &H202080
.margin = 4
.nColor = &H808080
.onmouseover = True
End With
.tbiLeftImage.NormalImage = vbNullString
.tbiLeftImage.HoverImage = vbNullString
.tbiLeftImage.w = 0
.tbiLeftImage.h = 0
.tbiRightImage.NormalImage = vbNullString
.tbiRightImage.HoverImage = vbNullString
.tbiRightImage.w = 0
.tbiRightImage.h = 0
.tbiBackImage.NormalImage = vbNullString
.tbiBackImage.HoverImage = vbNullString
.tbiBackImage.Tile = True
.tbiBackImage.AllowCrop = True
With .Radius
.TopLeft = 0
.TopRight = 0
.BottomLeft = 0