-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMCDHook.bas
1593 lines (1462 loc) · 84.4 KB
/
MCDHook.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 = "MCDHook"
Option Explicit
' --- API 函数 申明
' 释放程序内存
Private Declare Function SetProcessWorkingSetSize Lib "kernel32" (ByVal hProcess As Long, ByVal dwMinimumWorkingSetSize As Long, ByVal dwMaximumWorkingSetSize As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
' API call to alter the class data for this window
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, _
ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, _
ByVal hWnd&, ByVal msg&, ByVal wParam&, ByVal lParam&)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
' 取得控件相对屏幕左上角的坐标值！（单位：像素？！）
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, lpString As Any) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal e As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal f As String) As Long
' VB 取得图片大小
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
' =========================================================================================
' ==== 声音文件的播放（可去掉）============================================================
' =========================================================================================
'API 申明 使用PlaySound函数播放声音
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As String, ByVal dwFlags As Long) As Long
'API 申明 使用sndPlaySound函数播放声音，它是 PlaySound 函数的子集？！
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
Private Declare Function sndStopSound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszNull As Long, ByVal uFlags As Long) As Long
'关闭声音
'sndPlaySound Null, SND_ASYNC
'PlaySound 0,0,0
' 高级媒体播放函数
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
' mciSendString 是用来播放多媒体文件的API指令，可以播放MPEG,AVI,WAV,MP3,等等
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
' Multimedia Command Strings: http://msdn.microsoft.com/en-us/library/ms712587.aspx
' MCI Command Strings:http://msdn.microsoft.com/en-us/library/ms710815(VS.85).aspx
' --- for PlaySound \ sndPlaySound
Private Const SND_ASYNC = &H1 ' play asynchronously 在播放的同时继续执行以后的语句
Private Const SND_FILENAME = &H20000 ' name is a file name
Private Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound 一直重复播放声音，直到该函数开始播放第二个声音为止
Private Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file 播放内存中的声音, 譬如资源文件中的声音
Private Const SND_NODEFAULT = &H2 ' silence not default, if sound not found
Private Const SND_NOSTOP = &H10 ' don't stop any currently playing sound
Private Const SND_NOWAIT = &H2000 ' don't wait if the driver is busy
Private Const SND_PURGE = &H40 ' purge non-static events for task
Private Const SND_RESERVED = &HFF000000 ' In particular these flags are reserved
Private Const SND_RESOURCE = &H40004 ' name is a resource name or atom
Private Const SND_SYNC = &H0 ' play synchronously (default) 播放完声音之后再执行后面的语句
Private Const SND_TYPE_MASK = &H170007
Private Const SND_VALID = &H1F ' valid flags / ;Internal /
Private Const SND_VALIDFLAGS = &H17201F ' Set of valid flag bits. Anything outside
Private Enum PlayStatus ' 声音播放状态！
IsPlaying = 0
IsPaused = 1
IsStopped = 2
End Enum
' =========================================================================================
' ==== 声音文件的播放（可去掉）============================================================
' =========================================================================================
' =========================================================================================
' ==== 字体对话框 （单独）=================================================================
' =========================================================================================
Rem --------------------------------------------------------
Rem FONT STUFF
Rem --------------------------------------------------------
Public Const LF_FACESIZE = 32
Public Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
'lfFaceName As String * LF_FACESIZE
End Type
'Private lpLF As LOGFONT
Public Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Declare Function lstrcpyANY Lib "kernel32" Alias "lstrcpyA" (p1 As Any, p2 As Any) As Long
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetTextColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
'Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
' hDC 很重要！
' 说明 设置当前文本颜色。这种颜色也称为“前景色” 返回值 Long，文本色的前一个RGB颜色设定。CLR_INVALID表示失败。
Rem --------------------------------------------------------
Rem --------------------------------------------------------
Rem ChooseFont structure and function declarations
Rem --------------------------------------------------------
Public Type ChooseFontType
lStructSize As Long
hwndOwner As Long ' caller's window handle
hdc As Long ' printer DC/IC or NULL
lpLogFont As Long ' ptr. to a LOGFONT struct - changed from old "lpLogFont As LOGFONT"
iPointSize As Long ' 10 * size in points of selected font
Flags As Long ' enum. type flags
rgbColors As Long ' returned text color
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. to hook function
lpTemplateName As String ' custom template name
hInstance As Long ' instance handle of.EXE that contains cust. dlg. template
lpszStyle As String ' return the style field here must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the EnumFonts call back with the extra FONTTYPE bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if CF_LIMITSIZE is used
End Type
Public Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As ChooseFontType) As Long
Private Declare Function SendDlgItemMessage Lib "user32.dll" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CB_GETCURSEL As Long = &H147
Private Const CB_GETITEMDATA As Long = &H150
Private Const CB_ERR As Long = (-1)
Private Const CB_RESETCONTENT As Long = &H14B
Public Enum CF_Flags
CF_SCREENFONTS = &H1&
CF_PRINTERFONTS = &H2&
CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
CF_SHOWHELP = &H4&
CF_ENABLEHOOK = &H8&
CF_ENABLETEMPLATE = &H10&
CF_ENABLETEMPLATEHANDLE = &H20&
CF_INITTOLOGFONTSTRUCT = &H40&
CF_USESTYLE = &H80&
CF_EFFECTS = &H100&
CF_APPLY = &H200&
CF_ANSIONLY = &H400&
CF_NOVECTORFONTS = &H800&
CF_NOOEMFONTS = CF_NOVECTORFONTS
CF_NOSIMULATIONS = &H1000&
CF_LIMITSIZE = &H2000&
CF_FIXEDPITCHONLY = &H4000&
CF_WYSIWYG = &H8000& 'Must also have CF_SCREENFONTS and CF_PRINTERFONTS
CF_FORCEFONTEXIST = &H1000&
CF_SCALABLEONLY = &H2000&
CF_TTONLY = &H4000&
CF_NOFACESEL = &H8000&
CF_NOSTYLESEL = &H100000
CF_NOSIZESEL = &H200000
End Enum
Public Const SIMULATED_FONTTYPE = &H8000
Public Const PRINTER_FONTTYPE = &H4000
Public Const SCREEN_FONTTYPE = &H2000
Public Const BOLD_FONTTYPE = &H100
Public Const ITALIC_FONTTYPE = &H200
Public Const REGULAR_FONTTYPE = &H400
'public Const WM_CHOOSEFONT_GETLOGFONT = (&H400 + 1) 'WM_USER + 1
Public Const LBSELCHSTRING = "commdlg_LBSelChangedNotify"
Public Const SHAREVISTRING = "commdlg_ShareViolation"
Public Const FILEOKSTRING = "commdlg_FileNameOK"
Public Const COLOROKSTRING = "commdlg_ColorOK"
Public Const SETRGBSTRING = "commdlg_SetRGBColor"
Public Const FINDMSGSTRING = "commdlg_FindReplace"
Public Const HELPMSGSTRING = "commdlg_help"
Public Const CD_LBSELNOITEMS = -1
Public Const CD_LBSELCHANGE = 0
Public Const CD_LBSELSUB = 1
Public Const CD_LBSELADD = 2
Rem ------------------------------------------------------------
Rem per maggior praticit� ho enumerato tutti i controlli della
Rem finestra Carattere
Rem ------------------------------------------------------------
Public Enum enumFONT_CTL ' 字体对话框上的控件 ID
stc_FontName = 1088 ' 字体(&F): 标签
edt_FontName = 1001 ' 字体名称 文本框？？
cbo_FontName = &H470 ' 字体名称 下拉框？？66672
stc_BoldItalic = 1089 ' 字形(&Y): 标签
edt_BoldItalic = 1001 ' 字形 文本框？？
cbo_BoldItalic = &H471 ' 字形 下拉框？？66673
stc_Size = 1090 ' 大小(&S): 标签
edt_Size = 1001 ' 大小 文本框？？
cbo_Size = &H472 ' 大小 下拉框？？66674
btn_Ok = 1 ' 确定(&O) 按钮
btn_Cancel = 2 ' 取消(&C) 按钮
btn_Apply = 1026 ' 应用(&A) 按钮
btn_Help = 1038 ' 帮助(&H) 按钮
btn_Effects = 1072 ' 效果 组合框
btn_Strikethrough = &H410 ' 删除线(&K) 按钮
btn_Underline = &H411 ' 下划线(&U) 按钮
stc_Color = &H443 ' 颜色(&C): 标签
cbo_Color = &H473 ' 颜色 下拉框？？66675
btn_Sample = 1073 ' 示例组合框
stc_SampleText = &H444 ' 示例标签：微软中文软件
stc_Charset = 1094 ' 字符集(&R): 标签
cbo_Charset = &H474 ' 字符集下拉框
stc_Description = 1093 ' 字体描述标签：该字体用于显示。打印时将使用最接近的匹配字体。
' Note: 'Axis' is a invisible groupbox with some controls
btn_Axis = 1074 ' groupbox
hsb_1 = 1168 ' horizontal scrollbar
hsb_2 = 1169
hsb_3 = 1170
hsb_4 = 1171
hsb_5 = 1172
hsb_6 = 1173
stc_1 = 1098 ' static
stc_2 = 1099
stc_3 = 1100
stc_4 = 1101
stc_5 = 1102
stc_6 = 1103
stc_7 = 1105
stc_8 = 1106
stc_9 = 1107
stc_10 = 1108
stc_11 = 1109
stc_12 = 1110
stc_13 = 1112
stc_14 = 1113
stc_15 = 1114
stc_16 = 1115
stc_17 = 1116
stc_18 = 1118
edt_1 = 1152 ' edit
edt_2 = 1153
edt_3 = 1154
edt_4 = 1155
edt_5 = 1156
edt_6 = 1157
End Enum
' =========================================================================================
' ==== 字体对话框（单独）==================================================================
' =========================================================================================
' =========================================================================================
' ==== 颜色对话框 （单独）=================================================================
' =========================================================================================
Rem --------------------------------------------------------
Rem ChooseColor structure and function declarations
Rem --------------------------------------------------------
Public Type CHOOSECOLOR_TYPE
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR_TYPE) As Long
Public Enum CC_Flags
CC_RGBINIT = &H1
CC_FULLOPEN = &H2
CC_PREVENTFULLOPEN = &H4
CC_SHOWHELP = &H8
CC_ENABLEHOOK = &H10
CC_ENABLETEMPLATE = &H20
CC_ENABLETEMPLATEHANDLE = &H40
End Enum
Rem --------------------------------------------------------
Rem Public MEMORY Stuff
Rem --------------------------------------------------------
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hmem As Long) As Long
'Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal Lenght As Long)
Public Const GMEM_MOVEABLE = &H2
Public Const GMEM_ZEROINIT = &H40
Public Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Rem --------------------------------------------------------
' =========================================================================================
' ==== 颜色对话框（单独）=================================================================
' =========================================================================================
' --- 常数 申明
' for Windows 消息 常数
Private Const WM_USER = &H400
Private Const WM_INITDIALOG = &H110
Private Const WM_NOTIFY = &H4E
Private Const WM_DESTROY = &H2
Private Const WM_COMMAND As Long = &H111
Private Const WM_GETDLGCODE = &H87
Private Const WM_SETREDRAW = &HB
Private Const WM_SHOWWINDOW = &H18
Private Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_WINDOWPOSCHANGED = &H47
Private Const WM_NCCALCSIZE = &H83
Private Const WM_CHILDACTIVATE = &H22
Private Const WM_NCDESTROY = &H82
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_CHOOSEFONT_GETLOGFONT As Long = (WM_USER + 1)
Private Const WM_CHOOSEFONT_SETFLAGS As Long = (WM_USER + 102)
Private Const WM_CHOOSEFONT_SETLOGFONT As Long = (WM_USER + 101)
Private Const WM_CTLCOLOREDIT = &H133
Private Const WM_CLOSE As Long = &H10
Private Const WM_GETFONT As Long = &H31
Private Const WM_SETFONT As Long = &H30
Private Const WM_SETTEXT = &HC
Private Const WM_PAINT As Long = &HF&
Private Const SW_NORMAL = 1
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
' for SetWindowLong&
Private Const GWL_WNDPROC As Long = (-4&)
' for 对话框上的消息
Private Const CDM_First = (WM_USER + 100) '/---
Private Const CDM_GetSpec = (CDM_First + &H0) '取得文件名
Private Const CDM_GetFilePath = (CDM_First + &H1) '取得文件名与目录
Private Const CDM_GetFolderPath = (CDM_First + &H2) '取得路径
Private Const CDM_GetFolderIDList = (CDM_First + &H3) '
Private Const CDM_SetControlText = (CDM_First + &H4) '设置控件文本
Private Const CDM_HideControl = (CDM_First + &H5) '隐藏控件
Private Const CDM_SetDefext = (CDM_First + &H6) '
Private Const CDM_Last = (WM_USER + 200) '\---
Private Const CDN_First = (-601) '/---
Private Const CDN_InitDone = (CDN_First - &H0) '初始化完成
Private Const CDN_SelChange = (CDN_First - &H1) '选择文件改变
Private Const CDN_FolderChange = (CDN_First - &H2) '目录改变
Private Const CDN_ShareViolation = (CDN_First - &H3) '
Private Const CDN_Help = (CDN_First - &H4) '点了帮助
Private Const CDN_FileOK = (CDN_First - &H5) '点了确定
Private Const CDN_TypeChange = (CDN_First - &H6) '过滤类型改变
Private Const CDN_IncludeItem = (CDN_First - &H7) '
Private Const CDN_Last = (-699) '\---
' for 对话框上控件的 ID
Private Const ID_FolderLabel As Long = &H443 '“查找范围(&I)”标签
Private Const ID_FolderCombo As Long = &H471 '目录下拉框
Private Const ID_ToolBar As Long = &H440 '工具栏（特别注意：无法通过 CDMoveOriginControl 函数移动！）
Private Const ID_ToolBarWin2K As Long = &H4A0 '快捷目录区（版本>=Win2K）
' 列表框（列出文件的最大区域）
Private Const ID_List0 As Long = &H460 ' 使用这个有效！？！
Private Const ID_List1 As Long = &H461
Private Const ID_List2 As Long = &H462
Private Const ID_OK As Long = 1 '“确定(&O)”按键
Private Const ID_Cancel As Long = 2 '“取消(&C)”按键
Private Const ID_Help As Long = &H40E '“帮助(&H)”按键
Private Const ID_ReadOnly As Long = &H410 '“只读”多选框
Private Const ID_FileTypeLabel As Long = &H441 '“文件类型(&T)”标签
Private Const ID_FileNameLable As Long = &H442 '“文件名(&N)”标签
'“文件类型(&T)”下拉框
Private Const ID_FileTypeCombo0 As Long = &H470 ' 使用这个有效！？！
Private Const ID_FileTypeCombo1 As Long = &H471
Private Const ID_FileTypeCombo2 As Long = &H472
Private Const ID_FileTypeComboC As Long = &H47C '“文件名(&N)”文本框
Private Const ID_FileNameText As Long = &H480 '“文件名(&N)”文本框（新外观时不是它！）
' for SendMessage 取得复选框是否选中？
Private Const BM_GETCHECK = &HF0
' for CreateWindowEx 创建预览文本框
Private Const WS_EX_STATICEDGE = &H20000
Private Const WS_EX_TRANSPARENT = &H20&
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_BORDER = &H800000
Private Const WS_CHILD = &H40000000
Private Const WS_HSCROLL = &H100000
Private Const WS_VISIBLE = &H10000000
Private Const WS_VSCROLL = &H200000
Private Const ES_AUTOHSCROLL = &H80&
Private Const ES_AUTOVSCROLL = &H40&
Private Const ES_LEFT = &H0&
Private Const ES_MULTILINE = &H4& ' 文本允许多行
Private Const ES_READONLY = &H800& ' 将编辑框设置成只读的
Private Const ES_CENTER = &H1& ' 文本显示居中
Private Const ES_WANTRETURN = &H1000& ' 使多行编辑器接收回车键输入并换行。如果不指定该风格，按回车键会选择缺省的命令按钮，这往往会导致对话框的关闭。
' --- for CreateFont 字体信息常数
Private Const CLIP_LH_ANGLES As Long = 16 ' 字符旋转所需要的
Private Const PROOF_QUALITY As Long = 2
Private Const TRUETYPE_FONTTYPE As Long = &H4
Private Const ANTIALIASED_QUALITY As Long = 4
Private Const DEFAULT_CHARSET As Long = 1
Private Const FF_DONTCARE = 0 ' Don't care or don't know.
Private Const DEFAULT_PITCH = 0
Private Const OUT_DEFAULT_PRECIS = 0
' --- 枚举 申明
Public Enum PreviewPosition ' 预览图片框位置
ppNone = -1 ' 设为此值时，不显示！
ppTop = 0
ppLeft = 1
ppRight = 2
ppBottom = 3
End Enum
Public Enum DialogStyle ' 对话框风格，打开？保存？字体？颜色？
ssOpen = 0
ssSave = 1
ssFont = 2
ssColor = 3
End Enum
Private Enum FileType
ffText = 0 ' 文本 预览（默认值，任何文件可以以文本方式打开？！）
ffPicture = 1 ' 图片 预览
ffWave = 2 ' Wave 波形文件 预览，画出声音波形！！
ffAudio = 3 ' 一般音频文件，添加播放、暂停、停止按钮，进行预览。API播放声音！！
End Enum
' --- 结构体 申明
' for CopyMemory 取得对话框哪些控件改变？
Private Type NMHDR
hwndFrom As Long
idFrom As Long
code As Long
End Type
' 坐标？
Private Type POINTAPI
X As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' for GetObject
Private Type BITMAP ' 取得BITMAP结构体
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type PicInfo ' 图片宽、高
picWidth As Long
picHeight As Long
End Type
' --- 私有变量 申明
Private procOld As Long ' 保存原 窗体属性的变量，其实是默认的 窗体函数 的地址
Private hWndTextView As Long ' 动态创建的预览文本框 句柄
Private hWndButtonPlay(0 To 2) As Long ' 3 个播放按钮 句柄
Private strSelFile As String ' 选中的文件路径
' ==== 字体对话框 （单独）=================================================================
Private hWndFontPreview As Long ' 字体预览文本框
' ==== 字体对话框 （单独）=================================================================
' --- 公共变量 申明...为 CCommonDialog 服务！！
Public IsReadOnlyChecked As Boolean ' 指示是否选定只读复选框
Public WhichStyle As DialogStyle ' 对话框风格，打开？保存？字体？颜色？
' 特别特别注意：图片框设计时必须有图片，否则第二次弹出对话框时图片框消失？！！！且窗体上要放两个空的图片框（不作任何事，当摆设！！！）
Public m_picLogoPicture As PictureBox ' 程序标志图片框图片
Public m_picPreviewPicture As PictureBox ' 预览图片框图片
Public m_ppLogoPosition As PreviewPosition ' 程序标志图片框位置
Public m_ppPreviewPosition As PreviewPosition ' 预览图片框位置
Public m_dlgStartUpPosition As StartUpPositionConstants ' 对话框启动位置？
Public m_blnHideControls(0 To 8) As Boolean ' 是否隐藏对话框上的控件？（可去掉）
Public m_strControlsCaption(0 To 6) As String ' 对话框上的控件的文字？（可去掉）
' ################################################################################################
' 回调函数，用来截取消息，让动态创建的控件可以响应消息！（注意：是截取对话框消息！）
' ################################################################################################
Private Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' 确定接收到的是什么消息
Select Case iMsg
Case WM_COMMAND ' 单击
Dim I As Integer
For I = 0 To 2
If lParam = hWndButtonPlay(I) Then Call B3Button_Click(I)
Next I
' Case WM_LBUTTONDOWN ' 鼠标左键按下
' Debug.Print "WM_LBUTTONDOWN " & lParam
End Select
' 如果不是我们需要的消息，则传递给原来的窗体函数处理
WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
End Function
' 设置开始和结束的两个过程！！！
Private Sub CDHook(ByVal hWnd As Long)
' 整个procOld变量用来存储窗口的原始参数，以便恢复
' 调用了 SetWindowLong 函数，它使用了 GWL_WNDPROC 索引来创建窗口类的子类，通过这样设置
' 操作系统发给窗体的消息将由回调函数 (WindowProc) 来截取， AddressOf是关键字取得函数地址
procOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
' AddressOf是一元运算符，它在过程地址传送到 API 过程之前，先得到该过程的地址
End Sub
Private Sub CDUnHook(ByVal hWnd As Long)
' 此句关键，把窗口（不是窗体，而是具有句柄的任一控件）的属性复原
Call SetWindowLong(hWnd, GWL_WNDPROC, procOld)
End Sub
' ################################################################################################
' 回调函数，用来截取消息，让动态创建的控件可以响应消息！
' ################################################################################################
' 回调函数，对话框显示时要使用！！！
Public Function CDCallBackFun(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo CDCallBack_Error
' Debug.Print "&H" + Hex$(hWnd); ":",
Dim retV As Long ' 函数返回值？！
' 取得父窗体句柄？（仅是打开、保存对话框句柄？！，字体时，hWnd 是对话框句柄！！）
Dim hWndParent As Long: hWndParent = GetParent(hWnd)
' 判断消息，检测是否为需处理的消息
Select Case uMsg
Case WM_INITDIALOG ' 对话框初始化时，
Debug.Print "WM_INITDIALOG", "&H" + Hex(wParam), "&H" + Hex(lParam)
' 私有变量初始化！
procOld = 0: hWndTextView = 0: strSelFile = ""
hWndButtonPlay(0) = 0: hWndButtonPlay(1) = 0: hWndButtonPlay(2) = 0
' 显示对话框之前。自定义字体对话框外观。
CDHook hWndParent ' 回调函数，用来截取消息，让动态创建的控件可以响应消息！
If WhichStyle = ssFont Then CustomizeFontDialog hWnd ' 初始化字体对话框
If WhichStyle = ssColor Then setDlgStartUpPosition hWnd, hWndParent ' 初始化颜色对话框，只需改启动位置！
' 判断有没有设置两个图片框？？！！
' 修正了没有设置预览或程序标志图片框时，对话框位置无法调整的问题；
If m_picLogoPicture Is Nothing Then m_ppLogoPosition = ppNone
If m_picPreviewPicture Is Nothing Then m_ppPreviewPosition = ppNone
Case WM_NOTIFY ' 对话框变化时，仅对打开/保存对话框！！！
retV = CDNotify(hWndParent, lParam)
Case WM_COMMAND ' 仅单击 字体、颜色对话框 上的控件？！
'Debug.Print LOWORD(wParam); HIWORD(wParam)
Dim L As Long: L = LOWORD(wParam)
If WhichStyle = ssFont Then
If L = enumFONT_CTL.btn_Apply _
Or L = enumFONT_CTL.cbo_FontName Or L = enumFONT_CTL.cbo_BoldItalic _
Or L = enumFONT_CTL.cbo_Size Or L = enumFONT_CTL.btn_Strikethrough _
Or L = enumFONT_CTL.btn_Underline Or L = enumFONT_CTL.cbo_Color _
Or L = enumFONT_CTL.cbo_Charset Then ' lParam 控件句柄？ wParam 参数=控件 ID ！！！
' 设置字体对话框预览。（有些单击不管用要双击，前3个cbo！）
mSetFontPreview hWnd
ElseIf L = enumFONT_CTL.btn_Help Then ' 字体对话框帮助！
MsgBox "字体对话框帮助！", vbInformation
'Else ' 其他单击，发送消息单击 应用 按钮！还是不行！？
' SendMessage GetDlgItem(hWnd, enumFONT_CTL.btn_Apply), WM_LBUTTONDOWN, 0&, 0&
End If
ElseIf WhichStyle = ssColor Then
If L = enumFONT_CTL.btn_Help Then ' 颜色对话框帮助！几个按钮通用一个ID值？！
MsgBox "颜色对话框帮助！", vbInformation
End If
End If
Case WM_DESTROY ' 对话框销毁时，
Debug.Print "WM_DESTROY", "&H" + Hex(wParam), "&H" + Hex(lParam)
' 取得 是否选定只读复选框
Dim hWndButton As Long: hWndButton = GetDlgItem(hWndParent, ID_ReadOnly)
IsReadOnlyChecked = SendMessage(hWndButton, BM_GETCHECK, ByVal 0&, ByVal 0&)
' 设置图片框到原来的父窗口，（桌面句柄=0，恢复到其原来的父，再次弹出对话框时图片消失了！！！）
' 如果窗体上有两个图片框，再次弹出时就能正常显示？！！！）
If Not m_picLogoPicture Is Nothing Then ' 若不加判断，会引发错误！
ShowWindow m_picLogoPicture.hWnd, SW_HIDE
Call SetParent(m_picLogoPicture.hWnd, Val(m_picLogoPicture.Tag))
End If
If Not m_picPreviewPicture Is Nothing Then
ShowWindow m_picPreviewPicture.hWnd, SW_HIDE
Call SetParent(m_picPreviewPicture.hWnd, Val(m_picPreviewPicture.Tag))
End If
' 停止声音 停止声音，因为前面可能在播放！！！！' 注意：这里不直接调用 B3Button_Click 2 ！
PlayAudio strSelFile, 2
sndPlaySound vbNullString, 0 ' 停止 Wave 文件播放。
' 销毁创建的控件
If hWndTextView Then DestroyWindow hWndTextView
If hWndButtonPlay(0) Then DestroyWindow hWndButtonPlay(0) ': hWndButtonPlay(0) = 0
If hWndButtonPlay(1) Then DestroyWindow hWndButtonPlay(1) ': hWndButtonPlay(1) = 0
If hWndButtonPlay(2) Then DestroyWindow hWndButtonPlay(2) ': hWndButtonPlay(2) = 0
If hWndFontPreview Then DestroyWindow hWndFontPreview ' 字体预览文本框
' 回调函数，用来截取消息，让动态创建的控件可以响应消息！
CDUnHook hWndParent
' 释放物理内存！！！不知为什么，调出对话框后，程序占用的物理内存大增！！！
SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1&
' Case Else
' Debug.Print "Else ", "&H" + Hex(wParam), "&H" + Hex(lParam)
End Select
CDCallBackFun = retV ' 函数返回值？！
On Error GoTo 0
Exit Function
CDCallBack_Error:
Debug.Print "CDCallBackFun Error " & Err.Number & " (" & Err.Description & ")"
Resume Next
End Function
' 对话框变化时，进行调整。仅对打开/保存对话框！！！
Private Function CDNotify(ByVal hWndParent As Long, ByVal lParam As Long) As Long
Dim hToolBar As Long ' 对话框上工具栏句柄
Dim rcTB As RECT ' 工具栏矩形
Dim pt As POINTAPI, W As Long, H As Long
Dim rcDlg As RECT ' 对话框矩形
Dim picLeft As Long, picTop As Long ' 图片框位置坐标，两个图片框相互影响，一个移动时要判断另一个的位置！
' == 中间最大的列表框矩形，图片框 Left Top 位置的基准点。。。
Dim hWndControl As Long, rcList0 As RECT, ptL As POINTAPI
hWndControl = GetDlgItem(hWndParent, ID_List0) ' 根据ID取得控件句柄
GetWindowRect hWndControl, rcList0 ' 取得控件矩形
ptL.X = rcList0.Left: ptL.y = rcList0.Top
ScreenToClient hWndParent, ptL ' ptL经过转化后才能得到想要的结果！
Dim hdr As NMHDR
Call CopyMemory(hdr, ByVal lParam, LenB(hdr))
Select Case hdr.code
Case CDN_InitDone ' 初始化完成，对话框将要显示时，
Debug.Print "InitDone"
' ===== 判断程序标志图片框位置，以调整对话框外观（尺寸及其上的控件位置）！
Dim OffSetX As Long, OffSetY As Long, stpX As Single, stpY As Single ' 对话框大小、控件偏移量（像素！）
stpX = Screen.TwipsPerPixelX: stpY = Screen.TwipsPerPixelY ' Twips 转化为 Pixels 要除以他们！
If m_ppLogoPosition = ppNone Then GoTo NoLogo ' 判断有没有设置两个图片框？？！！
OffSetX = m_picLogoPicture.Width \ stpX: OffSetY = m_picLogoPicture.Height \ stpY
Dim ClientRect As RECT ' ppBottom 时！取得对话框矩形，与其他都不同！不知为什么只有这样才行！！！？？？
Select Case m_ppLogoPosition
Case ppNone ' 无程序标志图片，不操作！
OffSetX = 0: OffSetY = 0
picLeft = 0: picTop = 0
Case ppLeft ' 程序标志图片 在左端，要移动对话框上原来的控件！
' 对话框上所有原始控件右移
CDMoveOriginControl hWndParent, ID_OK, OffSetX
CDMoveOriginControl hWndParent, ID_Cancel, OffSetX
CDMoveOriginControl hWndParent, ID_Help, OffSetX
CDMoveOriginControl hWndParent, ID_ReadOnly, OffSetX
CDMoveOriginControl hWndParent, ID_FolderLabel, OffSetX
CDMoveOriginControl hWndParent, ID_FolderCombo, OffSetX
CDMoveOriginControl hWndParent, ID_ToolBarWin2K, OffSetX
CDMoveOriginControl hWndParent, ID_List0, OffSetX
CDMoveOriginControl hWndParent, ID_FileNameLable, OffSetX
CDMoveOriginControl hWndParent, ID_FileTypeCombo0, OffSetX
CDMoveOriginControl hWndParent, ID_FileTypeLabel, OffSetX
CDMoveOriginControl hWndParent, ID_FileTypeComboC, OffSetX ' 新外观！移动对话框上文件名文本框，
CDMoveOriginControl hWndParent, ID_FileNameText, OffSetX
' 移动工具栏！工具栏（特别注意：无法通过 CDMoveOriginControl 函数移动！）
hToolBar = CDGetToolBarHandle(hWndParent)
GetWindowRect hToolBar, rcTB
pt.X = rcTB.Left
pt.y = rcTB.Top
ScreenToClient hWndParent, pt
MoveWindow hToolBar, pt.X + OffSetX, pt.y, rcTB.Right - rcTB.Left, rcTB.Bottom - rcTB.Top, True
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变宽度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left + OffSetX, rcDlg.Bottom - rcDlg.Top, True
' 设置程序标志图片
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picLogoPicture.Tag = SetParent(m_picLogoPicture.hWnd, hWndParent)
' 移动图片框，Top 位置固定，高度固定！
If m_ppPreviewPosition = ppLeft Then
picLeft = 2: picTop = 0
'ElseIf m_ppPreviewPosition = ppRight Then' 不需要判断！
ElseIf m_ppPreviewPosition = ppTop Then
picLeft = 2: picTop = m_picPreviewPicture.Height \ stpY
ElseIf m_ppPreviewPosition = ppBottom Then
picLeft = 2: picTop = m_picPreviewPicture.Height \ stpY
Else
picLeft = 2: picTop = 0
End If
MoveWindow m_picLogoPicture.hWnd, picLeft, 2, _
m_picLogoPicture.Width \ stpX, rcDlg.Bottom - rcDlg.Top + picTop - 29, True
' 加载图片
'm_picLogoPicture.PaintPicture m_picLogoPicture.Picture, 0, 0, m_picLogoPicture.ScaleWidth * 100, m_picLogoPicture.ScaleHeight
ShowWindow m_picLogoPicture.hWnd, SW_SHOW ' 显示图片框
Case ppRight
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变宽度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left + OffSetX, rcDlg.Bottom - rcDlg.Top, True
' 设置程序标志图片
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picLogoPicture.Tag = SetParent(m_picLogoPicture.hWnd, hWndParent)
' 移动图片框，，Top 位置固定，高度固定！
If m_ppPreviewPosition = ppLeft Then
picLeft = rcDlg.Right - rcDlg.Left + m_picPreviewPicture.Width \ stpX - 8: picTop = 0
ElseIf m_ppPreviewPosition = ppRight Then
picLeft = m_picPreviewPicture.Width \ stpX + rcDlg.Right - rcDlg.Left - 5: picTop = 0
ElseIf m_ppPreviewPosition = ppTop Then
picLeft = rcDlg.Right - rcDlg.Left - 8: picTop = m_picPreviewPicture.Height \ stpY
ElseIf m_ppPreviewPosition = ppBottom Then
picLeft = rcDlg.Right - rcDlg.Left - 8: picTop = m_picPreviewPicture.Height \ stpY
Else
picLeft = rcDlg.Right - rcDlg.Left - 8: picTop = 0
End If
MoveWindow m_picLogoPicture.hWnd, picLeft, 2, _
m_picLogoPicture.Width \ stpX, rcDlg.Bottom - rcDlg.Top + picTop - 29, True
' 加载图片
'm_picLogoPicture.PaintPicture m_picLogoPicture.Picture, 0, 0, m_picLogoPicture.ScaleWidth, m_picLogoPicture.ScaleHeight
ShowWindow m_picLogoPicture.hWnd, SW_SHOW ' 显示图片框
Case ppTop ' 程序标志图片 在顶端，要移动对话框上原来的控件！
' 对话框上所有原始控件下移
CDMoveOriginControl hWndParent, ID_OK, , OffSetY
CDMoveOriginControl hWndParent, ID_Cancel, , OffSetY
CDMoveOriginControl hWndParent, ID_Help, , OffSetY
CDMoveOriginControl hWndParent, ID_ReadOnly, , OffSetY
CDMoveOriginControl hWndParent, ID_FolderLabel, , OffSetY
CDMoveOriginControl hWndParent, ID_FolderCombo, , OffSetY
CDMoveOriginControl hWndParent, ID_ToolBarWin2K, , OffSetY
CDMoveOriginControl hWndParent, ID_List0, , OffSetY
CDMoveOriginControl hWndParent, ID_FileNameLable, , OffSetY
CDMoveOriginControl hWndParent, ID_FileTypeCombo0, , OffSetY
CDMoveOriginControl hWndParent, ID_FileTypeLabel, , OffSetY
CDMoveOriginControl hWndParent, ID_FileTypeComboC, , OffSetY ' 新外观！移动对话框上文件名文本框，
CDMoveOriginControl hWndParent, ID_FileNameText, , OffSetY
' 移动工具栏！工具栏（特别注意：无法通过 CDMoveOriginControl 函数移动！）
hToolBar = CDGetToolBarHandle(hWndParent)
GetWindowRect hToolBar, rcTB
pt.X = rcTB.Left
pt.y = rcTB.Top
ScreenToClient hWndParent, pt
MoveWindow hToolBar, pt.X, pt.y + OffSetY, rcTB.Right - rcTB.Left, rcTB.Bottom - rcTB.Top, True
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变高度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left, rcDlg.Bottom - rcDlg.Top + OffSetY, True
' 设置程序标志图片
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picLogoPicture.Tag = SetParent(m_picLogoPicture.hWnd, hWndParent) ' GetParent(m_picLogoPicture.hwnd)
' 移动图片框，Left 位置固定，宽度固定。picLeft + (rcDlg.Right - rcDlg.Left - m_picLogoPicture.Width \ stpX) \ 2 - 3
If m_ppPreviewPosition = ppLeft Then
picLeft = m_picPreviewPicture.Width \ stpX: picTop = 0
ElseIf m_ppPreviewPosition = ppRight Then ' 不需要判断！
picLeft = m_picPreviewPicture.Width \ stpX
'ElseIf m_ppPreviewPosition = ppTop Then
'ElseIf m_ppPreviewPosition = ppBottom Then
End If
MoveWindow m_picLogoPicture.hWnd, 5, picTop + 2, _
rcDlg.Right - rcDlg.Left + picLeft - 15, m_picLogoPicture.Height \ stpY, True
' 加载图片
'm_picLogoPicture.PaintPicture m_picLogoPicture.Picture, 0, 0, m_picLogoPicture.ScaleWidth, m_picLogoPicture.ScaleHeight
ShowWindow m_picLogoPicture.hWnd, SW_SHOW ' 显示图片框
Case ppBottom
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变高度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left, rcDlg.Bottom - rcDlg.Top + OffSetY, True
' 设置程序标志图片
Call GetClientRect(hWndParent, ClientRect) ' 用 rcDlg.Bottom 不行！！！
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picLogoPicture.Tag = SetParent(m_picLogoPicture.hWnd, hWndParent)
' 移动图片框，Left 位置固定，宽度固定。
If m_ppPreviewPosition = ppLeft Then
picLeft = m_picPreviewPicture.Width \ stpX: picTop = 0
ElseIf m_ppPreviewPosition = ppRight Then
picLeft = m_picPreviewPicture.Width \ stpX
ElseIf m_ppPreviewPosition = ppTop Then
picTop = m_picPreviewPicture.Height \ stpY: picLeft = 0
ElseIf m_ppPreviewPosition = ppBottom Then ' 这时，要移动标志到预览下面！
picTop = m_picPreviewPicture.Height \ stpY: picLeft = 0
End If
MoveWindow m_picLogoPicture.hWnd, 5, picTop + ClientRect.Bottom - OffSetY, _
rcDlg.Right - rcDlg.Left + picLeft - 15, m_picLogoPicture.Height \ stpY, True
' 加载图片
'm_picLogoPicture.PaintPicture m_picLogoPicture.Picture, 0, 0, m_picLogoPicture.ScaleWidth, m_picLogoPicture.ScaleHeight
ShowWindow m_picLogoPicture.hWnd, SW_SHOW ' 显示图片框
End Select
NoLogo:
' **********************************************************************************************************
' ===== 判断预览图片框位置，特别注意：要判断程序标志图片框位置？！！！！方法：？？？！！！
' 预览图片框位置固定一个值！！！大小在左右、上下分两种情况：分别固定高度、宽度！！！
If m_ppPreviewPosition = ppNone Then GoTo NoPreview ' 判断有没有设置两个图片框？？！！
OffSetX = m_picPreviewPicture.Width \ stpX: OffSetY = m_picPreviewPicture.Height \ stpY
Select Case m_ppPreviewPosition
Case ppNone
OffSetX = 0: OffSetY = 0
picLeft = 0: picTop = 0
Case ppLeft ' 预览图片框 在左端，要移动对话框上原来的控件！
' 重新取得 LIST控件矩形，可能在上面被移动了！
GetWindowRect hWndControl, rcList0
ptL.X = rcList0.Left: ptL.y = rcList0.Top
ScreenToClient hWndParent, ptL ' ptL经过转化后才能得到想要的结果！
' 对话框上所有原始控件右移
CDMoveOriginControl hWndParent, ID_OK, OffSetX
CDMoveOriginControl hWndParent, ID_Cancel, OffSetX
CDMoveOriginControl hWndParent, ID_Help, OffSetX
CDMoveOriginControl hWndParent, ID_ReadOnly, OffSetX
CDMoveOriginControl hWndParent, ID_FolderLabel, OffSetX
CDMoveOriginControl hWndParent, ID_FolderCombo, OffSetX
CDMoveOriginControl hWndParent, ID_ToolBarWin2K, OffSetX
CDMoveOriginControl hWndParent, ID_List0, OffSetX
CDMoveOriginControl hWndParent, ID_FileNameLable, OffSetX
CDMoveOriginControl hWndParent, ID_FileTypeCombo0, OffSetX
CDMoveOriginControl hWndParent, ID_FileTypeLabel, OffSetX
CDMoveOriginControl hWndParent, ID_FileTypeComboC, OffSetX ' 新外观！移动对话框上文件名文本框，
CDMoveOriginControl hWndParent, ID_FileNameText, OffSetX
' 移动工具栏！工具栏（特别注意：无法通过 CDMoveOriginControl 函数移动！）
hToolBar = CDGetToolBarHandle(hWndParent)
GetWindowRect hToolBar, rcTB
pt.X = rcTB.Left
pt.y = rcTB.Top
ScreenToClient hWndParent, pt
MoveWindow hToolBar, pt.X + OffSetX, pt.y, rcTB.Right - rcTB.Left, rcTB.Bottom - rcTB.Top, True
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变宽度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left + OffSetX, rcDlg.Bottom - rcDlg.Top, True
' 设置 预览图片框
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picPreviewPicture.Tag = SetParent(m_picPreviewPicture.hWnd, hWndParent)
' 移动图片框，Top 位置固定，高度固定！
picLeft = 5: picTop = ptL.y: W = 5
If m_ppLogoPosition = ppLeft Then
picLeft = m_picLogoPicture.Width \ stpX + 5
'ElseIf m_ppLogoPosition = ppRight Then' 不需要判断！
'ElseIf m_ppLogoPosition = ppTop Then
'ElseIf m_ppLogoPosition = ppBottom Then
End If
MoveWindow m_picPreviewPicture.hWnd, picLeft, picTop, _
m_picPreviewPicture.Width \ stpX - W, rcList0.Bottom - rcList0.Top, True
' 加载图片
'm_picPreviewPicture.PaintPicture m_picPreviewPicture.Picture, 0, 0, m_picPreviewPicture.ScaleWidth, m_picPreviewPicture.ScaleHeight
myPaintPicture m_picPreviewPicture, False
ShowWindow m_picPreviewPicture.hWnd, SW_SHOW ' 显示图片框
Case ppRight
' 重新取得 LIST控件矩形，可能在上面被移动了！
GetWindowRect hWndControl, rcList0
ptL.X = rcList0.Left: ptL.y = rcList0.Top
ScreenToClient hWndParent, ptL ' ptL经过转化后才能得到想要的结果！
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变宽度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left + OffSetX, rcDlg.Bottom - rcDlg.Top, True
' 设置 预览图片框
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picPreviewPicture.Tag = SetParent(m_picPreviewPicture.hWnd, hWndParent)
' 移动图片框，Right 位置固定，高度固定！
If m_ppLogoPosition = ppRight Then
picLeft = rcDlg.Right - rcDlg.Left - 5 - m_picLogoPicture.Width \ stpX: picTop = 0
Else
picLeft = rcDlg.Right - rcDlg.Left - 8: picTop = 0
End If
MoveWindow m_picPreviewPicture.hWnd, picLeft, ptL.y, _
m_picPreviewPicture.Width \ stpX - 3, rcList0.Bottom - rcList0.Top, True
' 加载图片
'm_picPreviewPicture.PaintPicture m_picPreviewPicture.Picture, 0, 0, m_picPreviewPicture.ScaleWidth, m_picPreviewPicture.ScaleHeight
myPaintPicture m_picPreviewPicture, False
ShowWindow m_picPreviewPicture.hWnd, SW_SHOW ' 显示图片框
Case ppTop ' 预览图片框 在顶端，要移动对话框上原来的控件！
' 重新取得 LIST控件矩形，可能在上面被移动了！
GetWindowRect hWndControl, rcList0
ptL.X = rcList0.Left: ptL.y = rcList0.Top
ScreenToClient hWndParent, ptL ' ptL经过转化后才能得到想要的结果！
' 对话框上所有原始控件下移
CDMoveOriginControl hWndParent, ID_OK, , OffSetY
CDMoveOriginControl hWndParent, ID_Cancel, , OffSetY
CDMoveOriginControl hWndParent, ID_Help, , OffSetY
CDMoveOriginControl hWndParent, ID_ReadOnly, , OffSetY
CDMoveOriginControl hWndParent, ID_FolderLabel, , OffSetY
CDMoveOriginControl hWndParent, ID_FolderCombo, , OffSetY
CDMoveOriginControl hWndParent, ID_ToolBarWin2K, , OffSetY
CDMoveOriginControl hWndParent, ID_List0, , OffSetY
CDMoveOriginControl hWndParent, ID_FileNameLable, , OffSetY
CDMoveOriginControl hWndParent, ID_FileTypeCombo0, , OffSetY
CDMoveOriginControl hWndParent, ID_FileTypeLabel, , OffSetY
CDMoveOriginControl hWndParent, ID_FileTypeComboC, , OffSetY ' 新外观！移动对话框上文件名文本框，
CDMoveOriginControl hWndParent, ID_FileNameText, , OffSetY
' 移动工具栏！工具栏（特别注意：无法通过 CDMoveOriginControl 函数移动！）
hToolBar = CDGetToolBarHandle(hWndParent)
GetWindowRect hToolBar, rcTB
pt.X = rcTB.Left
pt.y = rcTB.Top
ScreenToClient hWndParent, pt
MoveWindow hToolBar, pt.X, pt.y + OffSetY, rcTB.Right - rcTB.Left, rcTB.Bottom - rcTB.Top, True
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变高度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left, rcDlg.Bottom - rcDlg.Top + OffSetY, True
' 设置程序标志图片
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picPreviewPicture.Tag = SetParent(m_picPreviewPicture.hWnd, hWndParent)
' 移动图片框，Left 位置固定，宽度固定！
If m_ppLogoPosition = ppLeft Then
picLeft = m_picLogoPicture.Width \ stpX + 5: picTop = 2: W = picLeft + 17
ElseIf m_ppLogoPosition = ppRight Then
picLeft = 5: picTop = 2: W = m_picLogoPicture.Width \ stpX + 19
ElseIf m_ppLogoPosition = ppTop Then
picLeft = 5: picTop = m_picLogoPicture.Height \ stpY + 2: W = 15
ElseIf m_ppLogoPosition = ppBottom Then
picLeft = 5: picTop = 2: W = 15
End If
MoveWindow m_picPreviewPicture.hWnd, picLeft, picTop, _
rcDlg.Right - rcDlg.Left - W, m_picPreviewPicture.Height \ stpY, True
' 加载图片
'm_picPreviewPicture.PaintPicture m_picPreviewPicture.Picture, 0, 0, m_picPreviewPicture.ScaleWidth, m_picPreviewPicture.ScaleHeight
myPaintPicture m_picPreviewPicture, False
ShowWindow m_picPreviewPicture.hWnd, SW_SHOW ' 显示图片框
Case ppBottom
' 重新取得 LIST控件矩形，可能在上面被移动了！
GetWindowRect hWndControl, rcList0
ptL.X = rcList0.Left: ptL.y = rcList0.Top
ScreenToClient hWndParent, ptL ' ptL经过转化后才能得到想要的结果！
' 改变对话框大小，！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形，再移动（实际只改变高度！）
MoveWindow hWndParent, rcDlg.Left, rcDlg.Top, rcDlg.Right - rcDlg.Left, rcDlg.Bottom - rcDlg.Top + OffSetY, True
' 设置 预览图片框
Call GetClientRect(hWndParent, ClientRect) ' 用 rcDlg.Bottom 不行！！！
' 设置新的，并保存图片框原来的父窗口句柄？！
m_picPreviewPicture.Tag = SetParent(m_picPreviewPicture.hWnd, hWndParent)
' 移动图片框，Left 位置固定，宽度固定！
picTop = ClientRect.Bottom - OffSetY - 2
If m_ppLogoPosition = ppLeft Then
picLeft = m_picLogoPicture.Width \ stpX + 5: W = picLeft + 7
ElseIf m_ppLogoPosition = ppRight Then
picLeft = 5: W = m_picLogoPicture.Width \ stpX + 12
ElseIf m_ppLogoPosition = ppTop Then
picLeft = 5: W = 10
ElseIf m_ppLogoPosition = ppBottom Then
picLeft = 5: picTop = ClientRect.Bottom - OffSetY - m_picLogoPicture.Height \ stpY - 2
W = 10
End If
MoveWindow m_picPreviewPicture.hWnd, picLeft, picTop, _
ClientRect.Right - ClientRect.Left - W, m_picPreviewPicture.Height \ stpY, True
' 加载图片
'm_picPreviewPicture.PaintPicture m_picPreviewPicture.Picture, 0, 0, m_picPreviewPicture.ScaleWidth, m_picPreviewPicture.ScaleHeight
myPaintPicture m_picPreviewPicture, False
ShowWindow m_picPreviewPicture.hWnd, SW_SHOW ' 显示图片框
End Select
NoPreview:
' 设置对话框启动位置？只判断屏幕中心和所有者中心，其他不管！
GetWindowRect hWndParent, rcDlg ' 取得对话框矩形
W = rcDlg.Right - rcDlg.Left: H = rcDlg.Bottom - rcDlg.Top ' 对话框宽、高
If m_dlgStartUpPosition = vbStartUpScreen Then ' 再移动。屏幕中心
MoveWindow hWndParent, (Screen.Width \ stpX - W) \ 2, (Screen.Height \ stpY - H) \ 2, W, H, True
ElseIf m_dlgStartUpPosition = vbStartUpOwner Then ' 所有者中心