-
Notifications
You must be signed in to change notification settings - Fork 3
/
frmTarget.frm
1718 lines (1467 loc) · 85.8 KB
/
frmTarget.frm
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
VERSION 5.00
Begin VB.Form frmTarget
AutoRedraw = -1 'True
Caption = "MyWindow"
ClientHeight = 4245
ClientLeft = 105
ClientTop = 435
ClientWidth = 6555
DrawWidth = 2
Icon = "frmTarget.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
Moveable = 0 'False
ScaleHeight = 4245
ScaleWidth = 6555
Begin VB.Timer tmrCreating
Enabled = 0 'False
Interval = 10
Left = 4440
Top = 3720
End
Begin VB.Timer tmrSize
Enabled = 0 'False
Interval = 10
Left = 5880
Top = 3720
End
Begin VB.Timer tmrDrag
Enabled = 0 'False
Interval = 10
Left = 5160
Top = 3720
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 7
Left = 2640
MousePointer = 8 'Size NW SE
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 9
Top = 720
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 6
Left = 2400
MousePointer = 7 'Size N S
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 8
Top = 720
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 5
Left = 2160
MousePointer = 6 'Size NE SW
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 7
Top = 720
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 4
Left = 2640
MousePointer = 9 'Size W E
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 6
Top = 480
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 3
Left = 2160
MousePointer = 9 'Size W E
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 5
Top = 480
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 2
Left = 2640
MousePointer = 6 'Size NE SW
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 4
Top = 240
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 1
Left = 2400
MousePointer = 7 'Size N S
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 3
Top = 240
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picDrag
Appearance = 0 'Flat
BackColor = &H00FF9C31&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 60
Index = 0
Left = 2160
MousePointer = 8 'Size NW SE
ScaleHeight = 60
ScaleWidth = 60
TabIndex = 2
Top = 240
Visible = 0 'False
Width = 60
End
Begin VB.PictureBox picControls
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
Height = 492
Index = 0
Left = 120
MousePointer = 15 'Size All
ScaleHeight = 495
ScaleWidth = 1215
TabIndex = 0
Top = 120
Visible = 0 'False
Width = 1212
Begin VB.PictureBox picControlContainer
AutoRedraw = -1 'True
BorderStyle = 0 'None
Enabled = 0 'False
Height = 252
Index = 0
Left = 0
ScaleHeight = 255
ScaleWidth = 495
TabIndex = 1
Top = 0
Width = 492
End
End
Begin VB.Line lnAlign
BorderStyle = 3 'Dot
DrawMode = 1 'Blackness
Index = 3
Visible = 0 'False
X1 = 3600
X2 = 4440
Y1 = 1320
Y2 = 1320
End
Begin VB.Line lnAlign
BorderStyle = 3 'Dot
DrawMode = 1 'Blackness
Index = 2
Visible = 0 'False
X1 = 3600
X2 = 4440
Y1 = 1200
Y2 = 1200
End
Begin VB.Line lnAlign
BorderStyle = 3 'Dot
DrawMode = 1 'Blackness
Index = 1
Visible = 0 'False
X1 = 3600
X2 = 4440
Y1 = 1080
Y2 = 1080
End
Begin VB.Line lnAlign
BorderStyle = 3 'Dot
DrawMode = 1 'Blackness
Index = 0
Visible = 0 'False
X1 = 3600
X2 = 4440
Y1 = 960
Y2 = 960
End
Begin VB.Shape shpBorder
BorderColor = &H00707070&
BorderWidth = 2
Height = 495
Left = 3600
Top = 240
Visible = 0 'False
Width = 855
End
End
Attribute VB_Name = "frmTarget"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const MAX_DISTANCE = 150 '控件自动对齐的最大距离
Public CurrentWindowStyle As Long '当前窗体的样式
Public CurrentDragging As PictureBox '当前正在拖动的控件
Public CurrentChanging As PictureBox '当前正准备改变大小的控件
Public IsCreatingControl As Boolean '当前是否正在创建控件
Dim DragPrevComp(7) As PictureBox '拖动控件时或者调整控件大小时进行距离比较的控件 (0, 1 = 左对齐; 2, 3 = 右对齐; 4, 5 = 上对齐; 6, 7 = 下对齐)
Dim cMode As Integer '更改控件大小的方向(上下左右分别两个)
Dim DownX As Long, DownY As Long '鼠标拖控件时按下的坐标
Dim DragDownX As Single, DragDownY As Single '鼠标按下并开始绘制控件外框时的坐标
Dim DragCurrentX As Single, DragCurrentY As Single '绘制控件外框时鼠标实时坐标
Dim dControlX As Long, dControlY As Long, _
dControlW As Long, dControlH As Long '鼠标按下时控件的坐标及大小
'根据指定的坐标显示一条虚线在指定的位置
' 描述:由于直接在窗体上绘制会造成控件闪烁(由于窗体重绘),所以直接用Line控件算了。本过程实质是调整指定的Line控件的位置
'必选参数:LineIndex:Line控件的序号;X1、Y1为第一个点的X坐标和Y坐标;X2和Y2位第二个点的X坐标和Y坐标
'可选参数:无
' 返回值:无
Private Sub LineEx(LineIndex As Integer, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)
Me.lnAlign(LineIndex).X1 = X1
Me.lnAlign(LineIndex).Y1 = Y1
Me.lnAlign(LineIndex).X2 = X2
Me.lnAlign(LineIndex).Y2 = Y2
Me.lnAlign(LineIndex).Visible = True
End Sub
'根据指定的数字返回对应的控件类型名称
' 描述:根据指定的数字返回对应的控件类型名称
'必选参数:iNumber:指定的数字。【0 ≤ iNumber ≤ 22】
'可选参数:无
' 返回值:数字对应的控件类型名称
Public Function NumberToCtlType(iNumber As Integer) As String
Select Case iNumber
Case 0: NumberToCtlType = "Image"
Case 1: NumberToCtlType = "Label"
Case 2: NumberToCtlType = "Edit"
Case 3: NumberToCtlType = "Frame"
Case 4: NumberToCtlType = "Button"
Case 5: NumberToCtlType = "CheckBox"
Case 6: NumberToCtlType = "Option"
Case 7: NumberToCtlType = "Combo"
Case 8: NumberToCtlType = "ListBox"
Case 9: NumberToCtlType = "HScroll"
Case 10: NumberToCtlType = "VScroll"
Case 11: NumberToCtlType = "UpDown"
Case 12: NumberToCtlType = "ProgressBar"
Case 13: NumberToCtlType = "Slider"
Case 14: NumberToCtlType = "Hotkey"
Case 15: NumberToCtlType = "ListView"
Case 16: NumberToCtlType = "TreeView"
Case 17: NumberToCtlType = "Tab"
Case 18: NumberToCtlType = "Animation"
Case 19: NumberToCtlType = "RichEdit"
Case 20: NumberToCtlType = "TimePicker"
Case 21: NumberToCtlType = "MonthCalendar"
Case 22: NumberToCtlType = "IpAddress"
Case Else: NumberToCtlType = ""
End Select
End Function
'为指定类型的控件初始化属性列表的过程
' 描述:根据特定类型的控件初始化对应的属性值
'必选参数:ControlIndex:指定控件的序号;ControlType:控件类型;PropIndex:属性的序号
'可选参数:无
' 返回值:无
Public Sub InitProperty(ControlIndex As Integer, ControlType As Integer, PropIndex As Integer)
Select Case ControlType '控件的类型
Case 0 '图片控件
If PropIndex <> 1 Then '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End If
Case 1 '标签控件
Select Case PropIndex
Case 1 '文本
MainPropList(ControlIndex, PropIndex, 0) = "Label"
Case 2, 3, 5, 6 '黑色边框 & 黑色填充 & 自动换行 & 自动添加省略号
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 4 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "SS_LEFT"
Case 7, 8 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 2 '文本框控件
Select Case PropIndex
Case 2, 3, 12, 15, 16 '自动水平滚动 & 自动垂直滚动 & 立体边框 & 有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
Case 4 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "ES_LEFT"
Case 5, 6, 7, 8, 10, 11, 13 '强制小写 & 强制大写 & 强制数字 & 密码文本 & 文本只读 & 黑色边框 & 多行文本
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 14 '滚动条
MainPropList(ControlIndex, PropIndex, 0) = "两个都没"
Case 9 '密码文本
MainPropList(ControlIndex, PropIndex, 0) = "0"
End Select
Case 3 '组框控件
Select Case PropIndex
Case 1 '文本
MainPropList(ControlIndex, PropIndex, 0) = "Frame"
Case 2 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "←"
Case 3, 4 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 4 '按钮控件
Select Case PropIndex
Case 1 '文本
MainPropList(ControlIndex, PropIndex, 0) = "Button"
Case 3 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "●"
Case 2, 4, 5 '立体边框 & 扁平 & 黑色边框
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 6, 7 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 5 '复选框控件
Select Case PropIndex
Case 1 '文本
MainPropList(ControlIndex, PropIndex, 0) = "CheckBox"
Case 2 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "←"
Case 3, 4, 5, 6 '立体边框 & 扁平 & 黑色边框 & 按钮形式
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 7, 8 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 6 '单选框控件
Select Case PropIndex
Case 1 '文本
MainPropList(ControlIndex, PropIndex, 0) = "Option"
Case 2 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "←"
Case 3, 4, 5, 6 '立体边框 & 扁平 & 黑色边框 & 按钮形式
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 7, 8 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 7 '组合框控件
Select Case PropIndex
Case 1 '垂直滚动条
MainPropList(ControlIndex, PropIndex, 0) = "自动"
Case 2, 8, 9 '自动水平滚动 & 有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
Case 3, 4, 5, 6 '强制小写 & 强制大写 & 列表样式 & 自动排列
MainPropList(ControlIndex, PropIndex, 0) = "False"
End Select
Case 8 '列表框控件
Select Case PropIndex
Case 1 '垂直滚动条
MainPropList(ControlIndex, PropIndex, 0) = "无"
Case 4, 8, 9 '立体边框 & 有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
Case 2, 3, 5, 6 '允许多选 & 是否多列 & 黑色边框 & 自动排列
MainPropList(ControlIndex, PropIndex, 0) = "False"
End Select
Case 9, 10 '水平&垂直滚动条
Select Case PropIndex
Case 1 '最小值
MainPropList(ControlIndex, PropIndex, 0) = 0
Case 2 '最大值
MainPropList(ControlIndex, PropIndex, 0) = 100
Case 3 '最小更改值
MainPropList(ControlIndex, PropIndex, 0) = 1
Case 4 '最大更改值
MainPropList(ControlIndex, PropIndex, 0) = 10
Case 5, 6 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 11 '调节按钮
Select Case PropIndex
Case 1 '最小值
MainPropList(ControlIndex, PropIndex, 0) = 0
Case 2 '最大值
MainPropList(ControlIndex, PropIndex, 0) = 100
Case 3 '快进速度
MainPropList(ControlIndex, PropIndex, 0) = 5
Case 4 '样式
MainPropList(ControlIndex, PropIndex, 0) = "垂直"
Case 5, 6 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 12 '进度条
Select Case PropIndex
Case 1 '最小值
MainPropList(ControlIndex, PropIndex, 0) = 0
Case 2 '最大值
MainPropList(ControlIndex, PropIndex, 0) = 100
Case 3 '样式
MainPropList(ControlIndex, PropIndex, 0) = "方块"
Case 4 '方向
MainPropList(ControlIndex, PropIndex, 0) = "水平"
Case 5 '滑块颜色
MainPropList(ControlIndex, PropIndex, 0) = RGB(52, 135, 255)
Case 6 '背景颜色
MainPropList(ControlIndex, PropIndex, 0) = RGB(240, 240, 240)
Case 7, 8 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 13 '滑块
Select Case PropIndex
Case 1 '方向
MainPropList(ControlIndex, PropIndex, 0) = "水平"
Case 2 '刻度位置
MainPropList(ControlIndex, PropIndex, 0) = "下方"
Case 3, 10 '不显示滑块 & 黑色边框
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 4 '数字标签位置
MainPropList(ControlIndex, PropIndex, 0) = "下方"
Case 5 '刻度间隔
MainPropList(ControlIndex, PropIndex, 0) = "1"
Case 6 '最小值
MainPropList(ControlIndex, PropIndex, 0) = "0"
Case 7 '最大值
MainPropList(ControlIndex, PropIndex, 0) = "100"
Case 8 '慢速更改步长
MainPropList(ControlIndex, PropIndex, 0) = "1"
Case 9 '快速更改步长
MainPropList(ControlIndex, PropIndex, 0) = "10"
Case 11, 12 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 14 '热键
If (PropIndex = 1) Or (PropIndex = 2) Then '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End If
Case 15 '列表视图
Select Case PropIndex
Case 1 '样式
MainPropList(ControlIndex, PropIndex, 0) = "报告"
Case 2 '自动排序
MainPropList(ControlIndex, PropIndex, 0) = "不排序"
Case 3 '自动对齐
MainPropList(ControlIndex, PropIndex, 0) = "自动"
Case 4, 5 '可编辑标签 & 可多选
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 6, 7, 8 '黑色边框 & 有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 16 '树视图
Select Case PropIndex
Case 1, 5, 6, 8, 9 '可编辑标签 & 禁止水平和垂直滚动 & 实施选取 & 多选框
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 2, 3, 4, 7, 10, 11, 12 '显示节点按钮 & 根节点显示按钮 & 显示树线 & 失焦时显示选择项 & 黑色边框 & 有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 17 '选项卡
Select Case PropIndex
Case 1 To 10 '其余剩下的所有属性
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 11, 12 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 18 '动画
Select Case PropIndex
Case 2 To 6 '自动播放 & 居中显示 & 视频背景透明 & 立体边框 & 黑色边框
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 7, 8 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 19 'RTF文本框
Select Case PropIndex
Case 2, 3, 9, 11, 15, 16, 17 '自动水平/垂直滚动 & 立体边框 & 多行文本 & 左边缘空白 & 有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
Case 5, 6, 7, 8, 10, 13, 14 '强制数字 & 密码文本 & 文本只读 & 黑色边框 & 下沉的边框 & 滚动条自动禁用 & 禁用输入法
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 4 '文本位置
MainPropList(ControlIndex, PropIndex, 0) = "ES_LEFT"
Case 12 '滚动条
MainPropList(ControlIndex, PropIndex, 0) = "WS_VSCROLL"
End Select
Case 20 '日期时间选取器
Select Case PropIndex
Case 1 To 5 '除了有效和可视之外的所有属性
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 6, 7 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 21 '月历
Select Case PropIndex
Case 1, 3 To 7 '连续选取 & 显示第几周 & 不圈选今天 & 不显示今天 & 黑色边框 & 立体边框
MainPropList(ControlIndex, PropIndex, 0) = "False"
Case 2 '连续选取数量
MainPropList(ControlIndex, PropIndex, 0) = "7"
Case 8, 9 '有效 & 可视
MainPropList(ControlIndex, PropIndex, 0) = "True"
End Select
Case 22 'IP地址
MainPropList(ControlIndex, PropIndex, 0) = "True" '有效 & 可视
End Select
End Sub
'显示调整大小的边框过程
' 描述:在指定的图片框周边显示可以供调整大小的边框
'必选参数:指定一个显示调整大小边框的图片框
'可选参数:无
' 返回值:无
Public Sub ShowSizers(TargetControl As PictureBox)
'0 1 2
'3 4
'5 6 7
'=============================================================================================
Dim i As Integer
'显示边框
For i = 0 To 7
Me.picDrag(i).Visible = True
Me.picDrag(i).ZOrder 0
Next i
'=============================================================================================
'设置各个边框的坐标
Me.picDrag(0).Move TargetControl.Left - Me.picDrag(0).Width, _
TargetControl.Top - Me.picDrag(0).Height
Me.picDrag(1).Move TargetControl.Left + TargetControl.Width / 2 - Me.picDrag(1).Width / 2, _
TargetControl.Top - Me.picDrag(1).Height
Me.picDrag(2).Move TargetControl.Left + TargetControl.Width, _
TargetControl.Top - Me.picDrag(1).Height
Me.picDrag(3).Move TargetControl.Left - Me.picDrag(3).Width, _
TargetControl.Top + TargetControl.Height / 2 - Me.picDrag(3).Height / 2
Me.picDrag(4).Move TargetControl.Left + TargetControl.Width, _
TargetControl.Top + TargetControl.Height / 2 - Me.picDrag(4).Height / 2
Me.picDrag(5).Move TargetControl.Left - Me.picDrag(5).Width, _
TargetControl.Top + TargetControl.Height
Me.picDrag(6).Move TargetControl.Left + TargetControl.Width / 2 - Me.picDrag(6).Width / 2, _
TargetControl.Top + TargetControl.Height
Me.picDrag(7).Move TargetControl.Left + TargetControl.Width, _
TargetControl.Top + TargetControl.Height
End Sub
'新建控件容器函数
' 描述:用来新建一个用来放置控件的容器及容器的容器,即两个图片框
'必选参数:无
'可选参数:X、Y、W、H分别对应两轴坐标和宽度高度
' 返回值:创建的控件容器
Public Function NewControlContainer(Optional x As Single, Optional y As Single, _
Optional W As Single, Optional H As Single) As PictureBox
Dim NewIndex As Integer
NewIndex = Me.picControls.UBound + 1
Load Me.picControls(NewIndex) '加载新的控件容器的容器
Load Me.picControlContainer(NewIndex) '加载新的控件容器
SetParent Me.picControlContainer(NewIndex).hWnd, Me.picControls(NewIndex).hWnd '设置控件容器的母窗体
'显示加载好的控件
Me.picControls(NewIndex).Visible = True
Me.picControlContainer(NewIndex).Visible = True
'让控件的容器的容器不可用 这样就可以让主容器来响应事件
Me.picControlContainer(NewIndex).Enabled = False
'检测是否传入了可选参数
If x <> 0 Or y <> 0 Or W <> 0 Or H <> 0 Then
'按照设置的参数进行设置
Me.picControls(NewIndex).Move x, y, W, H
Else
'否则居中创建控件容器
Me.picControls(NewIndex).Move Me.Width / 2 - Me.picControls(NewIndex).Width / 2, _
Me.Height / 2 - Me.picControls(NewIndex).Height / 2
End If
'让控件容器的大小适应其母容器
Me.picControlContainer(NewIndex).Move 0, 0, Me.picControlContainer(NewIndex).Width, _
Me.picControlContainer(NewIndex).Height
'让大容器置顶
Me.picControls(NewIndex).ZOrder 0
'返回创建的控件容器的句柄
Set NewControlContainer = Me.picControlContainer(NewIndex)
End Function
Public Sub Form_DblClick()
'显示对窗体编辑的代码窗口
Dim i As Integer
frmCoding.comEvent.Clear
frmCoding.TargetType = 24
For i = 1 To EventList(24).Count
frmCoding.comEvent.AddItem EventList(24).Item(i)
Next i
On Error Resume Next
frmCoding.comTarget.ListIndex = 1
frmCoding.comEvent.ListIndex = 0
frmCoding.Show
End Sub
Private Sub Form_Load()
'设置放置控件的容器的颜色及大小
Me.picControls(0).BackColor = Me.picControlContainer(0).BackColor
Me.picControlContainer(0).Width = Me.picControls(0).Width
Me.picControlContainer(0).Height = Me.picControls(0).Height
'=====================================================================
'设置本窗体的样式,使控件可以自动重绘
'标题栏 + 可视 + 子窗口重绘时不绘制被重叠的部分 + 系统菜单 + 最大化按钮 + 最小化按钮 + 可调大小 + MDI子窗体
'加入WS_CHILD这个属性很关键,这样Windows才会认为这个窗体是个子窗体,这个窗体的母窗体才会保持着焦点
'隐藏再重新显示一次窗体是为了应用窗体样式的更改
SetWindowLong Me.hWnd, GWL_STYLE, WS_CAPTION Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_SYSMENU Or _
WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_THICKFRAME Or WS_CHILD
'禁止窗体从左边、上边、左上或者右上调整大小并禁止窗体最大化最小化 【开关】
PrevWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf NoChangeWndProc)
End Sub
Public Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Integer
'隐藏改变大小的边框
For i = 0 To 7
Me.picDrag(i).Visible = False
Next i
'如果列表框窗体当前可视
If frmListPanel.Visible = True Then
Unload frmListPanel '保存里面的内容并关闭它
End If
'=============================
If Not IsCreatingControl Then '如果不处于拖放控件状态
'删除属性表里其它项目
For i = 1 To frmProperties.labPropName.UBound
Unload frmProperties.labPropName(i)
Unload frmProperties.labPropValue(i)
Next i
'拉取窗体的属性表
Dim sString() As String '分割字符串缓存
frmProperties.NowIndex = 0 '初始化属性面板的状态
frmProperties.labPropName(0).Caption = ""
frmProperties.labPropValue(0).Caption = ""
frmProperties.labPropName(0).BackColor = vbWhite
frmProperties.labPropValue(0).BackColor = vbWhite
frmProperties.comProp.Clear
frmProperties.edProp.Visible = False
frmProperties.comProp.Visible = False
frmProperties.cmdCall.Visible = False
frmProperties.cmdDropdownList.Visible = False
Set frmProperties.NowPropList = PropList(24) '设置属性面板的属性列表为窗体的属性列表
Set frmProperties.PropSetTarget = Me '设置属性面板的设置属性的对象为本窗体
frmProperties.CurrentTarget = 0
frmProperties.labPropName(0).Enabled = True '激活属性表的最顶栏
frmProperties.labPropValue(0).Enabled = True
For i = 0 To PropList(24).Count - 1
sString = Split(PropList(24).Item(i + 1), "|") '分割字符串
If i > 0 Then '之后的控件需要动态加载
Load frmProperties.labPropName(i) '加载一行新的属性列表
Load frmProperties.labPropValue(i)
frmProperties.labPropName(i).Caption = sString(1) '获取属性名
If MainPropList(0, i, 0) = "" Then '如果属性值是空的就按照数据类型初始化属性值
If sString(3) = 2 Then 'Boolean
MainPropList(0, i, 0) = "True" '初始化为“True”
End If
If sString(3) = 4 Then 'Combo
MainPropList(0, i, 0) = sString(4) '初始化为第一个列表项
End If
If sString(3) = 6 Then 'Command Button
MainPropList(0, i, 0) = RGB(240, 240, 240) '初始化为按钮表面色
End If
End If
frmProperties.labPropValue(i).Caption = MainPropList(0, i, 0) '获取属性值
frmProperties.labPropName(i).Left = 0 '调整控件位置
frmProperties.labPropName(i).Top = frmProperties.labPropName(0).Height * i
frmProperties.labPropValue(i).Top = frmProperties.labPropName(i).Top
Else '一开始就有的0号控件
frmProperties.labPropName(0).Caption = sString(1) '获取属性名
frmProperties.labPropValue(0).Caption = MainPropList(0, 0, 0) '获取属性值
End If
frmProperties.labPropName(i).Visible = True '显示这行
frmProperties.labPropValue(i).Visible = True
Next i
Call frmProperties.Form_Resize
frmProperties.labPropName(0).BackColor = &HFF9933 '更改颜色
frmProperties.labPropValue(0).BackColor = &HFF9933
frmToolBar.TargetIsForm = True '设置当前显示大小的对象为窗体
frmToolBar.labXY.Caption = "0, 0"
frmToolBar.labWH.Caption = Me.Width / Screen.TwipsPerPixelX & " x " & Me.Height / Screen.TwipsPerPixelY
Else '如果处于拖放控件状态
DragDownX = x '记录鼠标按下时的坐标
DragDownY = y
If frmMain.UseGrid Then '自动对齐到网格
DragDownX = DragDownX - DragDownX Mod 150
DragDownY = DragDownY - DragDownY Mod 150
End If
Me.shpBorder.Left = DragDownX '先初始化控件坐标,改善用户体验
Me.shpBorder.Top = DragDownY
Me.shpBorder.Width = 1
Me.shpBorder.Height = 1
Me.shpBorder.Visible = True '显示拖控件时的边框
Me.tmrCreating.Enabled = True '启动计时器
End If
If Button = 2 Then '点击右键则弹出右键菜单
PopupMenu frmMain.mnuTargetWindowPopup
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsCreatingControl Then '如果处于创建控件的拖放控件状态
DragCurrentX = x '记录鼠标当前的坐标
DragCurrentY = y
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
'判断是否自动对齐到网格
If frmMain.UseGrid Then
Me.Width = Me.Width - Me.Width Mod 150
Me.Height = Me.Height - Me.Height Mod 150
End If
'显示窗体的大小
If frmToolBar.TargetIsForm Then
frmToolBar.labXY.Caption = "0, 0"
frmToolBar.labWH.Caption = Me.Width / Screen.TwipsPerPixelX & " x " & Me.Height / Screen.TwipsPerPixelY
If Me.Width <> 1500 And Me.Height <> 3000 Then '如果用户更改了窗体大小
IsSaved = False '则记录为未保存
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'还原窗体消息处理,正常退出
If frmMain.IsExiting Then
SetWindowLong Me.hWnd, GWL_WNDPROC, PrevWndProc
Else
Cancel = True
End If
End Sub
Public Sub picControls_DblClick(Index As Integer)
'显示对控件编辑的代码窗口
Dim i As Integer
Dim CtlName As String '控件的名称
frmCoding.comEvent.Clear
frmCoding.TargetType = CInt(Split(Me.picControlContainer(Index).Tag, "|")(1)) '获取当前控件的类型
frmCoding.TargetIndex = CInt(Split(Me.picControlContainer(Index).Tag, "|")(2)) '获取当前的控件的序号
For i = 1 To EventList(frmCoding.TargetType).Count '读取当前控件的事件
'把控件序号标记替换成控件的序号
frmCoding.comEvent.AddItem Replace(EventList(frmCoding.TargetType).Item(i), "【hMenu】", frmCoding.TargetIndex)
Next i
CtlName = NumberToCtlType(frmCoding.TargetType) & "_" & frmCoding.TargetIndex '获取控件的名称
frmCoding.comTarget.ListIndex = FindItem(frmCoding.comTarget, CtlName) '在“对象列表”中选择控件对应的列表项
frmCoding.comEvent.ListIndex = 0 '选择第一个事件
frmCoding.Show
End Sub
Private Sub picControls_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
'如果按下了删除键而且当前选定了控件
If KeyCode = vbKeyDelete And Not (frmTarget.CurrentDragging Is Nothing) And frmTarget.picDrag(0).Visible Then
Call frmMain.mnuDelete_Click
End If
End Sub
Public Sub picControls_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
'如果列表框窗体当前可视
If frmListPanel.Visible = True Then
Unload frmListPanel '保存里面的内容并关闭它
End If
IsSaved = False '记录当前工程已更改
Set CurrentChanging = Me.picControls(Index) '设置当前图片框为正在准备更改大小的对象
dControlX = CurrentChanging.Left '记录当前控件的坐标及大小
dControlY = CurrentChanging.Top
dControlW = CurrentChanging.Width
dControlH = CurrentChanging.Height
ShowSizers CurrentChanging
If Button = 1 Or Button = 2 Then '左键按下拖动或者右键按下弹出菜单
Dim Cur As POINTAPI
GetCursorPos Cur '获取鼠标当前坐标
DownX = Cur.x '记录当前坐标
DownY = Cur.y
Set CurrentDragging = Me.picControls(Index) '设置当前图片框为拖动对象
'==================================================================================
'删除属性表里的其他项目
Dim i As Integer
For i = 1 To frmProperties.labPropName.UBound
Unload frmProperties.labPropName(i)
Unload frmProperties.labPropValue(i)
Next i
'---------------------------------------------------
'拉取窗体的属性表
Dim sString() As String '分割字符串缓存
Dim CurrentControlType As Integer '当前选择的控件的类型
frmProperties.NowIndex = 0 '初始化属性面板的状态
frmProperties.labPropName(0).Caption = ""
frmProperties.labPropValue(0).Caption = ""
frmProperties.labPropName(0).BackColor = vbWhite
frmProperties.labPropValue(0).BackColor = vbWhite
frmProperties.comProp.Clear
frmProperties.edProp.Visible = False
frmProperties.comProp.Visible = False
frmProperties.cmdCall.Visible = False
frmProperties.cmdDropdownList.Visible = False
CurrentControlType = CInt(Split(Me.picControlContainer(Index).Tag, "|")(1))
Set frmProperties.NowPropList = PropList(CurrentControlType) '拉取当前对应控件的属性表
Set frmProperties.PropSetTarget = Me.picControlContainer(Index) '设置属性窗口的属性设置对象为当前选择的控件容器
frmProperties.CurrentTarget = Index '设置当前属性设置的对象的序号
'由于用Redim Preserve只能改变数组最后一维的上界
'所以使用一个缓存数组存放主属性列表的内容,然后调整主属性列表所有维数的上界,再复制所有内容回去
'这里可能还有更好的方法,如果您有的话欢迎告诉我。
Dim TempPropList() As String
ReDim TempPropList(UBound(MainPropList, 1), UBound(MainPropList, 2), UBound(MainPropList, 3))
'备份所有内容
Dim fX As Integer, fY As Integer, fZ As Integer
For fX = 0 To UBound(TempPropList, 1)
For fY = 0 To UBound(TempPropList, 2)
For fZ = 0 To UBound(TempPropList, 3)
TempPropList(fX, fY, fZ) = MainPropList(fX, fY, fZ)
Next fZ
Next fY
Next fX
'扩充用来存放所有控件属性的动态数组
Dim NewControlCount As Integer '计算三维数组第一维(用来存放控件序号)的新大小
Dim NewPropListBuffer As Integer '计算三维数组第二维(用来存放控件属性)的新大小
NewControlCount = IIf(UBound(MainPropList, 1) > Me.picControls.UBound, _
UBound(MainPropList, 1), _
Me.picControls.UBound)