1 /******************************************************************************
2 *
3 * Copyright (C) 2004-2007, The Gentee Group. All rights reserved.
4 * This file is part of the Gentee open source project - http://www.gentee.com.
5 *
6 * THIS FILE IS PROVIDED UNDER THE TERMS OF THE GENTEE LICENSE ("AGREEMENT").
7 * ANY USE, REPRODUCTION OR DISTRIBUTION OF THIS FILE CONSTITUTES RECIPIENTS
8 * ACCEPTANCE OF THE AGREEMENT.
9 *
10 * ID: vis.form 17.07.07 0.0.A.
11 *
12 * Author: Alexander Krivonogov ( gentee )
13 *
14 ******************************************************************************/
15 /* Компонента vForm, порождена от vCtrl
16 События
17
18 */
19 /*define
20 {
21 ETDT_DISABLE = 0x00000001
22 ETDT_ENABLE = 0x00000002
23 ETDT_USETABTEXTURE = 0x00000004
24 ETDT_ENABLETAB = 0x00000006
25 }
26 */
27 global
28 {
29 uint isThemed
30 uint pIsAppThemed
31 //uint pEnableThemeDialogTexture
32 uint pDrawThemeParentBackground
33 uint pOpenThemeData
34 uint pDrawThemeBackground
35 //uint pDrawThemeText
36 arr ThemeData[ $theme_max ] of uint
37 }
38
39 type VS_FIXEDFILEINFO {
40 uint dwSignature
41 uint dwStrucVersion
42 uint dwFileVersionMS
43 uint dwFileVersionLS
44 uint dwProductVersionMS
45 uint dwProductVersionLS
46 uint dwFileFlagsMask
47 uint dwFileFlags
48 uint dwFileOS
49 uint dwFileType
50 uint dwFileSubtype
51 uint dwFileDateMS
52 uint dwFileDateLS
53 }
54
55 import "version.dll"
56 {
57 uint GetFileVersionInfoSizeW( uint, uint ) -> GetFileVersionInfoSize
58 uint GetFileVersionInfoW( uint, uint, uint, uint ) -> GetFileVersionInfo
59 uint VerQueryValueW( uint, uint, uint, uint ) -> VerQueryValue
60 }
61
62 func uint IsXPStyle()
63 {
64 ustr filename = "comctl32.dll"
65 uint res, size
66 buf info
67 uint pfi
68
69 if size = GetFileVersionInfoSize( filename.ptr(), &res )
70 {
71 info.expand( size )
72 if GetFileVersionInfo( filename.ptr(), &res, size, info.ptr()) &&
73 VerQueryValue( info.ptr(), "\\".ustr().ptr(), &pfi, &res )
74 {
75 return pfi->VS_FIXEDFILEINFO.dwFileVersionMS >= 0x00060000
76 }
77 }
78 return 0
79 }
80
81 func loadthemefuncs <entry>
82 {
83 uint hinstdll
84
85 isThemed = 0
86 if (hinstdll = LoadLibrary("UxTheme.dll".ptr()))
87 {
88 //pIsAppThemed = GetProcAddress(hinstdll, "IsAppThemed".ptr())
89 uint pIsThemeActive = GetProcAddress(hinstdll, "IsThemeActive".ptr())
90
91 //GetProcAddress(hinstdll, "EnableTheming".ptr() )->stdcall(1)
92 //pEnableThemeDialogTexture = GetProcAddress(hinstdll, "EnableThemeDialogTexture".ptr())
93 if pDrawThemeParentBackground = GetProcAddress(hinstdll, "DrawThemeParentBackground".ptr())
94 {
95 pDrawThemeBackground = GetProcAddress(hinstdll, "DrawThemeBackground".ptr())
96 pOpenThemeData = GetProcAddress(hinstdll, "OpenThemeData".ptr())
97 //pDrawThemeText = GetProcAddress(hinstdll, "DrawThemeText".ptr())
98
99 isThemed = pIsThemeActive->stdcall() && IsXPStyle()
100 //if pIsAppThemed
101 {
102 //isThemed = pIsAppThemed->stdcall()
103 }
104 //isThemed = pIsThemeActive->stdcall() && pIsAppThemed->stdcall()
105 //print( "isThemed \(isThemed)\n" )
106 }
107 //FreeLibrary(hinstDll)
108 }
109 //print( "isThemed = \(isThemed)\n" )
110 }
111
112 func themeinit ()
113 {
114 if isThemed
115 {
116 ThemeData[$theme_button] = pOpenThemeData->stdcall( 0, "button".ustr().ptr() )
117 ThemeData[$theme_toolbar] = pOpenThemeData->stdcall( 0, "toolbar".ustr().ptr() )
118 //ThemeData[$theme_menu] = pOpenThemeData->stdcall( 0, "menu".ustr().ptr() )
119
120 }
121 }
122
123
124 /*
125 func uint IsAppThemed()
126 {
127 if pIsAppThemed
128 {
129 return pIsAppThemed->stdcall()
130 }
131 return 0
132 }
133
134 func uint EnableThemeDialogTexture( uint hwnd, uint flag )
135 {
136 if pEnableThemeDialogTexture
137 {
138 return pEnableThemeDialogTexture->stdcall( hwnd, flag )
139 }
140 return 0
141 }
142
143 func setxpstyle( uint hwnd )
144 {
145 if !isthemefuncs
146 {
147 loadthemefuncs()
148 }
149 if IsAppThemed()
150 {print( "Themed
151 \(EnableThemeDialogTexture( hwnd, $ETDT_USETABTEXTURE | $ETDT_ENABLETAB ))\n" )
152 }
153 }*/
154
155 include {
156 //"app.g"
157 "ctrl.g"
158 }
159
160 type vForm <inherit = vCtrl>
161 {
162 //arr components[] of uint
163 locustr pCaption
164 uint curtab
165 uint flgpopup
166
167 uint lng
168 uint pResult
169 uint pBorder
170 uint pWindowState
171 ustr pIconName
172
173 uint fCreate
174 uint fLoad
175
176 uint pMenu
177
178 evQuery OnCloseQuery
179 evEvent OnCreate
180 evEvent OnDestroy
181 evEvent OnLanguage
182
183 uint hwndTip
184 }
185
186 define <export>{
187 mForm = $vCtrl_last
188 vForm_last
189 }
190
191 define <export>{
192 //Стили рамки формы Border
193 fbrdNone = 0
194 fbrdSizeable = 1
195 fbrdDialog = 2
196 //Стили состояния окна WindowState
197 wsNormal = 0
198 wsMaximized = 1
199 wsMinimized = 2
200 }
201
202 //flgpopup
203 define
204 {
205 FPOPUP = 1
206 FMODAL = 2
207 }
208
209
210 method uint vCtrl.NextCtrl( uint curctrl, uint plevel, uint flgbrother )
211 {
212 uint owner
213 uint ctrl as curctrl->vVirtCtrl
214 uint cidx
215
216 if !&ctrl
217 {
218 ctrl as this
219 plevel->uint++
220 }
221 elif ctrl.TypeIs( vCtrl) && ctrl->vCtrl.pCtrls/**ctrl.ctrls*/ && !flgbrother
222 {
223
224 ctrl as ctrl.Comps[0]->vVirtCtrl//ctrls[0]->vCtrl
225 plevel->uint++
226 }
227 else
228 {
229 while &ctrl != &this
230 {
231 owner as ctrl.pOwner->vCtrl
232 cidx = ctrl.cidx + 1
233 if cidx < owner.pCtrls/**owner.ctrls*/
234 {
235 ctrl as owner.Comps[cidx]//ctrls[cidx]
236 goto end
237 }
238 ctrl as owner
239 plevel->uint--
240 }
241 ctrl as 0
242 }
243 label end
244 return &ctrl
245 }
246
247 method uint vCtrl.PrevCtrl( uint curctrl, uint plevel, uint flgbrother )
248 {
249 uint owner
250 uint ctrl as curctrl->vVirtCtrl
251 int cidx
252
253 if !&ctrl
254 {
255 ctrl as this
256 plevel->uint++
257 }
258 elif ctrl.TypeIs( vCtrl) && ctrl->vCtrl.pCtrls/**ctrl.ctrls*/ && !flgbrother
259 {
260 ctrl as ctrl.Comps[ctrl->vCtrl.pCtrls-1]->vVirtCtrl/*ctrls[*ctrl.ctrls-1]->vCtrl*/
261 plevel->uint++
262 }
263 else
264 {
265 while &ctrl != &this//ctrl.p_owner//&ctrl != &this
266 {
267 owner as ctrl.pOwner->vCtrl
268 cidx = ctrl.cidx - 1
269 if cidx >= 0
270 {
271 ctrl as owner.Comps[cidx]//ctrls[cidx]
272 goto end
273 }
274 ctrl as owner
275 plevel->uint--
276 }
277 ctrl as 0
278 }
279 label end
280 return &ctrl
281 }
282
283 method vCtrl.mInsert <alias=vCtrl_mInsert>( vComp newcomp )
284 {
285 if newcomp.TypeIs( vVirtCtrl )
286 {
287 uint ctrl as newcomp->vVirtCtrl
288 uint flgremove
289 if this.pCanContain
290 {
291 //print( "insert \(this.Name) \(this.TypeName) <-\(ctrl.Name) \(ctrl.TypeName) \(this.pCtrls)\n" )
292 if ctrl.pOwner
293 {
294 this.Virtual( $mRemove, ctrl )
295 ctrl.pOwner = &this
296 ctrl.form = this.GetForm()
297 flgremove = 1
298 }
299 else
300 {
301 ctrl.pOwner = &this
302 ctrl.form = this.GetForm()
303 ctrl.Virtual( $mCreateWin )
304 }
305 //ctrl.Virtual( $mSetOwner )
306
307 ctrl.cidx = this.pCtrls
308 this.Comps.insert( ctrl.cidx )
309 this.Comps[ ctrl.cidx ] = &ctrl
310 this.pCtrls++
311 if ctrl.TypeIs( vCtrl )
312 {
313 ctrl as vCtrl
314 if flgremove
315 {
316 SetWindowLong( ctrl.hwnd, $GWL_STYLE, GetWindowLong( ctrl.hwnd, $GWL_STYLE ) | $WS_CHILD )
317 SetParent( ctrl.hwnd, this.hwnd )
318 }
319 if !ctrl.TypeIs( vForm ) || !ctrl->vForm.flgpopup: BringWindowToTop( ctrl.hwnd )
320 }
321 ctrl.Virtual( $mSetOwner, &this )
322 }
323 }
324 else
325 {
326 this->vComp.mInsert( newcomp )
327 }
328 }
329
330
331 method vForm.nexttab( uint flgreverse )
332 {
333 uint level
334 uint curtab as this.curtab->vCtrl
335 uint flgbrother, flgstart
336 uint mainform
337 while 1
338 {
339 if curtab as ?(flgreverse,
340 this.PrevCtrl( &curtab, &level, flgbrother )->vCtrl,
341 this.NextCtrl( &curtab, &level, flgbrother )->vCtrl )
342 {
343 //print( "curtab \(curtab.Name)\n" )
344 if curtab.TypeIs( vCtrl ) && curtab.Visible && curtab.Enabled && !curtab.p_designing
345 {
346 if curtab.pTabStop : break
347 flgbrother = 0
348 }
349 else : flgbrother = 1
350 }
351 else
352 {
353 if flgstart : break
354 flgstart = 1
355 }
356 }
357 //print( "nexttabe \(&curtab)\n" )
358 if &curtab {
359 SetFocus( curtab.hwnd )
360 }
361
362 }
363
364
365 method uint vComp.GetForm()
366 {
367 uint cur as this
368 while &cur && !cur.TypeIs( vForm )
369 {
370 cur as cur.Owner
371 }
372 return &cur //->vForm
373 }
374
375 method uint vComp.GetMainForm()
376 {
377 uint cur as this
378 while &cur && ( !cur.TypeIs( vForm ) || ( cur->vForm.Owner && cur->vForm.flgpopup != $FMODAL ))
379 {
380 cur as cur.Owner
381 }
382 return &cur //->vForm
383 }
384
385 method vCtrl.SetFocus()
386 {
387 SetFocus( this.hwnd )
388 if !.pTabStop || !.pVisible || !.pEnabled
389 {
390 .GetMainForm()->vForm.nexttab( 0 )
391 }
392 }
393
394 /* Метод iUpdateCaption
395 Связывает заголовок окна с визуальным отображением
396 */
397 method vForm.iUpdateCaption
398 {
399 SetWindowText( this.hwnd, this.pCaption.Text(this).ptr() )
400 }
401
402 property ustr vForm.Caption<result>
403 {
404 result = this.pCaption.Value
405 }
406
407 property vForm.Caption( ustr val )
408 {
409 if this.pCaption.Value != val
410 {
411 this.pCaption.Value = val
412 .iUpdateCaption()
413 }
414 }
415
416
417 /* Свойство uint Border - Get Set
418 */
419 property uint vForm.Border()
420 {
421 return this.pBorder
422 }
423
424 property vForm.Border( uint val )
425 {
426 uint style
427
428 if this.pBorder != val
429 {
430 this.pBorder = val
431 ifdef !$DESIGNING {
432 .Virtual( $mReCreateWin )
433 }
434 // print( "val \(val )\n" )
435 // .SetStyle( $WS_OVERLAPPEDWINDOW, ?( val == $fbrdNone, 0, 1 ) )
436 /*style = GetWindowLong( this.hwnd, $GWL_EXSTYLE )
437 style &= ~( $WS_EX_STATICEDGE | $WS_EX_WINDOWEDGE | $WS_EX_CLIENTEDGE |
438 $WS_EX_DLGMODALFRAME)
439 switch val
440 {
441 case $brdLowered, $brdRaised : style |= $WS_EX_STATICEDGE
442 case $brdDblRaised : style |= $WS_EX_DLGMODALFRAME
443 case $brdDblLowered : style |= $WS_EX_CLIENTEDGE
444 }
445 SetWindowLong( this.hwnd, $GWL_EXSTYLE, style )
446 SetWindowPos( this.hwnd, 0, 0, 0, 0, 0, $SWP_FRAMECHANGED |
447 $SWP_NOACTIVATE | $SWP_NOZORDER | $SWP_NOMOVE | $SWP_NOSIZE )*/
448 }
449 }
450
451 /* Свойство uint WindowState - Get Set
452 */
453 property uint vForm.WindowState()
454 {
455 return this.pWindowState
456 }
457
458 property vForm.WindowState( uint val )
459 {
460 uint style
461
462 if this.pWindowState != val
463 {
464 this.pWindowState = val
465 .Virtual( $mSetVisible )
466 }
467 }
468
469 /* Свойство ustr IconName - Get Set
470 Имя иконки окна
471 */
472 method vForm.iUpdateIcon()
473 {
474 str sname = .pIconName
475 arrstr path
476 sname.split( path, '[', $SPLIT_EMPTY )
477 uint im as this.GetImage( path[0].ustr() )
478 if &im
479 {
480 im.hImage
481 .WinMsg( $WM_SETICON, 0, im.hImage )
482 uint im as this.GetImage( path[0].ustr() + "[1]" )
483 .WinMsg( $WM_SETICON, 1, im.hImage )
484 }
485 }
486
487 property ustr vForm.IconName <result> ()
488 {
489 result = this.pIconName
490 }
491
492 property vForm.IconName( ustr val )
493 {
494 if this.pIconName != val
495 {
496 this.pIconName = val
497 .iUpdateIcon()
498 }
499 }
500
501
502 method vForm vForm.init( )
503 {
504 this.pTypeId =vForm
505 this.pCanContain = 1
506 this.loc.width = 600
507 this.loc.height = 400
508 this.pBorder = $fbrdSizeable
509 return this
510 }
511
512 property uint vForm.Result()
513 {
514 return .pResult
515 }
516
517 property vForm.Result( uint val )
518 {
519 if .flgpopup = $FPOPUP && val
520 {
521 .pResult = val
522 //.WinMsg( $WM_CLOSE )
523 }
524 }
525
526 method vForm vForm.mCreateWin <alias=vForm_mCreateWin>( )
527 {
528 //print( "win1 \(this.pOwner)\n" )
529 //print( "form init \( this.f_defproc ) \( ?(this.p_owner , this.p_owner->vCtrl.hwnd, 0 ))\n " )
530 //print( "popup = \(this.flgpopup )\n" )
531 uint style = $WS_CLIPSIBLINGS | $WS_CLIPCHILDREN | 0x40 | $WS_TABSTOP
532 ifdef $DESIGNING {
533 style |= $WS_OVERLAPPEDWINDOW
534 }
535 else {
536 if this.pBorder == $fbrdSizeable : style |= $WS_OVERLAPPEDWINDOW
537 elif this.pBorder == $fbrdDialog : style |= $WS_DLGFRAME | $WS_OVERLAPPED
538 }
539 .CreateWin( "GVForm".ustr(), /*0x00010400*//*0*/$WS_EX_CONTROLPARENT,
540 /*0x94c800c4*/?( this.pOwner, ?( this.flgpopup, $WS_POPUP, $WS_CHILD), 0) |
541 style
542 )
543 //print( "WNDSTART = \(&this) \( this.hwnd )\n" )
544 /*this.hwnd = CreateWindowEx( 0x00010000, "GVForm".ustr().ptr(), "".ustr().ptr(),
545 ?( this.p_owner,$WS_CHILD,0) |$WS_CLIPSIBLINGS | $WS_CLIPCHILDREN | $WS_OVERLAPPEDWINDOW | $WS_OVERLAPPED | $WS_SYSMENU , 0, 0,
546 500, 500, ?( this.p_owner, this.p_owner->vCtrl.hwnd, 0 ), 0, 0, &this )*/
547 //setxpstyle( this.hwnd )
548 SCROLLINFO sci
549 sci.cbSize = sizeof( SCROLLINFO )
550 sci.fMask = 0x17
551 sci.nMin = 0
552 sci.nMax = 500
553 sci.nPage = 30
554 sci.nPos = 100
555
556 this.prevwndproc = -1
557 this->vCtrl.mCreateWin()
558 //&DefWindowProc
559 //sci.nTrackPos
560 //SetScrollInfo( this.hwnd, 1, sci, 1)
561
562 //this.f_defproc = getid( "@defproc", %{this.p_typeid, eventn } )
563 this.pCanContain = 1
564 //win_customproc( this.hwnd, &vCtrlproc )
565 this.form = &this
566 if this.pOwner && !this.flgpopup
567 {
568 //print( "win2\n" )
569 SetParent( this.hwnd, this.pOwner->vCtrl.hwnd )
570 //ShowWindow( this.hwnd, $SW_SHOWNORMAL )
571 }
572
573
574 /*else
575 {
576 SetParent( this.hwnd, 0 )
577 }*/
578 /*if .pVisible
579 {
580 //print( "Show\n" )
581 ShowWindow( this.hwnd, $SW_SHOWNORMAL )
582 }*/
583 this.hwndTip = CreateWindowEx( 0, "tooltips_class32".ustr().ptr(), 0,
584 $WS_POPUP | 0x01 | 0x02, // | $TTS_NOPREFIX | $TTS_ALWAYSTIP,
585 0x80000000, 0x80000000,
586 0x80000000, 0x80000000, //$CW_USEDEFAULT,
587 0, 0, 0/*GetModuleHandle( 0 )*/, 0)
588 if !.fCreate && !.fLoad
589 {
590 .fLoad = 1
591 .Virtual( $mLoad )
592 .fLoad = 0
593 }
594
595 if .pVisible
596 {
597 ShowWindow( this.hwnd, $SW_SHOWNORMAL )
598 }
599
600 evparEvent ev
601 ev.sender = &this
602 if !.fCreate && !.fLoad
603 {
604 this.OnCreate.Run( ev )
605 .fCreate = 1
606 }
607 .iUpdateCaption()
608
609 .OnLanguage.Run( this )
610 .iUpdateIcon()
611
612
613 //print( "HWNDTIP = \(&this) \(this.hwnd) \(this.hwndTip)\n" )
614 return this
615 }
616
617 method vForm.mSetOwner <alias=vForm_mSetOwner>( vComp newowner )
618 {
619 //print( "form.setowner\n" )
620 if newowner && newowner.TypeIs( vApp )
621 {
622 //print( "form.setowner2\n" )
623 .pOwner = 0
624 }
625 else
626 {
627 .pOwner = &newowner
628 }
629 }
630
631 method vForm.mPosChanging <alias=vForm_mPosChanging>( eventpos evp )
632 {
633 if this.p_designing
634 {
635 //print( "posChanging\n" )
636
637
638 evp.loc.left = -this.Owner->vCtrl.clloc.left
639 evp.loc.top = -this.Owner->vCtrl.clloc.top
640
641
642 }
643 this->vCtrl.mPosChanging( evp )
644 }
645
646 method vForm.mSetVisible <alias=vForm_mSetVisible>( )
647 {
648 uint newstate
649 if !this.p_designing
650 {
651 newstate = $SW_SHOWNOACTIVATE//$SW_SHOWNORMAL
652 if .pWindowState == $wsMaximized
653 {
654 newstate = $SW_MAXIMIZE
655 }
656 elif .pWindowState == $wsMinimized
657 {
658
659 newstate = $SW_MINIMIZE
660 }
661
662
663 if !.pVisible : newstate = $SW_HIDE
664
665 ShowWindow( this.hwnd, newstate )
666 if .pVisible
667 {
668 BringWindowToTop( this.hwnd )
669 }
670 }
671 }
672
673 /*Виртуальный метод uint vCustomBtn.mLangChanged - Изменение текущего языка
674 */
675 method vForm.mLangChanged <alias=vForm_mLangChanged>()
676 {
677 .iUpdateCaption()
678 .iUpdateIcon()
679 this->vCtrl.mLangChanged()
680 .OnLanguage.Run( this )
681 }
682
683 include {
684 "menu.g"
685 "popupmenu.g"
686 }
687 /* Свойство uint Menu - Get Set
688 */
689 property vMenu vForm.Menu()
690 {
691 return this.pMenu->vMenu
692 }
693
694 property vForm.Menu( vMenu val )
695 {
696 if this.pMenu != &val
697 {
698 this.pMenu = &val
699 SetMenu( .hwnd, ?( &val, val.phMenu, 0 ) )
700 DrawMenuBar( .hwnd )
701 }
702 }
703
704 method vForm.mInsert <alias=vForm_mInsert>( vComp newcomp )
705 {
706 this->vCtrl.mInsert( newcomp )
707 if !.pMenu && newcomp.TypeIs( vMenu )
708 {
709 .Menu = newcomp->vMenu
710 }
711 }
712
713 method vForm.mRemove <alias=vForm_mRemove>( vComp remcomp )
714 {
715 this->vCtrl.mRemove( remcomp )
716 if .pMenu == &remcomp
717 {
718 .Menu = 0->vMenu
719 }
720 }
721
722 /*method uint vForm.mKey <alias=vForm_mKey> ( evparKey ev )
723 {
724
725 }*/
726
727
728 /*method vForm.mPosChanged <alias=vForm_mPosChanged>( evparEvent ev )
729 {
730 this->vCtrl.mPosChanged( ev )
731 //print( "form \( this.Left ) \( this.Top )\n" )
732 if this.p_designing
733 {
734 if this.Left || this.Top
735 {
736 this.Left = 0
737 this.Top = 0
738 }
739 }
740 }*/
741
742 method vForm.Close()
743 {
744 .WinMsg( $WM_CLOSE )
745 }
746
747
748 method uint vForm.wmclose <alias=vForm_wmclose>( winmsg wmsg )
749 {
750 //print( "wmclose\n")
751 evparQuery evpQ
752 .OnCloseQuery.run( evpQ )
753 //wmsg.flags = evpQ.flgCancel
754 if evpQ.flgCancel
755 {
756 wmsg.flags = 1
757 }
758 else
759 {
760 if this.flgpopup == $FMODAL
761 {
762 //wmsg.flags = 1
763 //this.Visible = 0
764 if !wmsg.flags && !.Result
765 {
766 .Result = -1
767 }
768 wmsg.flags = 1
769 }
770 }
771 //DestroyWindow(this.hwnd )
772 /*if App.
773 PostQuitMessage( 0 )*/
774 return 0
775 //return evpQ.flgCancel
776 }
777
778 method uint vForm.wmdestroy <alias=vForm_wmdestroy>( winmsg wmsg )
779 {
780 evparEvent ev
781 ev.sender = &this
782 this.OnDestroy.Run( ev )
783 if !wmsg.flags : this.hwnd = 0
784 if App.Comps[0] == &this
785 {
786 // print( "wmdestroy\n")
787 // this.DestroyComp()
788 PostQuitMessage( 0 )
789 }
790 return 0
791 //return evpQ.flgCancel
792 }
793
794
795 method uint vForm.wmsettingchange <alias=vForm_wmsettingchange>( winmsg wmsg )
796 {
797 if App.Comps[0] == &this && wmsg.wpar = 0x2A
798 {
799 App.SettingChange()
800 }
801 return 0
802 //return evpQ.flgCancel
803 }
804
805 method uint vForm.wmactivate <alias=vForm_wmactivate>( winmsg wmsg )
806 {
807 if ( wmsg.wpar & 0xFFFF ) != $WA_INACTIVE
808 {
809 //print( "activate \(&this) \(.curtab)\n" )
810 if .curtab
811 {
812 SetFocus( .curtab->vCtrl.hwnd )
813 }
814 else
815 {
816 //print( "nexttab\n" )
817 .nexttab( 0 )
818 }
819 wmsg.flags = 1
820 }
821 /*$WA_ACTIVE
822
823 $WA_CLICKACTIVE*/
824
825
826
827 return 0
828 //return evpQ.flgCancel
829 }
830
831
832 method vCtrl.mFocus <alias=vCtrl_mFocus>( evparValUint ev )
833 {
834 if ev.val
835 {
836 uint form as this.GetMainForm()->vForm
837 if &form && &form != &this : form.curtab = &this
838 if this.form != &this : this.form->vForm.curtab = &this
839 //print( "curtab \(&form) \(&this)\n" )
840 }
841
842 this.OnFocus.Run( ev, this )
843 }
844
845 /* Свойство uint PopupMenu - Get Set
846 */
847 property vPopupMenu vCtrl.PopupMenu()
848 {
849 return this.pPopupMenu->vPopupMenu
850 }
851
852 property vCtrl.PopupMenu( vPopupMenu val )
853 {
854 if this.pPopupMenu != &val
855 {
856 this.pPopupMenu = &val
857 }
858 }
859
860 method uint vCtrl.mKey <alias=vCtrl_mKey> ( evparKey ev )
861 {
862 ev.sender = &this
863
864 if ev.evktype == $evkDown
865 {
866 if ev.key == 0x09
867 {
868 if !ev.mstate || ( ev.mstate & $mstShift )
869 {
870 this.form->vForm.nexttab( ev.mstate & $mstShift )
871 return 1
872 }
873 }
874 if &this.form->vForm.Menu && this.form->vForm.Menu.CheckShortKey( ev.mstate, ev.key )
875 {
876 return 0
877 }
878 if &this.PopupMenu && this.PopupMenu.CheckShortKey( ev.mstate, ev.key )
879 {
880 return 0
881 }
882 if ev.key == 0x1B && !ev.mstate && (this.form->vForm.flgpopup & $FMODAL)
883 {
884 this.form->vForm.Result = -1
885 }
886 }
887 if ev.evktype == $evkPress
888 {
889 if ev.key == 0x09 && ( !ev.mstate || ( ev.mstate & $mstShift ) )
890 {
891 return 1
892 }
893 }
894
895 uint res = this.OnKey.Run(/* this,*/ ev )
896 return res
897 }
898
899 method uint vCtrl.mMouse <alias=vCtrl_mMouse> ( evparMouse ev )
900 {
901 ev.sender = &this
902
903 /*if ev.evmtype == $evmRUp && &this.PopupMenu
904 {
905 POINT pnt
906 pnt.x = ev.x
907 pnt.y = ev.y
908 ClientToScreen( this.hwnd, pnt )
909 this.PopupMenu.Show( pnt.x, pnt.y )
910 return 0
911 } */
912 return this.OnMouse.Run( /*this,*/ ev )
913 }
914
915
916
917
918 /*include {
919 "menu.g"
920 }*/
921 method uint vCtrl.wmcommand <alias=vCtrl_wmcommand>( winmsg wmsg )
922 {
923 //print( "XXXXXXXXXX \(wmsg.wpar ) \(wmsg.lpar)\n" )
924 switch wmsg.lpar
925 {
926 case 0
927 {
928
929 uint c as wmsg.wpar->vComp
930 c.Virtual( $mMenuClick )
931 }
932 case 1
933 {
934
935 }
936 default
937 {
938
939 uint msgcmd as wmsg->winmsgcmd
940 // print( "wmcommand \(wmsg.lpar) \(winmsgcmd) \(msgcmd.ctrlhwnd)\n" )
941 uint c as getctrl( msgcmd.ctrlhwnd )
942 if &c
943 {
944 //print( "WM_COMMAND \(hex2stru(msgcmd.id)) \(hex2stru(msgcmd.ntf)) \(hex2stru(msgcmd.ctrlhwnd))\n" )
945 //print( "WM_COMMAND \( msgcmd.hwnd ) \($mWinCmd) \(this.hwnd) \(msgcmd.hwnd)\n" )
946 c.Virtual( $mWinCmd, msgcmd.ntf, msgcmd.id )
947 }
948 }
949 }
950 return 0
951 }
952
953 global
954 {
955 ustr curhint
956 }
957
958 method uint vCtrl.wmnotify <alias=vCtrl_wmnotify>( winmsg wmsg )
959 {
960 uint nmhdr as wmsg.lpar->NMHDR
961 if nmhdr.code == $TTN_GETDISPINFO
962 {
963 nmhdr as NMTTDISPINFO
964 //print( "ntf0 = \(nmhdr.hdr.hwndFrom) \(nmhdr.uFlags) \(nmhdr.hdr.idFrom) \(-nmhdr.hdr.code)
965 // \(nmhdr.lParam)\n" )
966
967
968 TOOLINFO ti
969 ti.cbSize = sizeof( TOOLINFO )
970 SendMessage( nmhdr.hdr.hwndFrom, $TTM_GETCURRENTTOOL, 0, &ti )
971 //print( "ti \(ti.hwnd ) \(ti.uId ) \( ti.lParam )\n ")
972 uint c as getctrl( ti.hwnd )
973 if &c
974 {
975 //ustr curhint = "aaa1"
976 curhint.clear()
977 //print( "set \(curhint)\n" )
978
979 //curhint = "".ustr()
980 c.Virtual( $mGetHint, ti.uId, ti.lParam, curhint )
981 if *curhint
982 {
983
984 nmhdr.lpszText = curhint.ptr()
985 }
986 }
987 /*if nmhdr.hdr.idFrom > 1000
988 {
989 nmhdr.lpszText = nmhdr.hdr.idFrom->vVirtCtrl.pHint.Text( this ).ptr()
990 }*/
991 //wmsg.flags = 1
992
993 }
994 elif nmhdr.hwndFrom
995 {
996 //print( "ntf1 \n" )
997 uint c as getctrl( nmhdr.hwndFrom )
998
999 if &c
1000 {
1001 //wmsg.flags = 1
1002 return c.Virtual( $mWinNtf, nmhdr )
1003 }
1004 }
1005 return 0
1006 }
1007
1008 method uint vCtrl.wmdrawitem <alias=vCtrl_wmdrawitem>( winmsg wmsg )
1009 {
1010
1011 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1012 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1013 uint c
1014 c as getctrl( wmsg.lpar->DRAWITEMSTRUCT.hwndItem )
1015
1016 if !&c
1017 {
1018 c as wmsg.lpar->DRAWITEMSTRUCT.itemID->vComp
1019 // return 0
1020 }
1021
1022 /*print( "drawitem \(&c) \(wmsg.lpar->DRAWITEMSTRUCT.hwndItem)
1023 \(wmsg.lpar->DRAWITEMSTRUCT.itemID)\n" )*/
1024 if &c
1025 {
1026 //wmsg.flags = 0
1027 // print( "drawitem\n" )
1028 //print( "WM_COMMAND \( msgcmd.hwnd ) \($mWinCmd) \(this.hwnd) \(msgcmd.hwnd)\n" )
1029 c.Virtual( $mWinDrawItem, wmsg.lpar->DRAWITEMSTRUCT )
1030 }
1031 wmsg.flags = 1
1032 return 0
1033 }
1034
1035 method uint vCtrl.wmmeasureitem <alias=vCtrl_wmmeasureitem>( winmsg wmsg )
1036 {
1037
1038 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1039 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1040 uint c as vComp
1041 // c as getctrl( wmsg.lpar->MEASUREITEMSTRUCT.hwndItem )
1042 if !&c
1043 {
1044 c as wmsg.lpar->MEASUREITEMSTRUCT.itemID->vComp
1045 // return 0
1046 }
1047 /*print( "drawitem \(&c) \(wmsg.lpar->DRAWITEMSTRUCT.hwndItem)
1048 \(wmsg.lpar->DRAWITEMSTRUCT.itemID)\n" )*/
1049 if &c
1050 {
1051 //wmsg.flags = 0
1052 // print( "drawitem\n" )
1053 //print( "WM_COMMAND \( msgcmd.hwnd ) \($mWinCmd) \(this.hwnd) \(msgcmd.hwnd)\n" )
1054 c.Virtual( $mWinMeasureItem, wmsg.lpar->MEASUREITEMSTRUCT )
1055 }
1056 wmsg.flags = 1
1057 return 0
1058 }
1059
1060 method uint vCtrl.wmmove <alias=vCtrl_wmmove>( winmsg wmsg )
1061 {
1062 RECT r
1063 POINT p
1064 GetWindowRect(this.hwnd, r )
1065 if &this.Owner() && !( this.TypeIs( vForm ) && this->vForm.flgpopup )
1066 {
1067 p.x = r.left
1068 p.y = r.top
1069 ScreenToClient( this.Owner->vCtrl.hwnd, p )
1070 r.left = p.x// + this.Owner->vCtrl.clloc.left //для скролирования
1071 r.top = p.y// + this.Owner->vCtrl.clloc.top
1072 }
1073
1074
1075 this.loc.left = r.left
1076 this.loc.top = r.top
1077 evparValUint evu
1078 .Virtual( $mPosChanged, evu )
1079 .flgnoposchanged = 0
1080 return 0
1081 }
1082
1083 method uint vForm.wmsize <alias=vForm_wmsize>( winmsg wmsg )
1084 {
1085 if !this.p_designing && .pVisible
1086 {
1087 if wmsg.wpar == $SIZE_MAXIMIZED : .pWindowState = $wsMaximized
1088 elif wmsg.wpar == $SIZE_MINIMIZED : .pWindowState = $wsMinimized
1089 else : .pWindowState = $wsNormal
1090 }
1091 return this->vCtrl.wmsize( wmsg )
1092 }
1093
1094
1095 method uint vCtrl.wmwindowposchanged <alias=vCtrl_wmwindowposchanged>( winmsg wmsg )
1096 {
1097 .flgnoposchanged = 1
1098 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1099 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1100 if .flgnoposchanged && ( !(( wmsg.lpar->WINDOWPOS.flags & $SWP_NOMOVE ) &&
1101 ( wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE ) )/* ||
1102 wmsg.lpar->WINDOWPOS.flags & $SWP_FRAMECHANGED*/ )
1103 {
1104 RECT r
1105 POINT p
1106 GetWindowRect(this.hwnd, r )
1107 this.loc.width = r.right - r.left
1108 this.loc.height = r.bottom - r.top
1109
1110 if &this.Owner() && !( this.TypeIs( vForm ) && this->vForm.flgpopup )
1111 {
1112 p.x = r.left
1113 p.y = r.top
1114 ScreenToClient( this.Owner->vCtrl.hwnd, p )
1115 r.left = p.x// + this.Owner->vCtrl.clloc.left //для скролирования
1116 r.top = p.y// + this.Owner->vCtrl.clloc.top
1117 }
1118 this.loc.left = r.left
1119 this.loc.top = r.top
1120 evparValUint evu
1121 .Virtual( $mPosChanged, evu )
1122 .flgnoposchanged = 0
1123 }
1124
1125 return 0
1126 /*if !(( wmsg.lpar->WINDOWPOS.flags & $SWP_NOMOVE ) &&
1127 ( wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE ) ) ||
1128 ( wmsg.lpar->WINDOWPOS.flags & $SWP_FRAMECHANGED )
1129 {
1130 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1131 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1132
1133 RECT r
1134 GetWindowRect( this.hwnd, r )
1135
1136 POINT p
1137 p.x = r.left
1138 p.y = r.top
1139 if &this.Owner()
1140 {
1141 ScreenToClient( this.Owner->vCtrl.hwnd, p )
1142 }
1143
1144 this.loc.left = p.x//r.left
1145 this.loc.top = p.y//r.top
1146 this.loc.width = r.right - r.left
1147 this.loc.height = r.bottom - r.top
1148
1149 GetClientRect( this.hwnd, r )
1150 //print( " client \(this.Name) \( r.right - r.left ) \( r.bottom - r.top )\n" )
1151 this.clloc.width = r.right - r.left
1152 this.clloc.height = r.bottom - r.top
1153
1154 evparValUint evu
1155 if !(wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE) ||
1156 ( wmsg.lpar->WINDOWPOS.flags & $SWP_FRAMECHANGED )
1157 {
1158 evu.val = 1
1159 }
1160
1161 .Virtual( $mPosChanged, evu )
1162
1163 wmsg.flags = 1
1164
1165 }
1166
1167 return 0*/
1168 }
1169
1170 func uint MouseMsg ( winmsg wmsg, evparMouse em )
1171 {
1172 subfunc uint mouse( uint evmtype )
1173 {
1174 uint wpar = wmsg.wpar
1175 uint lpar = wmsg.lpar
1176
1177 em.evmtype = evmtype
1178 em.code = $e_mouse
1179 em.x = int( ( &lpar )->short )
1180 em.y = int( ( &lpar + 2 )->short )
1181 if wpar & $MK_CONTROL : em.mstate |= $mstCtrl
1182 if wpar & $MK_LBUTTON : em.mstate |= $mstLBtn
1183 if wpar & $MK_MBUTTON : em.mstate |= $mstMBtn
1184 if wpar & $MK_RBUTTON : em.mstate |= $mstRBtn
1185 if wpar & $MK_SHIFT : em.mstate |= $mstShift
1186 if GetKeyState( $VK_MENU ) & 0x8000 : em.mstate |= $mstAlt
1187 return 1
1188 }
1189 switch wmsg.msg
1190 {
1191 case $WM_MOUSEMOVE
1192 {
1193 return mouse( $evmMove )
1194 }
1195 case $WM_LBUTTONDOWN
1196 {
1197 return mouse( $evmLDown )
1198 }
1199 case $WM_LBUTTONUP
1200 {
1201 return mouse( $evmLUp )
1202 }
1203 case $WM_LBUTTONDBLCLK
1204 {
1205 return mouse( $evmLDbl )
1206 }
1207 case $WM_RBUTTONDOWN
1208 {
1209
1210 return mouse( $evmRDown )
1211 }
1212 case $WM_RBUTTONUP
1213 {
1214 return mouse( $evmRUp )
1215 }
1216 case $WM_RBUTTONDBLCLK
1217 {
1218 return mouse( $evmRDbl )
1219 }
1220 case $WM_MOUSELEAVE
1221 {
1222 return mouse( $evmLeave )
1223 }
1224 }
1225 return 0
1226 }
1227
1228 method uint vForm.MsgBox( ustr message, ustr caption, uint flags )
1229 {
1230 return MessageBox( ?( &this, this.hwnd, 0 ), caption->locustr.Text( this ).ptr(), message->locustr.Text( this ).ptr(), flags )
1231 }
1232
1233 method uint vCtrl.wmMouse <alias=vCtrl_wmMouse>( winmsg wmsg )
1234 {
1235 evparMouse em
1236 if MouseMsg( wmsg, em )
1237 {
1238 uint form
1239 /*if form = .GetForm()
1240 {
1241 //MSG msg
1242 print( "RELAY \(form->vForm.hwndTip) \n" )
1243 SendMessage( form->vForm.hwndTip, $TTM_RELAYEVENT, 0, &wmsg )
1244 //SendMessage( form->vForm.hwndTip, $TTM_ACTIVATE, 1, 0 )
1245 //SendMessage( form->vForm.hwndTip, $TTM_POPUP, 0, 0 )
1246 }*/
1247 return this.Virtual( $mMouse, em )
1248 }
1249 return 0
1250 /*subfunc uint mouse( uint evmtype )
1251 {
1252 uint wpar = wmsg.wpar
1253 uint lpar = wmsg.lpar
1254 evparMouse em
1255 em.evmtype = evmtype
1256 em.code = $e_mouse
1257 em.x = int( ( &lpar )->short )
1258 em.y = int( ( &lpar + 2 )->short )
1259 if wpar & $MK_CONTROL : em.mstate |= $mstCtrl
1260 if wpar & $MK_LBUTTON : em.mstate |= $mstLBtn
1261 if wpar & $MK_MBUTTON : em.mstate |= $mstMBtn
1262 if wpar & $MK_RBUTTON : em.mstate |= $mstRBtn
1263 if wpar & $MK_SHIFT : em.mstate |= $mstShift
1264 if GetKeyState( $VK_MENU ) & 0x8000 : em.mstate |= $mstAlt
1265 return this.Virtual( $mMouse, em )
1266 }
1267 switch wmsg.msg
1268 {
1269 case $WM_MOUSEMOVE
1270 {
1271 return mouse( $evmMove )
1272 }
1273 case $WM_LBUTTONDOWN
1274 {
1275 return mouse( $evmLDown )
1276 }
1277 case $WM_LBUTTONUP
1278 {
1279 return mouse( $evmLUp )
1280 }
1281 case $WM_LBUTTONDBLCLK
1282 {
1283 return mouse( $evmLDbl )
1284 }
1285 case $WM_RBUTTONDOWN
1286 {
1287
1288 return mouse( $evmRDown )
1289 }
1290 case $WM_RBUTTONUP
1291 {
1292 return mouse( $evmRUp )
1293 }
1294 case $WM_RBUTTONDBLCLK
1295 {
1296 return mouse( $evmRDbl )
1297 }
1298 case $WM_MOUSELEAVE
1299 {
1300 return mouse( $evmLeave )
1301 }
1302 }
1303 return 0*/
1304 }
1305
1306
1307 /*Обновляет окно всплывающего меню для отрисовки картинок vFakeMenuItem*/
1308 global {
1309 uint lastmenuhandle
1310 }
1311 method uint vCtrl.wmmenuselect <alias=vCtrl_wmmenuselect>( winmsg wmsg )
1312 {
1313 uint flginval
1314 if wmsg.msg == $WM_MENUSELECT
1315 {
1316 lastmenuhandle = wmsg.lpar
1317 goto inval
1318 }
1319 else
1320 {
1321 if lastmenuhandle
1322 {
1323 POINT p
1324 GetCursorPos( p )
1325 if MenuItemFromPoint( 0, lastmenuhandle, p.x, p.y ) == -1
1326 {
1327 lastmenuhandle = 0
1328 goto inval
1329 }
1330 }
1331 }
1332 return 0
1333 label inval
1334 uint hwnd
1335 while hwnd = FindWindowEx( 0, hwnd, 32768, 0 )
1336 {
1337 InvalidateRect( hwnd, 0->RECT, 0 )
1338 }
1339 return 0
1340 }
1341
1342
1343 method uint vCtrl.wmcontextmenu <alias=vCtrl_wmcontextmenu>( winmsg wmsg )
1344 {
1345 if &this.PopupMenu
1346 {
1347 int x = ( &wmsg.lpar )->short
1348 int y = ( &wmsg.lpar + 2 )->short
1349 if x == -1 || y == -1
1350 {
1351 POINT pnt
1352 pnt.x = 10
1353 pnt.y = 10
1354 ClientToScreen( this.hwnd, pnt )
1355 x = pnt.x
1356 y = pnt.y
1357 }
1358 this.PopupMenu.Show( x, y )
1359 }
1360 return 0
1361 }
1362
1363
1364 /*method vCtrl.iRemoveHint( vVirtCtrl ctrl )
1365 {
1366
1367 }
1368 */
1369 method vForm.iUpdateHint( vVirtCtrl ctrl )
1370 {
1371 if ctrl.TypeIs( vCtrl )
1372 {
1373 TOOLINFO ti
1374 uint res
1375 ustr txt = ctrl.pHint.Text( this )
1376
1377 ti.cbSize = sizeof( TOOLINFO )
1378 ti.hwnd = ctrl->vCtrl.hwnd
1379 ti.uId = ctrl->vCtrl.hwnd
1380
1381 res = SendMessage( this.hwndTip, $TTM_GETTOOLINFO, 0, &ti )
1382
1383 if *txt
1384 {
1385 ti.uFlags = $TTF_SUBCLASS | $TTF_IDISHWND //| $TTF_SUBCLASS //$TTF_IDISHWND |
1386 ti.hwnd = ctrl->vCtrl.hwnd
1387 ti.uId = ctrl->vCtrl.hwnd
1388 ti.lpszText = txt.ptr()
1389 ti.lParam = &ctrl
1390 //print( "set tip = \( x.hwndTip ) \n " )
1391 SendMessage( this.hwndTip,
1392 ?( res, $TTM_SETTOOLINFO, $TTM_ADDTOOL ), 0, &ti )
1393 }
1394 elif res
1395 {
1396 SendMessage( this.hwndTip, $TTM_DELTOOL, 0, &ti )
1397 }
1398 }
1399 /*elif ctrl.pOwner
1400 {
1401 TOOLINFO ti
1402 uint res
1403 ustr txt = ctrl.pHint.Text( this )
1404
1405 ti.cbSize = sizeof( TOOLINFO )
1406 ti.hwnd = ctrl.Owner->vCtrl.hwnd
1407 ti.uId = &ctrl
1408
1409 res = SendMessage( this.hwndTip, $TTM_GETTOOLINFO, 0, &ti )
1410
1411 if *txt
1412 {
1413 ti.uFlags = $TTF_SUBCLASS //| $TTF_IDISHWND //| $TTF_SUBCLASS //$TTF_IDISHWND |
1414 ti.hwnd = ctrl.Owner->vCtrl.hwnd
1415 ti.uId = &ctrl
1416 ti.lpszText = txt.ptr()
1417 ti.lParam = &ctrl
1418 ti.rect.left = ctrl.Left
1419 ti.rect.top = ctrl.Top
1420 ti.rect.right = ctrl.Left + ctrl.Width
1421 ti.rect.bottom = ctrl.Top + ctrl.Height
1422
1423 //print( "set tip = \( x.hwndTip ) \n " )
1424 print( "send1 = \(SendMessage( this.hwndTip,
1425 ?( res, $TTM_SETTOOLINFO, $TTM_ADDTOOL ), 0, &ti ))\n" )
1426 }
1427 elif res
1428 {
1429 SendMessage( this.hwndTip, $TTM_DELTOOL, 0, &ti )
1430 }
1431 }*/
1432 }
1433
1434 method vCtrl.mSetHint <alias=vCtrl_mSetHint>()
1435 {
1436 if this.hwnd && this.form
1437 {
1438 this.form->vForm.iUpdateHint( this )
1439 }
1440 }
1441
1442
1443 /*method uint vCtrl.wmclcolorbtn <alias=vCtrl_wmclcolorbtn>(winmsg wmsg )
1444 {
1445 print("Bk\n" )
1446 RECT rc
1447
1448
1449 SetBkMode( wmsg.wpar, $TRANSPARENT )
1450
1451 //SetBrushOrgEx( wmsg.wpar, -rc.left, -rc.top, 0 )
1452
1453 wmsg.flags = 1
1454 return 0
1455 }*/
1456
1457
1458
1459
1460
1461
1462 func init_vForm <entry>()
1463 {
1464 //print( "reg vform 1\n" )
1465 //mcopy( &formproctbl.tbl, &vCtrlproctbl.tbl, $WM_USER << 2 )
1466 //(&formproctbl.tbl[ $WM_SIZE << 2 ])->uint = getid( "wmsize", 1, %{vForm, uint, uint, uint} )
1467 WNDCLASSEX visclass
1468 ustr classname = "GVForm"
1469 with visclass
1470 {
1471 .cbSize = sizeof( WNDCLASSEX )
1472 // .style = $CS_HREDRAW | $CS_VREDRAW
1473 .lpfnWndProc = callback( &myproc, 4 )
1474 .cbClsExtra = 0
1475 .cbWndExtra = 0
1476 .hInstance = GetModuleHandle( 0 )
1477 .hIcon = 0
1478 .hCursor = LoadCursor( 0, $IDC_ARROW )
1479 .hbrBackground = 16
1480 .lpszMenuName = 0
1481 .lpszClassName = classname.ptr()
1482 .hIconSm = 0
1483 }
1484 uint hclass = RegisterClassEx( &visclass )
1485
1486 regcomp( vCtrl, "vCtrl", vVirtCtrl, $vCtrl_last,
1487 %{ %{$mCreateWin, vCtrl_mCreateWin},
1488 %{$mReCreateWin, vCtrl_mReCreateWin },
1489 %{$mDestroyWin, vCtrl_mDestroyWin},
1490 %{$mInsert, vCtrl_mInsert},
1491 %{$mRemove, vCtrl_mRemove},
1492 %{$mPreDel, vCtrl_mPreDel},
1493 %{$mPosChanged, vCtrl_mPosChanged},
1494 %{$mPosChanging, vCtrl_mPosChanging},
1495 %{$mFocus, vCtrl_mFocus },
1496 %{$mKey, vCtrl_mKey },
1497 %{$mMouse, vCtrl_mMouse },
1498 %{$mSetEnabled, vCtrl_mSetEnabled },
1499 %{$mSetVisible, vCtrl_mSetVisible },
1500 %{$mFontChanged, vCtrl_mFontChanged },
1501 %{$mSetHint, vCtrl_mSetHint },
1502 %{$mSetCaption, vCtrl_mSetCaption },
1503 %{$mClColor, vCtrl_mClColor }
1504 },
1505 %{ %{$WM_SIZE, vCtrl_wmsize},
1506 %{$WM_MOVE, vCtrl_wmmove},
1507 %{$WM_COMMAND , vCtrl_wmcommand},
1508 %{$WM_NOTIFY , vCtrl_wmnotify},
1509 %{$WM_DRAWITEM, vCtrl_wmdrawitem},
1510 %{$WM_MEASUREITEM,vCtrl_wmmeasureitem},
1511 %{$WM_SETFOCUS, vCtrl_wmfocus},
1512 %{$WM_KILLFOCUS, vCtrl_wmfocus},
1513
1514 %{$WM_KEYDOWN, vCtrl_wmkey},
1515 %{$WM_SYSKEYDOWN, vCtrl_wmkey},
1516 %{$WM_KEYUP, vCtrl_wmkey},
1517 %{$WM_SYSKEYUP, vCtrl_wmkey},
1518 %{$WM_CHAR, vCtrl_wmkey},
1519 %{$WM_SYSCHAR, vCtrl_wmkey},
1520 %{$WM_MOUSEMOVE, vCtrl_wmMouse},
1521 %{$WM_LBUTTONDOWN, vCtrl_wmMouse},
1522 %{$WM_LBUTTONUP, vCtrl_wmMouse},
1523 %{$WM_LBUTTONDBLCLK, vCtrl_wmMouse},
1524 %{$WM_RBUTTONDOWN, vCtrl_wmMouse},
1525 %{$WM_RBUTTONUP, vCtrl_wmMouse},
1526 %{$WM_RBUTTONDBLCLK, vCtrl_wmMouse},
1527 %{$WM_MOUSELEAVE , vCtrl_wmMouse},
1528
1529 %{$WM_WINDOWPOSCHANGED, vCtrl_wmwindowposchanged },
1530 %{$WM_MOVING, vCtrl_wmmoving_sizing},
1531 %{$WM_SIZING, vCtrl_wmmoving_sizing},
1532 %{$WM_CTLCOLORBTN, vCtrl_wmclcolorbtn },
1533 %{$WM_CTLCOLORSTATIC, vCtrl_wmclcolorbtn },
1534 %{$WM_ERASEBKGND, vCtrl_wmerasebkgnd },
1535 %{$WM_CONTEXTMENU, vCtrl_wmcontextmenu },
1536 %{$WM_MENUSELECT, vCtrl_wmmenuselect },
1537 %{$WM_ENTERIDLE, vCtrl_wmmenuselect }
1538
1539 } )
1540
1541
1542 regcomp( vForm, "vForm", vCtrl, $vForm_last,
1543 %{ %{$mCreateWin, vForm_mCreateWin},
1544 //%{$mPosChanged, vForm_mPosChanged},
1545 %{$mPosChanging, vForm_mPosChanging},
1546 %{$mSetOwner, vForm_mSetOwner},
1547 %{$mSetVisible,vForm_mSetVisible },
1548 %{$mInsert, vForm_mInsert},
1549 %{$mRemove, vForm_mRemove},
1550 %{$mLangChanged, vForm_mLangChanged }/*,
1551 %{$mKey, vForm_mKey }*/
1552 },
1553 %{ %{$WM_SIZE, vForm_wmsize},
1554 %{$WM_CLOSE, vForm_wmclose },
1555 %{$WM_DESTROY, vForm_wmdestroy },
1556 %{$WM_SETTINGCHANGE, vForm_wmsettingchange },
1557 %{$WM_ACTIVATE, vForm_wmactivate }
1558 } )
1559
1560 ifdef $DESIGNING {
1561
1562 cm.AddComp( vCtrl )
1563
1564 cm.AddProps( vCtrl, %{
1565 "Left" , int, 0,
1566 "Top" , int, 0,
1567 "Width" , uint, 0,
1568 "Height" , uint, 0,
1569 "Right" , int, $PROP_LOADAFTERCREATE,
1570 "Bottom" , int, $PROP_LOADAFTERCREATE,
1571 "VertAlign", uint, 0,
1572 "HorzAlign", uint, 0,
1573 "Style" , str, 0,
1574 "PopupMenu", vPopupMenu, $PROP_LOADAFTERCREATE
1575 })
1576
1577 cm.AddPropVals( vCtrl, "HorzAlign", %{
1578 "alhLeft", $alhLeft,
1579 "alhClient", $alhClient,
1580 "alhRight", $alhRight,
1581 "alhCenter", $alhCenter,
1582 "alhLeftRight", $alhLeftRight
1583 })
1584
1585 cm.AddPropVals( vCtrl, "VertAlign", %{
1586 "alvTop", $alvTop,
1587 "alvClient", $alvClient,
1588 "alvBottom", $alvBottom,
1589 "alvCenter", $alvCenter,
1590 "alvTopBottom", $alvTopBottom
1591 })
1592
1593 cm.AddEvents( vCtrl, %{
1594 "onPosChanged", "evparEvent"
1595 })
1596
1597 cm.AddComp( vForm )
1598 cm.AddProps( vForm, %{
1599 "Caption" , ustr, 0,
1600 "Border", uint, 0,
1601 "WindowState", uint, 0,
1602 "Menu" , vMenu, $PROP_LOADAFTERCHILD,
1603 "IconName", ustr, 0
1604 })
1605
1606 cm.AddEvents( vForm, %{
1607 "OnCreate" , "evparEvent",
1608 "OnDestroy" , "evparEvent",
1609 "OnCloseQuery" , "evparQuery",
1610 "OnLanguage" , "evparEvent"
1611
1612 })
1613
1614 cm.AddPropVals( vForm, "Border", %{
1615 "fbrdNone", $fbrdNone,
1616 "fbrdSizeable", $fbrdSizeable,
1617 "fbrdDialog", $fbrdDialog
1618 })
1619
1620 cm.AddPropVals( vForm, "WindowState", %{
1621 "wsNormal", $wsNormal,
1622 "wsMaximized", $wsMaximized,
1623 "wsMinimized", $wsMinimized
1624 })
1625 }
1626 //print( "reg vform 2\n" )
1627 }
1628
1629
1630 func noenableproc( uint hwnd, uint lParam )
1631 {
1632 uint modallist as lParam->arr of uint
1633 if IsWindowVisible( hwnd ) && IsWindowEnabled( hwnd )
1634 {
1635 modallist += hwnd
1636 EnableWindow( hwnd, 0 )
1637 }
1638 }
1639
1640 method vForm.ShowPopup( vForm owner )
1641 {
1642 if this.Owner && this.Visible : return
1643
1644 this.flgpopup = 1
1645
1646 this.Owner = owner
1647
1648 this.Visible = 1
1649 }
1650
1651 method uint vForm.ShowModal( vForm owner )
1652 {
1653 arr modallist of uint
1654 uint thread
1655 uint activewnd = GetActiveWindow()
1656 if this.Owner && this.Visible : return 0
1657 this.flgpopup = $FMODAL
1658 this.pResul