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 include : $"..\windows\fileversion.g"
40 /*type VS_FIXEDFILEINFO {
41 uint dwSignature
42 uint dwStrucVersion
43 uint dwFileVersionMS
44 uint dwFileVersionLS
45 uint dwProductVersionMS
46 uint dwProductVersionLS
47 uint dwFileFlagsMask
48 uint dwFileFlags
49 uint dwFileOS
50 uint dwFileType
51 uint dwFileSubtype
52 uint dwFileDateMS
53 uint dwFileDateLS
54 }
55
56 import "version.dll"
57 {
58 uint GetFileVersionInfoSizeW( uint, uint ) -> GetFileVersionInfoSize
59 uint GetFileVersionInfoW( uint, uint, uint, uint ) -> GetFileVersionInfo
60 uint VerQueryValueW( uint, uint, uint, uint ) -> VerQueryValue
61 }
62 */
63
64 import "shell32.dll"
65 {
66 uint SHGetSpecialFolderLocation( uint, uint, uint )
67 //uint SHGetPathFromIDListW( uint, uint ) -> SHGetPathFromIDList
68 }
69
70
71 func uint IsXPStyle()
72 {
73 uint hi lo
74 getfversion( "comctl32.dll", &hi, &lo )
75
76 //To OpenThemeData
77 uint ids
78 SHGetSpecialFolderLocation( 0, 0x001a, &ids )
79
80 return hi >= 0x00060000
81 /*ustr filename = "comctl32.dll"
82 uint res, size
83 buf info
84 uint pfi
85
86 if size = GetFileVersionInfoSize( filename.ptr(), &res )
87 {
88 info.expand( size )
89 if GetFileVersionInfo( filename.ptr(), &res, size, info.ptr()) &&
90 VerQueryValue( info.ptr(), "\\".ustr().ptr(), &pfi, &res )
91 {
92 return pfi->VS_FIXEDFILEINFO.dwFileVersionMS >= 0x00060000
93 }
94 }
95 return 0*/
96 }
97
98 func loadthemefuncs <entry>
99 {
100 uint hinstdll
101
102 isThemed = 0
103 if (hinstdll = LoadLibrary("UxTheme.dll".ptr()))
104 {
105 //uint pIsAppThemed = GetProcAddress(hinstdll, "IsAppThemed".ptr())
106 //pIsAppThemed->stdcall()
107 uint pIsThemeActive = GetProcAddress(hinstdll, "IsThemeActive".ptr())
108
109 //GetProcAddress(hinstdll, "EnableTheming".ptr() )->stdcall(1)
110 //pEnableThemeDialogTexture = GetProcAddress(hinstdll, "EnableThemeDialogTexture".ptr())
111 if pDrawThemeParentBackground = GetProcAddress(hinstdll, "DrawThemeParentBackground".ptr())
112 {
113 pDrawThemeBackground = GetProcAddress(hinstdll, "DrawThemeBackground".ptr())
114 pOpenThemeData = GetProcAddress(hinstdll, "OpenThemeData".ptr())
115 //pDrawThemeText = GetProcAddress(hinstdll, "DrawThemeText".ptr())
116
117 isThemed = pIsThemeActive->stdcall() && IsXPStyle()
118 //if pIsAppThemed
119 {
120 //isThemed = pIsAppThemed->stdcall()
121 }
122 //isThemed = pIsThemeActive->stdcall() && pIsAppThemed->stdcall()
123 }
124 //FreeLibrary(hinstDll)
125 }
126 }
127
128 func themeinit ()
129 {
130
131 if isThemed
132 {
133
134 ThemeData[$theme_button] = pOpenThemeData->stdcall( 0, "button".ustr().ptr() )
135 ThemeData[$theme_toolbar] = pOpenThemeData->stdcall( 0, "toolbar".ustr().ptr() )
136 //print( "themeinit \(pOpenThemeData) \(ThemeData[$theme_button])\n" )
137 //ThemeData[$theme_menu] = pOpenThemeData->stdcall( 0, "menu".ustr().ptr() )
138
139 }
140 }
141
142
143 /*
144 func uint IsAppThemed()
145 {
146 if pIsAppThemed
147 {
148 return pIsAppThemed->stdcall()
149 }
150 return 0
151 }
152
153 func uint EnableThemeDialogTexture( uint hwnd, uint flag )
154 {
155 if pEnableThemeDialogTexture
156 {
157 return pEnableThemeDialogTexture->stdcall( hwnd, flag )
158 }
159 return 0
160 }
161
162 func setxpstyle( uint hwnd )
163 {
164 if !isthemefuncs
165 {
166 loadthemefuncs()
167 }
168 if IsAppThemed()
169 {
170 \(EnableThemeDialogTexture( hwnd, $ETDT_USETABTEXTURE | $ETDT_ENABLETAB ))\n" )
171 }
172 }*/
173
174 include {
175 //"app.g"
176 "ctrl.g"
177 }
178
179 type vForm <inherit = vCtrl>
180 {
181 //arr components[] of uint
182 locustr pCaption
183 uint curtab
184 //uint pFormStyle
185
186 uint lng
187 uint pResult
188 uint pBorder
189 uint pWindowState
190 ustr pIconName
191 uint pStartPos
192 uint pTopMost
193 uint pFormStyle
194 uint pActivate
195
196 uint fCreate
197 uint fLoad
198
199 uint pMenu
200
201 evQuery OnCloseQuery
202 evEvent OnCreate
203 evEvent OnDestroy
204 evEvent OnLanguage
205 evValUint OnShow
206 evValUint OnActivate
207
208 uint hwndTip
209 }
210
211 define <export>{
212 mForm = $vCtrl_last
213 mHelp
214 vForm_last
215 }
216
217 define <export>{
218 //Стили рамки формы Border
219 fbrdNone = 0
220 fbrdSizeable = 1
221 fbrdDialog = 2
222 fbrdSizeToolWin = 3
223 //Стили состояния окна WindowState
224 wsNormal = 0
225 wsMaximized = 1
226 wsMinimized = 2
227 //Начальная позиция окна
228 spDesigned = 0
229 spScreenCenter = 1
230 spParentCenter = 2
231 //FormStyle
232 fsChild = 0
233 fsPopup = 1
234 fsModal = 2
235
236 }
237
238 //pFormStyle
239 define
240 {
241 fsPopup = 1
242 fsModal = 2
243 }
244
245
246 method uint vCtrl.NextCtrl( uint curctrl, uint plevel, uint flgbrother )
247 {
248 uint owner
249 uint ctrl as curctrl->vVirtCtrl
250 uint cidx
251
252 if !&ctrl
253 {
254 ctrl as this
255 plevel->uint++
256 }
257 elif ctrl.TypeIs( vCtrl) && ctrl->vCtrl.pCtrls/**ctrl.ctrls*/ && !flgbrother
258 {
259
260 ctrl as ctrl.Comps[0]->vVirtCtrl//ctrls[0]->vCtrl
261 plevel->uint++
262 }
263 else
264 {
265 while &ctrl != &this
266 {
267
268 owner as ctrl.pOwner->vCtrl
269 cidx = ctrl.pIndex + 1//cidx + 1
270 if cidx < owner.pCtrls/**owner.ctrls*/
271 {
272 ctrl as owner.Comps[cidx]
273 goto end
274 }
275 ctrl as owner
276 plevel->uint--
277 }
278 ctrl as 0
279 }
280 label end
281 return &ctrl
282 }
283
284 method uint vCtrl.PrevCtrl( uint curctrl, uint plevel, uint flgbrother )
285 {
286 uint owner
287 uint ctrl as curctrl->vVirtCtrl
288 int cidx
289
290 if !&ctrl
291 {
292 ctrl as this
293 plevel->uint++
294 }
295 elif ctrl.TypeIs( vCtrl) && ctrl->vCtrl.pCtrls/**ctrl.ctrls*/ && !flgbrother
296 {
297 ctrl as ctrl.Comps[ctrl->vCtrl.pCtrls-1]->vVirtCtrl/*ctrls[*ctrl.ctrls-1]->vCtrl*/
298 plevel->uint++
299 }
300 else
301 {
302 while &ctrl != &this//ctrl.p_owner//&ctrl != &this
303 {
304 owner as ctrl.pOwner->vCtrl
305 cidx = ctrl.pIndex - 1//.cidx - 1
306 if cidx >= 0
307 {
308 ctrl as owner.Comps[cidx]//ctrls[cidx]
309 goto end
310 }
311 ctrl as owner
312 plevel->uint--
313 }
314 ctrl as 0
315 }
316 label end
317 return &ctrl
318 }
319
320 method vCtrl.mInsert <alias=vCtrl_mInsert>( vComp newcomp )
321 {
322 if newcomp.TypeIs( vVirtCtrl )
323 {
324 uint ctrl as newcomp->vVirtCtrl
325 uint flgremove
326 if this.pCanContain
327 {
328
329 if ctrl.pOwner
330 {
331 ctrl.Owner.Virtual( $mRemove, ctrl )
332 ctrl.pOwner = &this
333 ctrl.form = this.GetForm()
334 flgremove = 1
335 }
336 else
337 {
338 ctrl.pOwner = &this
339 ctrl.form = this.GetForm()
340 //if this.hwnd : ctrl.Virtual( $mCreateWin )
341 if this.hwnd && !ctrl->vCtrl.hwnd: ctrl.Virtual( $mCreateWin )
342 }
343 //ctrl.Virtual( $mSetOwner )
344
345 //ctrl.cidx = this.pCtrls//cidx
346 ctrl.pIndex = this.pCtrls//ctrl.cidx
347 this.Comps.insert( ctrl.pIndex )//cidx )
348 this.Comps[ ctrl.pIndex ] = &ctrl//cidx ] = &ctrl
349 uint i
350 fornum i = ctrl.pIndex + 1, *this.Comps//cidx + 1, *this.Comps
351 {
352 this.Comps[i]->vComp.pIndex++
353 }
354
355 this.pCtrls++
356 if ctrl.TypeIs( vCtrl ) && ( !ctrl.TypeIs( vForm ) || !ctrl->vForm.pFormStyle )
357 {
358 ctrl as vCtrl
359 if flgremove
360 {
361 SetWindowLong( ctrl.hwnd, $GWL_STYLE, GetWindowLong( ctrl.hwnd, $GWL_STYLE )/* | $WS_CHILD*/ )
362 SetParent( ctrl.hwnd, this.hwnd )
363 }
364 BringWindowToTop( ctrl.hwnd )
365 }
366 ctrl.Virtual( $mSetOwner, &this )
367 }
368 }
369 else
370 {
371 this->vComp.mInsert( newcomp )
372 }
373 }
374
375 method vCtrl.mReCreateWin <alias=vCtrl_mReCreateWin> ()
376 {
377 if this.hwnd
378 {
379 uint i
380 uint oldhwnd = this.hwnd
381 this.hwnd = 0
382 /*if .pOwner
383 {
384 SetWindowLong( .hwnd, $GWL_STYLE, GetWindowLong( .hwnd, $GWL_STYLE ) | $WS_CHILD )
385 SetParent( .hwnd, .pOwner->vCtrl.hwnd )
386 this.TabOrder = this.TabOrder
387 }*/
388 if .pOwner && (.pOwner == &App || .pOwner->vCtrl.hwnd )
389 {
390 .Virtual( $mCreateWin )
391 }
392 //if .pOwner && .pOwner != &App
393 //{
394 // SetWindowLong( .hwnd, $GWL_STYLE, GetWindowLong( .hwnd, $GWL_STYLE )/* | $WS_CHILD*/ )
395 // SetParent( .hwnd, .pOwner->vCtrl.hwnd )
396 // this.TabOrder = this.TabOrder
397 // }
398 fornum i = 0, .pCtrls
399 {
400 if .Comps[i]->vComp.TypeIs( vCtrl ) && (!.Comps[i]->vComp.TypeIs( vForm ) || !.Comps[i]->vForm.pFormStyle )
401 {
402 SetParent( .Comps[i]->vCtrl.hwnd, this.hwnd )
403 }
404 }
405 SetWindowLong( oldhwnd, $GWL_USERDATA, 0 )
406 DestroyWindow( oldhwnd )
407 }
408 }
409
410 method uint vComp.GetMainForm()
411 {
412 uint cur as this
413 while &cur && cur.pOwner != &App && ( !cur.TypeIs( vForm ) || ( cur->vForm.Owner && !cur->vForm.pFormStyle /*!= $fsModal*/ ))
414 {
415 cur as cur.Owner
416 }
417 return &cur //->vForm
418 }
419
420 method vForm.nexttab( uint flgreverse )
421 {
422
423 uint level
424 uint curtab as this.curtab->vCtrl
425 uint flgbrother, flgstart
426 uint mainform as .GetMainForm()->vForm
427 while 1
428 {
429 if curtab as ?(flgreverse,
430 mainform.PrevCtrl( &curtab, &level, flgbrother )->vCtrl,
431 mainform.NextCtrl( &curtab, &level, flgbrother )->vCtrl )
432 {
433 if curtab.TypeIs( vCtrl ) && curtab.Visible && curtab.Enabled && !curtab.p_designing
434 {
435 if curtab.pTabStop : break
436 flgbrother = 0
437 }
438 else {
439 flgbrother = 1
440 }
441 }
442 else
443 {
444 if flgstart : break
445 flgstart = 1
446 }
447 }
448
449 if &curtab
450 {
451 if mainform.pActivate
452 {
453 SetFocus( curtab.hwnd )
454 }
455 else : mainform.curtab = &curtab
456 }
457
458 }
459
460 method vCtrl.mPreDel <alias=vCtrl_mPreDel>()
461 {
462
463 if this.form && this.form->vForm.curtab == &this
464 {
465 this.form->vForm.nexttab( 1 )
466 }
467 this->vComp.mPreDel()
468 if this.hwnd
469 {
470 DestroyWindow( this.hwnd )
471 this.hwnd = 0
472 }
473 }
474
475 method vCtrl.mSetEnabled <alias=vCtrl_mSetEnabled>( )// uint val )
476 {
477 /*if !.pEnabled
478 {
479 uint form as .GetMainForm()->vForm
480 uint curtab as form.curtab->vCtrl
481
482 if &curtab
483 {
484
485 while &curtab != &form
486 {
487
488 if &curtab == &this
489 {
490
491 form.nexttab( 0 )
492 }
493 curtab as curtab.Owner
494 }
495 }
496 }*/
497 EnableWindow( .hwnd, .pEnabled )
498 }
499
500
501 method uint vComp.GetForm()
502 {
503 uint cur as this
504 while &cur && cur.pOwner != &App && !cur.TypeIs( vForm )
505 {
506 cur as cur.Owner
507 }
508 return &cur //->vForm
509 }
510
511
512
513 method vCtrl.SetFocus()
514 {
515 if this.form->vForm.Visible
516 {
517 SetFocus( this.hwnd )
518 if !.pTabStop || !.pVisible || !.pEnabled
519 {
520 .GetMainForm()->vForm.nexttab( 0 )
521 }
522 }
523 else
524 {
525 this.form->vForm.curtab = &this
526 }
527 }
528
529 /* Метод iUpdateCaption
530 Связывает заголовок окна с визуальным отображением
531 */
532 method vForm.iUpdateCaption
533 {
534 SetWindowText( this.hwnd, this.pCaption.Text(this).ptr() )
535 }
536
537 property ustr vForm.Caption<result>
538 {
539 result = this.pCaption.Value
540 }
541
542 property vForm.Caption( ustr val )
543 {
544 if this.pCaption.Value != val
545 {
546 this.pCaption.Value = val
547 .iUpdateCaption()
548 }
549 }
550
551 /* Свойство uint StartPos - Get Set
552 Устанавливат/получает начальную позицию окна
553 */
554 property uint vForm.StartPos()
555 {
556 return .pStartPos
557 }
558
559 property vForm.StartPos( uint val )
560 {
561 if .pStartPos != val
562 {
563 .pStartPos = val
564 }
565 }
566
567 /* Свойство uint TopMost - Get Set
568 Устанавливат/получает положение окна в самом верху
569 */
570 property uint vForm.TopMost()
571 {
572 return .pTopMost
573 }
574
575 property vForm.TopMost( uint val )
576 {
577 if .pTopMost != val
578 {
579 .pTopMost = val
580 //SetWindowPos( .hwnd, ?( val, $HWND_TOPMOST, $HWND_NOTOPMOST ), 0, 0, 0, 0, $SWP_NOACTIVATE | $SWP_NOZORDER | $SWP_NOMOVE | $SWP_NOSIZE ) )\n" )
581 ifdef !$DESIGNING {
582 .Virtual( $mReCreateWin )
583 }
584 }
585 }
586
587 /* Свойство uint FormStyle - Get Set
588 Устанавливат/получает положение окна в самом верху
589 */
590 property uint vForm.FormStyle()
591 {
592 return .pFormStyle
593 }
594
595 property vForm.FormStyle( uint val )
596 {
597 if .pFormStyle != val
598 {
599 .pFormStyle = val
600 //SetWindowPos( .hwnd, ?( val, $HWND_TOPMOST, $HWND_NOTOPMOST ), 0, 0, 0, 0, $SWP_NOACTIVATE | $SWP_NOZORDER | $SWP_NOMOVE | $SWP_NOSIZE ) )\n" )
601 ifdef !$DESIGNING {
602 .Virtual( $mReCreateWin )
603 }
604 }
605 }
606
607 /* Свойство uint Border - Get Set
608 */
609 property uint vForm.Border()
610 {
611 return this.pBorder
612 }
613
614 property vForm.Border( uint val )
615 {
616 uint style
617
618 if this.pBorder != val
619 {
620 this.pBorder = val
621 ifdef !$DESIGNING {
622 .Virtual( $mReCreateWin )
623 }
624 //
625 // .SetStyle( $WS_OVERLAPPEDWINDOW, ?( val == $fbrdNone, 0, 1 ) )
626 /*style = GetWindowLong( this.hwnd, $GWL_EXSTYLE )
627 style &= ~( $WS_EX_STATICEDGE | $WS_EX_WINDOWEDGE | $WS_EX_CLIENTEDGE |
628 $WS_EX_DLGMODALFRAME)
629 switch val
630 {
631 case $brdLowered, $brdRaised : style |= $WS_EX_STATICEDGE
632 case $brdDblRaised : style |= $WS_EX_DLGMODALFRAME
633 case $brdDblLowered : style |= $WS_EX_CLIENTEDGE
634 }
635 SetWindowLong( this.hwnd, $GWL_EXSTYLE, style )
636 SetWindowPos( this.hwnd, 0, 0, 0, 0, 0, $SWP_FRAMECHANGED |
637 $SWP_NOACTIVATE | $SWP_NOZORDER | $SWP_NOMOVE | $SWP_NOSIZE )*/
638 }
639 }
640
641 /* Свойство uint WindowState - Get Set
642 */
643 property uint vForm.WindowState()
644 {
645 return this.pWindowState
646 }
647
648 property vForm.WindowState( uint val )
649 {
650 uint style
651
652 if this.pWindowState != val
653 {
654 this.pWindowState = val
655 .Virtual( $mSetVisible )
656 }
657 }
658
659 /* Свойство uint Activate - Get Set
660 */
661 property uint vForm.Activate()
662 {
663 return this.pActivate
664 }
665
666 property vForm.Activate( uint val )
667 {
668 if this.hwnd
669 {
670 SetActiveWindow( this.hwnd )
671 }
672 }
673
674 property vCtrl vForm.ActiveControl()
675 {
676 return .curtab->vCtrl
677 }
678
679 method vForm.iGetStyles( uint pstyle, uint pexstyle )
680 {
681 uint style = $WS_CLIPSIBLINGS | $WS_CLIPCHILDREN | $WS_TABSTOP
682 uint exstyle = $WS_EX_CONTROLPARENT
683 ifdef $DESIGNING {
684 style |= $WS_OVERLAPPEDWINDOW
685 }
686 else {
687 switch this.pBorder
688 {
689 case $fbrdSizeable : style |= $WS_OVERLAPPEDWINDOW | 0x40
690 case $fbrdDialog //: style |= $WS_SYSMENU
691 {
692 style = $WS_POPUPWINDOW | $WS_DLGFRAME | $DS_MODALFRAME | $WS_OVERLAPPED
693 exstyle |= $WS_EX_DLGMODALFRAME | $WS_EX_WINDOWEDGE
694 }
695 case $fbrdSizeToolWin
696 {
697 style |= $WS_SYSMENU | $WS_POPUPWINDOW | $WS_CLIPSIBLINGS | $WS_DLGFRAME | $WS_THICKFRAME | $WS_OVERLAPPED
698 exstyle |= $WS_EX_TOOLWINDOW
699 }
700 }
701 if .pTopMost : exstyle |= $WS_EX_TOPMOST
702 }
703 if this.pOwner && this.pOwner != &App
704 {
705 style |= ?( this.pFormStyle, $WS_POPUP, $WS_CHILD )
706 }
707 if .pVisible : style |= $WS_VISIBLE
708 if .pWindowState == $wsMaximized
709 {
710 style |= $WS_MAXIMIZE
711 }
712 elif .pWindowState == $wsMinimized
713 {
714 style |= $WS_MINIMIZE
715 }
716 if pstyle : pstyle->uint = style
717 if pexstyle : pexstyle->uint = exstyle
718 }
719
720 property uint vForm.ClientWidth()
721 {
722 return .clloc.width
723 }
724
725 property vForm.ClientWidth( uint val )
726 {
727 if val != .clloc.width
728 {
729 RECT r
730 uint style
731 r.right = val
732 .iGetStyles( &style, 0 )
733 AdjustWindowRect( r, style, this.pMenu )
734 .Width = r.right - r.left
735 }
736 }
737
738 property uint vForm.ClientHeight()
739 {
740 return .clloc.height
741 }
742
743 property vForm.ClientHeight( uint val )
744 {
745 if val != .clloc.height
746 {
747 RECT r
748 uint style
749 r.bottom = val
750 .iGetStyles( &style, 0 )
751 AdjustWindowRect( r, style, this.pMenu )
752 .Height = r.bottom - r.top
753 }
754 }
755 /* Свойство ustr IconName - Get Set
756 Имя иконки окна
757 */
758 method vForm.iUpdateIcon()
759 {
760 str sname = .pIconName
761 arrstr path
762 sname.split( path, '[', $SPLIT_EMPTY )
763 str name = path[0]
764 if !*name
765 {
766 uint il as App.ImgM.find("resources")->ImageList
767 if &il
768 {
769 foreach key, il.keys
770 {
771 name = "resources\\\(key)"
772 break
773 }
774 }
775 }
776 uint im as this.GetImage( name.ustr() )
777 if .pBorder != $fbrdDialog && &im
778 {
779 .WinMsg( $WM_SETICON, 0, im.hImage )
780 im as this.GetImage( name.ustr() + "[1]" )
781 if &im : .WinMsg( $WM_SETICON, 1, im.hImage )
782 }
783 else
784 {
785 .WinMsg( $WM_SETICON, 0, 0 )
786 .WinMsg( $WM_SETICON, 1, 0 )
787 }
788 }
789
790 property ustr vForm.IconName <result> ()
791 {
792 result = this.pIconName
793 }
794
795 property vForm.IconName( ustr val )
796 {
797 if this.pIconName != val
798 {
799 this.pIconName = val
800 .iUpdateIcon()
801 }
802 }
803
804
805 method vForm vForm.init( )
806 {
807 this.pTypeId =vForm
808 this.pCanContain = 1
809 this.loc.width = 600
810 this.loc.height = 400
811 this.pBorder = $fbrdSizeable
812 App.LoadForms[App.LoadForms.expand(1)] = &this
813 return this
814 }
815
816 property uint vForm.Result()
817 {
818 return .pResult
819 }
820
821 property vForm.Result( uint val )
822 {
823 if .pFormStyle == $fsModal && val
824 {
825 .pResult = val
826 //.WinMsg( $WM_CLOSE )
827 }
828 }
829 include {
830 "menu.g"
831 "popupmenu.g"
832 }
833 /* Свойство uint Menu - Get Set
834 */
835 method vForm.iUpdateMenu()
836 {
837 SetMenu( .hwnd, ?( this.pMenu, this.pMenu->vMenu.phMenu, 0 ) )
838 DrawMenuBar( .hwnd )
839 }
840
841 property vMenu vForm.Menu()
842 {
843 return this.pMenu->vMenu
844 }
845
846 property vForm.Menu( vMenu val )
847 {
848 if this.pMenu != &val
849 {
850 this.pMenu = &val
851 .iUpdateMenu()
852 }
853 }
854
855 method vForm.mInsert <alias=vForm_mInsert>( vComp newcomp )
856 {
857 this->vCtrl.mInsert( newcomp )
858 if !.pMenu && newcomp.TypeIs( vMenu )
859 {
860 .Menu = newcomp->vMenu
861 }
862 }
863
864 method vForm.mRemove <alias=vForm_mRemove>( vComp remcomp )
865 {
866 this->vCtrl.mRemove( remcomp )
867 if .pMenu == &remcomp
868 {
869 .Menu = 0->vMenu
870 }
871 }
872
873
874 /*method vCtrl.CreateChildren()
875 {
876 uint i
877 fornum i = 0, .pCtrls
878 {
879 if .Comps[i]->vComp.TypeIs( vCtrl )
880 {
881 .Comps[i]->vCtrl.Virtual( $mCreateWin )
882 .Comps[i]->vCtrl.CreateChildren()
883 }
884 }
885 }*/
886
887 method vCtrl vCtrl.mCreateWin <alias=vCtrl_mCreateWin> ()
888 {
889 this.WinMsg( $WM_SETFONT, GetStockObject( $DEFAULT_GUI_FONT ) )
890 SetWindowLong( this.hwnd, $GWL_USERDATA, &this )
891 uint addr
892 if .prevwndproc == -1
893 {
894 addr = 1
895 .prevwndproc = 0
896 }
897 //else : this.prevwndproc = SetWindowLong( this.hwnd, $GWL_WNDPROC, callback( &myproc, 4 ))
898 this.prevwndproc = SetWindowLong( this.hwnd, $GWL_WNDPROC, callback( &myproc, 4 ))
899 if addr : .prevwndproc = 0
900
901 RECT r
902 GetClientRect( this.hwnd, r )
903 this.clloc.width = r.right - r.left
904 this.clloc.height = r.bottom - r.top
905
906 int i
907 for i = *.Comps-1, i >= 0, i--
908 {
909 if .Comps[i]->vComp.TypeIs( vCtrl ) && !.Comps[i]->vCtrl.hwnd
910 {
911 .Comps[i]->vCtrl.Virtual( $mCreateWin )
912 }
913 else
914 {
915 .Comps[i]->vCtrl.Virtual( $mOwnerCreateWin )
916 }
917
918 }
919
920 if this.TypeIs( vForm ) && !( this.pOwner && this.pOwner != &App && !this->vForm.pFormStyle )
921 {
922 evparValUint evu
923 evu.val = 1
924 .Virtual( $mPosChanged, evu )
925 }
926 else
927 {
928 eventpos ep
929 vloc loc = this.loc
930 ep.loc = this.loc
931 ep.move = 1
932 ep.code = $e_poschanging
933 .Virtual( $mPosChanging, ep )
934
935 evparValUint evu
936 evu.val = 0
937 .Virtual( $mPosChanged, evu )
938 //this.Owner->vCtrl.Virtual( $mChildPosChanged, this )
939 }
940 .Virtual( $mFontChanged )
941 //vloc l =.loc
942 //SetWindowPos( this.hwnd, 0, 0,0,0,0, $SWP_NOACTIVATE | $SWP_NOZORDER )
943 //SetWindowPos( this.hwnd, 0, l.left, l.top, l.width, l.height, $SWP_NOACTIVATE | $SWP_NOZORDER )
944 //SetWindowPos( this.hwnd, 0, .loc.left, .loc.top, .loc.width, .loc.height, $SWP_NOACTIVATE | $SWP_NOZORDER )
945
946 return this
947 }
948
949
950 method vForm vForm.mCreateWin <alias=vForm_mCreateWin>( )
951 {
952 uint style, exstyle
953 .iGetStyles( &style, &exstyle )
954 if !.fCreate //&& !.fLoad
955 {
956 if .pStartPos == $spScreenCenter
957 {
958 .Left = ( GetSystemMetrics(0) - .Width ) / 2
959 .Top = ( GetSystemMetrics(1) - .Height ) / 2
960 }
961 elif .pStartPos == $spParentCenter
962 {
963 if this.pOwner && this.pOwner != &App && this.pFormStyle
964 {
965 .Left = .Owner->vForm.Left + (.Owner->vForm.Width - .Width ) / 2
966 .Top = .Owner->vForm.Top + (.Owner->vForm.Height - .Height ) / 2
967 }
968 }
969 .Left = max( .Left, 0 )
970 .Top = max( .Top, 0 )
971
972 this.hwndTip = CreateWindowEx( $WS_EX_TOPMOST, "tooltips_class32".ustr().ptr(), 0,
973 $WS_POPUP | 0x01 | 0x02, // | $TTS_NOPREFIX | $TTS_ALWAYSTIP,
974 0x80000000, 0x80000000,
975 0x80000000, 0x80000000, //$CW_USEDEFAULT,
976 0, 0, 0/*GetModuleHandle( 0 )*/, 0)
977 }
978 .CreateWin( "GVForm".ustr(), exstyle, /*0x94c800c4*/ style )
979
980 /*this.hwnd = CreateWindowEx( 0x00010000, "GVForm".ustr().ptr(), "".ustr().ptr(),
981 ?( this.p_owner,$WS_CHILD,0) |$WS_CLIPSIBLINGS | $WS_CLIPCHILDREN | $WS_OVERLAPPEDWINDOW | $WS_OVERLAPPED | $WS_SYSMENU , 0, 0,
982 500, 500, ?( this.p_owner, this.p_owner->vCtrl.hwnd, 0 ), 0, 0, &this )*/
983 //setxpstyle( this.hwnd )
984 SCROLLINFO sci
985 sci.cbSize = sizeof( SCROLLINFO )
986 sci.fMask = 0x17
987 sci.nMin = 0
988 sci.nMax = 500
989 sci.nPage = 30
990 sci.nPos = 100
991
992 this.prevwndproc = -1
993 this->vCtrl.mCreateWin()
994 //&DefWindowProc
995 //sci.nTrackPos
996 //SetScrollInfo( this.hwnd, 1, sci, 1)
997
998 //this.f_defproc = getid( "@defproc", %{this.p_typeid, eventn } )
999 this.pCanContain = 1
1000 //win_customproc( this.hwnd, &vCtrlproc )
1001 this.form = &this
1002 if this.pOwner && this.pOwner != &App && !this.pFormStyle
1003 {
1004 SetParent( this.hwnd, this.pOwner->vCtrl.hwnd )
1005 //ShowWindow( this.hwnd, $SW_SHOWNORMAL )
1006 }
1007
1008 /*else
1009 {
1010 SetParent( this.hwnd, 0 )
1011 }*/
1012 /*if .pVisible
1013 {
1014
1015 ShowWindow( this.hwnd, $SW_SHOWNORMAL )
1016 }*/
1017
1018
1019 /* if .pVisible
1020 {
1021 ShowWindow( this.hwnd, $SW_SHOWNORMAL )
1022 } */
1023
1024 evparEvent ev
1025 ev.sender = &this
1026 if !.fCreate //&& !.fLoad
1027 {
1028 .iUpdateMenu()
1029 this.OnCreate.Run( ev )
1030 .fCreate = 1
1031 }
1032 .iUpdateCaption()
1033 .OnLanguage.Run( this )
1034 .iUpdateIcon()
1035
1036 if .curtab
1037 {
1038 SetFocus( .curtab->vCtrl.hwnd )
1039 }
1040 else
1041 {
1042 .nexttab( 0 )
1043 }
1044 return this
1045 }
1046
1047
1048 method vForm.mSetOwner <alias=vForm_mSetOwner>( vComp newowner )
1049 {
1050
1051 /*if newowner && newowner.TypeIs( vApp )
1052 {
1053 .pOwner = 0
1054 }
1055 else*/
1056 {
1057 //print( "form.msetowner \(&newowner)\n" )
1058 .pOwner = &newowner
1059 //???????Нужно ли делать recrete????????????????
1060 //if .pFormStyle && &newowner : .Virtual( $mReCreateWin )
1061 }
1062 }
1063
1064 method vForm.mPosChanging <alias=vForm_mPosChanging>( eventpos evp )
1065 {
1066 if this.p_designing
1067 {
1068 evp.loc.left = -this.Owner->vCtrl.clloc.left
1069 evp.loc.top = -this.Owner->vCtrl.clloc.top
1070 }
1071 this->vCtrl.mPosChanging( evp )
1072 }
1073
1074 method vCtrl.mSetVisible <alias=vCtrl_mSetVisible>( )
1075 {
1076 ShowWindow( this.hwnd, ?( .pVisible || this.p_designing,
1077 $SW_SHOWNOACTIVATE, $SW_HIDE ))
1078 }
1079
1080 method vForm.mSetVisible <alias=vForm_mSetVisible>( )
1081 {
1082 uint newstate
1083 if !this.p_designing
1084 {
1085 if .pVisible
1086 {
1087 switch .pWindowState
1088 {
1089 case $wsMaximized: newstate = $SW_MAXIMIZE
1090 case $wsMinimized: newstate = $SW_MINIMIZE
1091 default : newstate = ?( .pFormStyle == $fsPopup, $SW_SHOWNOACTIVATE, $SW_SHOWNORMAL );
1092 }
1093 }
1094 else: newstate = $SW_HIDE
1095
1096 ShowWindow( this.hwnd, newstate )
1097 if .pVisible && &this == .GetMainForm()
1098 {
1099 if !.pFormStyle : BringWindowToTop( this.hwnd )
1100 if .GetMainForm()->vForm.pActivate
1101 {
1102 if .curtab
1103 {
1104 SetFocus( .curtab->vCtrl.hwnd )
1105 }
1106 else
1107 {
1108 .nexttab( 0 )
1109 }
1110 }
1111 }
1112 }
1113 }
1114
1115 /*Виртуальный метод uint vCustomBtn.mLangChanged - Изменение текущего языка
1116 */
1117 method vForm.mLangChanged <alias=vForm_mLangChanged>()
1118 {
1119 .iUpdateCaption()
1120 .iUpdateIcon()
1121 this->vCtrl.mLangChanged()
1122 .OnLanguage.Run( this )
1123 }
1124
1125 /*method uint vForm.mKey <alias=vForm_mKey> ( evparKey ev )
1126 {
1127
1128 }*/
1129
1130
1131 /*method vForm.mPosChanged <alias=vForm_mPosChanged>( evparEvent ev )
1132 {
1133 this->vCtrl.mPosChanged( ev )
1134 if this.p_designing
1135 {
1136 if this.Left || this.Top
1137 {
1138 this.Left = 0
1139 this.Top = 0
1140 }
1141 }
1142 }*/
1143
1144 method vForm.Close()
1145 {
1146 .WinMsg( $WM_CLOSE )
1147 //.Visible = 0
1148 }
1149
1150
1151 method uint vForm.wmclose <alias=vForm_wmclose>( winmsg wmsg )
1152 {
1153 evparQuery evpQ
1154 .OnCloseQuery.Run( evpQ )
1155 //wmsg.flags = evpQ.flgCancel
1156 if evpQ.flgCancel
1157 {
1158 wmsg.flags = 1
1159 }
1160 else
1161 {
1162 switch this.pFormStyle
1163 {
1164 case $fsModal
1165 {
1166 if !wmsg.flags && !.Result
1167 {
1168 .Result = -1
1169 }
1170 wmsg.flags = 1
1171 }
1172 case $fsPopup
1173 {
1174 //print( "Close\n" )
1175 wmsg.flags = 1
1176 .Visible = 0
1177 }
1178 }
1179 }
1180 //DestroyWindow(this.hwnd )
1181 /*if App.
1182 PostQuitMessage( 0 )*/
1183 return 0
1184 //return evpQ.flgCancel
1185 }
1186
1187 method uint vForm.wmqueryendsession <alias=vForm_wmqueryendsession>( winmsg wmsg )
1188 {
1189 evparQuery evpQ
1190 evpQ.val = 1
1191 .OnCloseQuery.Run( evpQ )
1192 //wmsg.flags = evpQ.flgCancel
1193 if evpQ.flgCancel
1194 {
1195 wmsg.flags = 1
1196 return 0
1197 }
1198 return 1
1199 }
1200
1201 //method uint vForm.wmdestroy <alias=vForm_wmdestroy>( winmsg wmsg )
1202 method uint vCtrl.wmdestroy <alias=vForm_wmdestroy>( winmsg wmsg )
1203 {//print( "destroy \(this.Name) \(this.TypeName)\n" )
1204 evparEvent ev
1205 ev.sender = &this
1206 if this.TypeIs( vForm )
1207 {
1208 this->vForm.OnDestroy.Run( ev )
1209 if this.pOwner == &App && App.Comps[0] == &this
1210 {
1211 //MsgBox( "progname".ustr(), "qitemdel".ustr(), $MB_YESNO | $MB_ICONQUESTION )
1212 // this.DestroyComp()
1213 PostQuitMessage( 0 )
1214 }
1215 }
1216 //elif !wmsg.flags
1217 //else
1218 {
1219 //this.hwnd = 0
1220 //this.fLoad = 0
1221 //this.fCreate = 0
1222 //this.mPreDel()
1223 }
1224 return 0
1225 //return evpQ.flgCancel
1226 }
1227
1228
1229 method uint vForm.wmsettingchange <alias=vForm_wmsettingchange>( winmsg wmsg )
1230 {
1231 if App.Comps[0] == &this && wmsg.wpar = 0x2A
1232 {
1233 App.SettingChange()
1234 }
1235 return 0
1236 //return evpQ.flgCancel
1237 }
1238
1239 method uint vForm.wmactivate <alias=vForm_wmactivate>( winmsg wmsg )
1240 {
1241 //if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1242 //else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1243 evparValUint ev
1244 if ( wmsg.wpar & 0xFFFF ) != $WA_INACTIVE
1245 {
1246 .pActivate = 1
1247 if .curtab
1248 {
1249 //SetFocus( .curtab->vCtrl.hwnd )
1250 PostMessage( this.hwnd, $WM_COMMAND, 0xFFFF0000, this.hwnd )
1251 }
1252 else
1253 {
1254 .nexttab( 0 )
1255 }
1256 wmsg.flags = 1
1257 }
1258 else : .pActivate = 0
1259 ev.val = .pActivate
1260 this.OnActivate.Run( ev, this )
1261 /*$WA_ACTIVE
1262
1263 $WA_CLICKACTIVE*/
1264
1265
1266
1267 return 0
1268 //return evpQ.flgCancel
1269 }
1270
1271 method uint vForm.wmshowwindow <alias=vForm_wmshowwindow>( winmsg wmsg )
1272 {
1273 /*print( "wmShowdindow \(this.hwnd) \(wmsg.wpar)\n" )
1274 evparValUint ev
1275 ev.val = wmsg.wpar
1276 this.OnShow.Run( ev, this )
1277 */
1278 return 0
1279 }
1280
1281 method vCtrl.mFocus <alias=vCtrl_mFocus>( evparValUint ev )
1282 {
1283 if ev.val
1284 {
1285 uint form as this.GetMainForm()->vForm
1286 if &form && &form != &this : form.curtab = &this
1287 if this.form != &this : this.form->vForm.curtab = &this
1288 }
1289 this.OnFocus.Run( ev, this )
1290 }
1291
1292 /* Свойство uint PopupMenu - Get Set
1293 */
1294 property vPopupMenu vCtrl.PopupMenu()
1295 {
1296 return this.pPopupMenu->vPopupMenu
1297 }
1298
1299 property vCtrl.PopupMenu( vPopupMenu val )
1300 {
1301 if this.pPopupMenu != &val
1302 {
1303 this.pPopupMenu = &val
1304 }
1305 }
1306
1307 /* Свойство uint HelpTopic - Get Set
1308 */
1309 property ustr vCtrl.HelpTopic <result>()
1310 {
1311 result = this.pHelpTopic
1312 }
1313
1314 property vCtrl.HelpTopic( ustr val )
1315 {
1316 if this.pHelpTopic != val
1317 {
1318 this.pHelpTopic = val
1319 }
1320 }
1321
1322 method uint vForm.mHelp <alias=vForm_mHelp>( vCtrl ctrl )
1323 {
1324 uint curctrl as ctrl
1325 subfunc ev
1326 {
1327 if App.OnHelp.id
1328 {
1329 evparValUstr evu
1330 evu.val = "".ustr()
1331 evu.sender = &ctrl
1332 App.OnHelp.Run( evu )
1333 }
1334 }
1335 while &curctrl && curctrl.TypeIs( vCtrl )
1336 {
1337 if *curctrl.HelpTopic
1338 {
1339 ev()
1340 return App.HelpM.Topic( curctrl.HelpTopic )
1341 }
1342 curctrl as curctrl.Owner
1343 }
1344 ev()
1345 return App.HelpM.Index()
1346 }
1347
1348
1349 method uint vForm.mWinCmd <alias=vForm_mWinCmd>( uint ntf, uint cmd )
1350 {
1351 if ntf == 0xFFFF && !cmd && .pActivate : SetFocus( this.curtab->vCtrl.hwnd )
1352 return 0
1353 }
1354
1355 method vCtrl.Help()
1356 {
1357 //if *App.HelpM.HelpFile
1358 .GetMainForm()->vForm.Virtual( $mHelp, this )
1359 }
1360
1361 method uint vCtrl.mKey <alias=vCtrl_mKey> ( evparKey ev )
1362 {
1363 ev.sender = &this
1364
1365 if ev.evktype == $evkDown
1366 {
1367 if ev.key == 0x09
1368 {
1369 if !ev.mstate || ( ev.mstate & $mstShift )
1370 {
1371 this.form->vForm.nexttab( ev.mstate & $mstShift )
1372 return 1
1373 }
1374 }
1375
1376 if ev.key == $VK_F1 && !ev.mstate
1377 {
1378 //uint curctrl as this
1379 .Help()
1380 return 0
1381 }
1382
1383 uint form as .GetMainForm()->vForm
1384 if form.Menu && form.Menu.CheckShortKey( ev.mstate, ev.key )
1385 //if &this.form->vForm.Menu && this.form->vForm.Menu.CheckShortKey( ev.mstate, ev.key )
1386 {
1387 return 1
1388 }
1389 if &this.PopupMenu && this.PopupMenu.CheckShortKey( ev.mstate, ev.key )
1390 {
1391 return 1
1392 }
1393 if ev.key == 0x1B && !ev.mstate && (form.pFormStyle & $fsModal)
1394 {
1395 form.Result = -1
1396 }
1397 }
1398 if ev.evktype == $evkPress
1399 {
1400 if ev.key == 0x09 && ( !ev.mstate || ( ev.mstate & $mstShift ) )
1401 {
1402 return 1
1403 }
1404 }
1405
1406 uint res = this.OnKey.Run(/* this,*/ ev )
1407 return res
1408 }
1409
1410 method uint vCtrl.mMouse <alias=vCtrl_mMouse> ( evparMouse ev )
1411 {
1412 ev.sender = &this
1413
1414 /*if ev.evmtype == $evmRUp && &this.PopupMenu
1415 {
1416 POINT pnt
1417 pnt.x = ev.x
1418 pnt.y = ev.y
1419 ClientToScreen( this.hwnd, pnt )
1420 this.PopupMenu.Show( pnt.x, pnt.y )
1421 return 0
1422 } */
1423 return this.OnMouse.Run( /*this,*/ ev )
1424 }
1425
1426
1427
1428
1429 /*include {
1430 "menu.g"
1431 }*/
1432 method uint vCtrl.wmcommand <alias=vCtrl_wmcommand>( winmsg wmsg )
1433 {
1434 switch wmsg.lpar
1435 {
1436 case 0
1437 {
1438
1439 uint c as wmsg.wpar->vComp
1440 c.Virtual( $mMenuClick )
1441 }
1442 case 1
1443 {
1444
1445 }
1446 default
1447 {
1448
1449 uint msgcmd as wmsg->winmsgcmd
1450 uint c as getctrl( msgcmd.ctrlhwnd )
1451 if &c
1452 {
1453 c.Virtual( $mWinCmd, msgcmd.ntf, msgcmd.id )
1454 }
1455 }
1456 }
1457 return 0
1458 }
1459
1460 global
1461 {
1462 ustr curhint
1463 }
1464
1465 method uint vCtrl.wmnotify <alias=vCtrl_wmnotify>( winmsg wmsg )
1466 {
1467 uint nmhdr as wmsg.lpar->NMHDR
1468
1469 if nmhdr.code == $TTN_GETDISPINFO
1470 {
1471 nmhdr as NMTTDISPINFO
1472 // \(nmhdr.lParam)\n" )
1473 TOOLINFO ti
1474 ti.cbSize = sizeof( TOOLINFO )
1475 SendMessage( nmhdr.hdr.hwndFrom, $TTM_GETCURRENTTOOL, 0, &ti )
1476 uint c as getctrl( ti.hwnd )
1477 if &c
1478 {
1479 //ustr curhint = "aaa1"
1480 curhint.clear()
1481 //curhint = "".ustr()
1482 c.Virtual( $mGetHint, ti.uId, ti.lParam, curhint )
1483 if *curhint
1484 {
1485 nmhdr.lpszText = curhint.ptr()
1486 }
1487 }
1488 /*if nmhdr.hdr.idFrom > 1000
1489 {
1490 nmhdr.lpszText = nmhdr.hdr.idFrom->vVirtCtrl.pHint.Text( this ).ptr()
1491 }*/
1492 //wmsg.flags = 1
1493
1494 }
1495 elif nmhdr.hwndFrom
1496 {
1497
1498 uint c as getctrl( nmhdr.hwndFrom )
1499
1500 if &c
1501 {
1502 //wmsg.flags = 1
1503 return c.Virtual( $mWinNtf, wmsg )
1504 }
1505 }
1506 return 0
1507 }
1508
1509 method uint vCtrl.wmdrawitem <alias=vCtrl_wmdrawitem>( winmsg wmsg )
1510 {
1511
1512 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1513 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1514 uint c
1515 c as getctrl( wmsg.lpar->DRAWITEMSTRUCT.hwndItem )
1516
1517 if !&c
1518 {
1519 c as wmsg.lpar->DRAWITEMSTRUCT.itemID->vComp
1520 // return 0
1521 }
1522
1523 if &c
1524 {
1525 //wmsg.flags = 0
1526 c.Virtual( $mWinDrawItem, wmsg.lpar->DRAWITEMSTRUCT )
1527 }
1528 wmsg.flags = 1
1529 return 0
1530 }
1531
1532 method uint vCtrl.wmmeasureitem <alias=vCtrl_wmmeasureitem>( winmsg wmsg )
1533 {
1534
1535 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1536 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1537 uint c as vComp
1538 // c as getctrl( wmsg.lpar->MEASUREITEMSTRUCT.hwndItem )
1539 if !&c
1540 {
1541 c as wmsg.lpar->MEASUREITEMSTRUCT.itemID->vComp
1542 // return 0
1543 }
1544
1545 if &c
1546 {
1547 //wmsg.flags = 0
1548 c.Virtual( $mWinMeasureItem, wmsg.lpar->MEASUREITEMSTRUCT )
1549 }
1550 wmsg.flags = 1
1551 return 0
1552 }
1553
1554 method uint vCtrl.wmmove <alias=vCtrl_wmmove>( winmsg wmsg )
1555 {
1556 RECT r
1557 POINT p
1558 GetWindowRect(this.hwnd, r )
1559 if &this.Owner() && !( this.TypeIs( vForm ) && this->vForm.pFormStyle )
1560 {
1561 p.x = r.left
1562 p.y = r.top
1563 ScreenToClient( this.Owner->vCtrl.hwnd, p )
1564 r.left = p.x// + this.Owner->vCtrl.clloc.left //для скролирования
1565 r.top = p.y// + this.Owner->vCtrl.clloc.top
1566 }
1567
1568
1569 this.loc.left = r.left
1570 this.loc.top = r.top
1571 evparValUint evu
1572 .Virtual( $mPosChanged, evu )
1573 .flgnoposchanged = 0
1574 return 0
1575 }
1576
1577 method uint vCtrl.wmsize <alias=vCtrl_wmsize>( winmsg wmsg )
1578 {
1579 RECT r
1580 this.clloc.width = wmsg.lpar & 0x7FFF
1581 this.clloc.height = (wmsg.lpar >> 16 ) & 0x7FFF
1582
1583 GetWindowRect( this.hwnd, r )
1584
1585 this.loc.width = r.right - r.left
1586 this.loc.height = r.bottom - r.top
1587 evparValUint evu
1588 evu.val = 1
1589 .Virtual( $mPosChanged, evu )
1590
1591 .flgnoposchanged = 0
1592
1593 return 0
1594 }
1595
1596 method uint vForm.wmsize <alias=vForm_wmsize>( winmsg wmsg )
1597 {
1598 if !this.p_designing && .pVisible
1599 {
1600 if wmsg.wpar == $SIZE_MAXIMIZED : .pWindowState = $wsMaximized
1601 elif wmsg.wpar == $SIZE_MINIMIZED : .pWindowState = $wsMinimized
1602 else : .pWindowState = $wsNormal
1603 }
1604 return this->vCtrl.wmsize( wmsg )
1605 }
1606
1607
1608 method uint vCtrl.wmwindowposchanged <alias=vCtrl_wmwindowposchanged>( winmsg wmsg )
1609 {
1610 .flgnoposchanged = 1
1611 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1612 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1613 if .flgnoposchanged && ( !(( wmsg.lpar->WINDOWPOS.flags & $SWP_NOMOVE ) &&
1614 ( wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE ) )/* ||
1615 wmsg.lpar->WINDOWPOS.flags & $SWP_FRAMECHANGED*/ )
1616 {
1617 RECT r
1618 POINT p
1619 GetWindowRect(this.hwnd, r )
1620 this.loc.width = r.right - r.left
1621 this.loc.height = r.bottom - r.top
1622 if &this.Owner() && !( this.TypeIs( vForm ) && this->vForm.pFormStyle )
1623 {
1624 p.x = r.left
1625 p.y = r.top
1626 ScreenToClient( this.Owner->vCtrl.hwnd, p )
1627 r.left = p.x// + this.Owner->vCtrl.clloc.left //для скролирования
1628 r.top = p.y// + this.Owner->vCtrl.clloc.top
1629 }
1630 this.loc.left = r.left
1631 this.loc.top = r.top
1632 evparValUint evu
1633 evu.val = !(wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE)
1634 .Virtual( $mPosChanged, evu )
1635 .flgnoposchanged = 0
1636 }
1637 wmsg.flags = 1
1638 return 0
1639 /*if !(( wmsg.lpar->WINDOWPOS.flags & $SWP_NOMOVE ) &&
1640 ( wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE ) ) ||
1641 ( wmsg.lpar->WINDOWPOS.flags & $SWP_FRAMECHANGED )
1642 {
1643 if this.prevwndproc : CallWindowProc( this.prevwndproc, this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1644 else : DefWindowProc( this.hwnd, wmsg.msg, wmsg.wpar, wmsg.lpar )
1645
1646 RECT r
1647 GetWindowRect( this.hwnd, r )
1648
1649 POINT p
1650 p.x = r.left
1651 p.y = r.top
1652 if &this.Owner()
1653 {
1654 ScreenToClient( this.Owner->vCtrl.hwnd, p )
1655 }
1656
1657 this.loc.left = p.x//r.left
1658 this.loc.top = p.y//r.top
1659 this.loc.width = r.right - r.left
1660 this.loc.height = r.bottom - r.top
1661
1662 GetClientRect( this.hwnd, r )
1663 this.clloc.width = r.right - r.left
1664 this.clloc.height = r.bottom - r.top
1665
1666 evparValUint evu
1667 if !(wmsg.lpar->WINDOWPOS.flags & $SWP_NOSIZE) ||
1668 ( wmsg.lpar->WINDOWPOS.flags & $SWP_FRAMECHANGED )
1669 {
1670 evu.val = 1
1671 }
1672
1673 .Virtual( $mPosChanged, evu )
1674
1675 wmsg.flags = 1
1676
1677 }
1678
1679 return 0*/
1680 }
1681
1682 method uint vForm.wmwindowposchanged <alias=vForm_wmwindowposchanged>( winmsg wmsg )
1683 {
1684 evparValUint ev
1685 this->vCtrl.wmwindowposchanged( wmsg )
1686 if wmsg.lpar->WINDOWPOS.flags & $SWP_SHOWWINDOW
1687 {
1688 ev.val = 1
1689 }
1690 elif !( wmsg.lpar->WINDOWPOS.flags & $SWP_HIDEWINDOW ): return 0
1691 this.OnShow.Run( ev, this )
1692 return 0
1693 }
1694
1695 func uint MouseMsg ( winmsg wmsg, evparMouse em )
1696 {
1697 subfunc uint mouse( uint evmtype )
1698 {
1699 uint wpar = wmsg.wpar
1700 uint lpar = wmsg.lpar
1701
1702 em.evmtype = evmtype
1703 em.code = $e_mouse
1704 em.x = int( ( &lpar )->short )
1705 em.y = int( ( &lpar + 2 )->short )
1706 if wpar & $MK_CONTROL : em.mstate |= $mstCtrl
1707 if wpar & $MK_LBUTTON : em.mstate |= $mstLBtn
1708 if wpar & $MK_MBUTTON : em.mstate |= $mstMBtn
1709 if wpar & $MK_RBUTTON : em.mstate |= $mstRBtn
1710 if wpar & $MK_SHIFT : em.mstate |= $mstShift
1711 if GetKeyState( $VK_MENU ) & 0x8000 : em.mstate |= $mstAlt
1712 return 1
1713 }
1714 switch wmsg.msg
1715 {
1716 case $WM_MOUSEMOVE
1717 {
1718 return mouse( $evmMove )
1719 }
1720 case $WM_LBUTTONDOWN
1721 {
1722 return mouse( $evmLDown )
1723 }
1724 case $WM_LBUTTONUP
1725 {
1726 return mouse( $evmLUp )
1727 }
1728 case $WM_LBUTTONDBLCLK
1729 {
1730 return mouse( $evmLDbl )
1731 }
1732 case $WM_RBUTTONDOWN
1733 {
1734
1735 return mouse( $evmRDown )
1736 }
1737 case $WM_RBUTTONUP
1738 {
1739 return mouse( $evmRUp )
1740 }
1741 case $WM_RBUTTONDBLCLK
1742 {
1743 return mouse( $evmRDbl )
1744 }
1745 case $WM_MOUSELEAVE
1746 {
1747 return mouse( $evmLeave )
1748 }
1749 case $WM_MOUSEACTIVATE
1750 {
1751 return mouse( $evmActivate )
1752 }
1753 }
1754 return 0
1755 }
1756
1757 method uint vForm.MsgBox( ustr message, ustr caption, uint flags )
1758 {
1759 //print( "this \(&this) \(?(&this, this.Name, "" ))\n" )
1760 return MessageBox( ?( &this, this.hwnd, GetActiveWindow() ), caption->locustr.Text( this ).ptr(), message->locustr.Text( this ).ptr(), flags )
1761 }
1762
1763 method uint vCtrl.wmMouse <alias=vCtrl_wmMouse>( winmsg wmsg )
1764 {
1765 evparMouse em
1766 if MouseMsg( wmsg, em )
1767 {
1768 uint form
1769 /*if form = .GetForm()
1770 {
1771 //MSG msg
1772 SendMessage( form->vForm.hwndTip, $TTM_RELAYEVENT, 0, &wmsg )
1773 //SendMessage( form->vForm.hwndTip, $TTM_ACTIVATE, 1, 0 )
1774 //SendMessage( form->vForm.hwndTip, $TTM_POPUP, 0, 0 )
1775 }*/
1776 wmsg.flags = this.Virtual( $mMouse, em )
1777 return em.ret
1778 }
1779 return 0
1780 /*subfunc uint mouse( uint evmtype )
1781 {
1782 uint wpar = wmsg.wpar
1783 uint lpar = wmsg.lpar
1784 evparMouse em
1785 em.evmtype = evmtype
1786 em.code = $e_mouse
1787 em.x = int( ( &lpar )->short )
1788 em.y = int( ( &lpar + 2 )->short )
1789 if wpar & $MK_CONTROL : em.mstate |= $mstCtrl
1790 if wpar & $MK_LBUTTON : em.mstate |= $mstLBtn
1791 if wpar & $MK_MBUTTON : em.mstate |= $mstMBtn
1792 if wpar & $MK_RBUTTON : em.mstate |= $mstRBtn
1793 if wpar & $MK_SHIFT : em.mstate |= $mstShift
1794 if GetKeyState( $VK_MENU ) & 0x8000 : em.mstate |= $mstAlt
1795 return this.Virtual( $mMouse, em )
1796 }
1797 switch wmsg.msg
1798 {
1799 case $WM_MOUSEMOVE
1800 {
1801 return mouse( $evmMove )
1802 }
1803 case $WM_LBUTTONDOWN
1804 {
1805 return mouse( $evmLDown )
1806 }
1807 case $WM_LBUTTONUP
1808 {
1809 return mouse( $evmLUp )
1810 }
1811 case $WM_LBUTTONDBLCLK
1812 {
1813 return mouse( $evmLDbl )
1814 }
1815 case $WM_RBUTTONDOWN
1816 {
1817
1818 return mouse( $evmRDown )
1819 }
1820 case $WM_RBUTTONUP
1821 {
1822 return mouse( $evmRUp )
1823 }
1824 case $WM_RBUTTONDBLCLK
1825 {
1826 return mouse( $evmRDbl )
1827 }
1828 case $WM_MOUSELEAVE
1829 {
1830 return mouse( $evmLeave )
1831 }
1832 }
1833 return 0*/
1834 }
1835
1836
1837 /*Обновляет окно всплывающего меню для отрисовки картинок vFakeMenuItem*/
1838 global {
1839 uint lastmenuhandle
1840 }
1841 method uint vCtrl.wmmenuselect <alias=vCtrl_wmmenuselect>( winmsg wmsg )
1842 {
1843 uint flginval
1844 if wmsg.msg == $WM_MENUSELECT
1845 {
1846 lastmenuhandle = wmsg.lpar
1847 goto inval
1848 }
1849 else
1850 {
1851 if lastmenuhandle
1852 {
1853 POINT p
1854 GetCursorPos( p )
1855 if MenuItemFromPoint( 0, lastmenuhandle, p.x, p.y ) == -1
1856 {
1857 lastmenuhandle = 0
1858 goto inval
1859 }
1860 }
1861 }
1862 return 0
1863 label inval
1864 uint hwnd
1865 while hwnd = FindWindowEx( 0, hwnd, 32768, 0 )
1866 {
1867 InvalidateRect( hwnd, 0->RECT, 0 )
1868 }
1869 return 0
1870 }
1871
1872
1873 method uint vCtrl.wmcontextmenu <alias=vCtrl_wmcontextmenu>( winmsg wmsg )
1874 {
1875 if &this.PopupMenu
1876 {
1877 int x = ( &wmsg.lpar )->short
1878 int y = ( &wmsg.lpar + 2 )->short
1879 if x == -1 || y == -1
1880 {
1881 POINT pnt
1882 pnt.x = 10
1883 pnt.y = 10
1884 ClientToScreen( this.hwnd, pnt )
1885 x = pnt.x
1886 y = pnt.y
1887 }
1888 this.PopupMenu.Show( x, y )
1889 }
1890 return 0
1891 }
1892
1893
1894 /*method vCtrl.iRemoveHint( vVirtCtrl ctrl )
1895 {
1896
1897 }
1898 */
1899 method vForm.iUpdateHint( vVirtCtrl ctrl )
1900 {
1901 if ctrl.TypeIs( vCtrl )
1902 {
1903 TOOLINFO ti
1904 uint res
1905 ustr txt = ctrl.pHint.Text( this )
1906
1907
1908 ti.cbSize = sizeof( TOOLINFO )
1909 ti.hwnd = ctrl->vCtrl.hwnd
1910 ti.uId = ctrl->vCtrl.hwnd
1911
1912 res = SendMessage( this.hwndTip, $TTM_GETTOOLINFO, 0, &ti )
1913
1914 if *txt
1915 {
1916 ti.uFlags = $TTF_SUBCLASS | $TTF_IDISHWND //| $TTF_SUBCLASS //$TTF_IDISHWND |
1917 ti.hwnd = ctrl->vCtrl.hwnd
1918 ti.uId = ctrl->vCtrl.hwnd
1919 ti.lpszText = txt.ptr()
1920 ti.lParam = &ctrl
1921 SendMessage( this.hwndTip,
1922 ?( res, $TTM_SETTOOLINFO, $TTM_ADDTOOL ), 0, &ti )
1923 }
1924 elif res
1925 {
1926 SendMessage( this.hwndTip, $TTM_DELTOOL, 0, &ti )
1927 }
1928 }
1929 /*elif ctrl.pOwner
1930 {
1931 TOOLINFO ti
1932 uint res
1933 ustr txt = ctrl.pHint.Text( this )
1934
1935 ti.cbSize = sizeof( TOOLINFO )
1936 ti.hwnd = ctrl.Owner->vCtrl.hwnd
1937 ti.uId = &ctrl
1938
1939 res = SendMessage( this.hwndTip, $TTM_GETTOOLINFO, 0, &ti )
1940
1941 if *txt
1942 {
1943 ti.uFlags = $TTF_SUBCLASS //| $TTF_IDISHWND //| $TTF_SUBCLASS //$TTF_IDISHWND |
1944 ti.hwnd = ctrl.Owner->vCtrl.hwnd
1945 ti.uId = &ctrl
1946 ti.lpszText = txt.ptr()
1947 ti.lParam = &ctrl
1948 ti.rect.left = ctrl.Left
1949 ti.rect.top = ctrl.Top
1950 ti.rect.right = ctrl.Left + ctrl.Width
1951 ti.rect.bottom = ctrl.Top + ctrl.Height
1952
1953 }
1954 elif res
1955 {
1956 SendMessage( this.hwndTip, $TTM_DELTOOL, 0, &ti )
1957 }
1958 }*/
1959 }
1960
1961 method vCtrl.mSetHint <alias=vCtrl_mSetHint>()
1962 {
1963 if this.hwnd && this.form
1964 {
1965 this.form->vForm.iUpdateHint( this )
1966 }
1967 }
1968
1969
1970 /*method uint vCtrl.wmclcolorbtn <alias=vCtrl_wmclcolorbtn>(winmsg wmsg )
1971 {
1972 RECT rc
1973
1974
1975 SetBkMode( wmsg.wpar, $TRANSPARENT )
1976
1977 //SetBrushOrgEx( wmsg.wpar, -rc.left, -rc.top, 0 )
1978
1979 wmsg.flags = 1
1980 return 0
1981 }*/
1982
1983
1984
1985
1986
1987
1988 func init_vForm <entry>()
1989 {
1990
1991 regcomp( vVirtCtrl, "vVirtCtrl", vComp, $vVirtCtrl_last,
1992 %{ %{$mLangChanged, vVirtCtrl_mLangChanged },
1993 %{$mSetIndex, vVirtCtrl_mSetIndex } },
1994 0->collection )
1995 ifdef $DESIGNING {
1996 cm.AddComp( vVirtCtrl )
1997 cm.AddProps( vVirtCtrl, %{
1998 "Visible" , uint, $PROP_LOADAFTERCREATE,//0,//$PROP_LOADAFTERCHILD,
1999 "Enabled" , uint, 0,
2000 "Hint" , ustr, 0
2001 })
2002 }
2003
2004 //mcopy( &formproctbl.tbl, &vCtrlproctbl.tbl, $WM_USER << 2 )
2005 //(&formproctbl.tbl[ $WM_SIZE << 2 ])->uint = getid( "wmsize", 1, %{vForm, uint, uint, uint} )
2006 WNDCLASSEX visclass
2007 ustr classname = "GVForm"
2008 with visclass
2009 {
2010 .cbSize = sizeof( WNDCLASSEX )
2011 // .style = $CS_HREDRAW | $CS_VREDRAW
2012 .lpfnWndProc = callback( &myproc, 4 )
2013 .cbClsExtra = 0
2014 .cbWndExtra = 0
2015 .hInstance = GetModuleHandle( 0 )
2016 .hIcon = 0
2017 .hCursor = LoadCursor( 0, $IDC_ARROW )
2018 .hbrBackground = 16
2019 .lpszMenuName = 0
2020 .lpszClassName = classname.ptr()
2021 .hIconSm = 0
2022 }
2023 uint hclass = RegisterClassEx( &visclass )
2024 regcomp( vCtrl, "vCtrl", vVirtCtrl, $vCtrl_last,
2025 %{ %{$mCreateWin, vCtrl_mCreateWin},
2026 %{$mReCreateWin, vCtrl_mReCreateWin },
2027 %{$mDestroyWin, vCtrl_mDestroyWin},
2028 %{$mInsert, vCtrl_mInsert},
2029 %{$mRemove, vCtrl_mRemove},
2030 %{$mPreDel, vCtrl_mPreDel},
2031 %{$mPosChanged, vCtrl_mPosChanged},
2032 %{$mPosChanging, vCtrl_mPosChanging},
2033 %{$mFocus, vCtrl_mFocus },
2034 %{$mKey, vCtrl_mKey },
2035 %{$mMouse, vCtrl_mMouse },
2036 %{$mSetEnabled, vCtrl_mSetEnabled },
2037 %{$mSetVisible, vCtrl_mSetVisible },
2038 %{$mFontChanged, vCtrl_mFontChanged },
2039 %{$mSetHint, vCtrl_mSetHint },
2040 %{$mSetCaption, vCtrl_mSetCaption },
2041 %{$mClColor, vCtrl_mClColor },
2042 %{$mSetIndex, vCtrl_mSetIndex }
2043 },
2044 %{ %{$WM_SIZE, vCtrl_wmsize},
2045 %{$WM_MOVE, vCtrl_wmmove},
2046 %{$WM_COMMAND , vCtrl_wmcommand},
2047 %{$WM_NOTIFY , vCtrl_wmnotify},
2048 %{$WM_DRAWITEM, vCtrl_wmdrawitem},
2049 %{$WM_MEASUREITEM,vCtrl_wmmeasureitem},
2050 %{$WM_SETFOCUS, vCtrl_wmfocus},
2051 %{$WM_KILLFOCUS, vCtrl_wmfocus},
2052
2053 %{$WM_KEYDOWN, vCtrl_wmkey},
2054 %{$WM_SYSKEYDOWN, vCtrl_wmkey},
2055 %{$WM_KEYUP, vCtrl_wmkey},
2056 %{$WM_SYSKEYUP, vCtrl_wmkey},
2057 %{$WM_CHAR, vCtrl_wmkey},
2058 %{$WM_SYSCHAR, vCtrl_wmkey},
2059 %{$WM_MOUSEMOVE, vCtrl_wmMouse},
2060 %{$WM_LBUTTONDOWN, vCtrl_wmMouse},
2061 %{$WM_LBUTTONUP, vCtrl_wmMouse},
2062 %{$WM_LBUTTONDBLCLK, vCtrl_wmMouse},
2063 %{$WM_RBUTTONDOWN, vCtrl_wmMouse},
2064 %{$WM_RBUTTONUP, vCtrl_wmMouse},
2065 %{$WM_RBUTTONDBLCLK, vCtrl_wmMouse},
2066 %{$WM_MOUSELEAVE , vCtrl_wmMouse},
2067 %{$WM_MOUSEACTIVATE, vCtrl_wmMouse},
2068
2069 %{$WM_WINDOWPOSCHANGED, vCtrl_wmwindowposchanged },
2070 %{$WM_MOVING, vCtrl_wmmoving_sizing},
2071 %{$WM_SIZING, vCtrl_wmmoving_sizing},
2072 %{$WM_CTLCOLORBTN, vCtrl_wmclcolorbtn },
2073 %{$WM_CTLCOLOREDIT, vCtrl_wmclcolorbtn },
2074 %{$WM_CTLCOLORSTATIC, vCtrl_wmclcolorbtn },
2075 %{$WM_ERASEBKGND, vCtrl_wmerasebkgnd },
2076 %{$WM_CONTEXTMENU, vCtrl_wmcontextmenu },
2077 %{$WM_MENUSELECT, vCtrl_wmmenuselect },
2078 %{$WM_ENTERIDLE, vCtrl_wmmenuselect },
2079 %{$WM_DESTROY, vForm_wmdestroy }
2080 } )
2081
2082
2083 regcomp( vForm, "vForm", vCtrl, $vForm_last,
2084 %{ %{$mCreateWin, vForm_mCreateWin},
2085 //%{$mPosChanged, vForm_mPosChanged},
2086 %{$mPosChanging, vForm_mPosChanging},
2087 %{$mSetOwner, vForm_mSetOwner},
2088 %{$mSetVisible,vForm_mSetVisible },
2089 %{$mInsert, vForm_mInsert},
2090 %{$mRemove, vForm_mRemove},
2091 %{$mLangChanged, vForm_mLangChanged },
2092 %{$mHelp, vForm_mHelp },
2093 %{$mWinCmd, vForm_mWinCmd }/*,
2094 %{$mKey, vForm_mKey }*/
2095 },
2096 %{ %{$WM_SIZE, vForm_wmsize},
2097 %{$WM_CLOSE, vForm_wmclose },
2098 %{$WM_QUERYENDSESSION, vForm_wmqueryendsession },
2099 // %{$WM_DESTROY, vForm_wmdestroy },
2100 %{$WM_SETTINGCHANGE, vForm_wmsettingchange },
2101 %{$WM_ACTIVATE, vForm_wmactivate },
2102 %{$WM_SHOWWINDOW, vForm_wmshowwindow },
2103 %{$WM_WINDOWPOSCHANGED, vForm_wmwindowposchanged }
2104 } )
2105
2106 ifdef $DESIGNING {
2107
2108 cm.AddComp( vCtrl )
2109
2110 cm.AddProps( vCtrl, %{
2111 "Left" , int, 0,
2112 "Top" , int, 0,
2113 "Width" , uint, 0,
2114 "Height" , uint, 0,
2115 "Right" , int, $PROP_LOADAFTERCREATE,
2116 "Bottom" , int, $PROP_LOADAFTERCREATE,
2117 "VertAlign", uint, 0,
2118 "HorzAlign", uint, 0,
2119 "Style" , str, 0,
2120 "PopupMenu", vPopupMenu, $PROP_LOADAFTERCREATE,
2121 "HelpTopic", ustr, 0,
2122 "TabOrder", uint, 0
2123 })
2124
2125 cm.AddPropVals( vCtrl, "HorzAlign", %{
2126 "alhLeft", $alhLeft,
2127 "alhClient", $alhClient,
2128 "alhRight", $alhRight,
2129 "alhCenter", $alhCenter,
2130 "alhLeftRight", $alhLeftRight
2131 })
2132
2133 cm.AddPropVals( vCtrl, "VertAlign", %{
2134 "alvTop", $alvTop,
2135 "alvClient", $alvClient,
2136 "alvBottom", $alvBottom,
2137 "alvCenter", $alvCenter,
2138 "alvTopBottom", $alvTopBottom
2139 })
2140
2141 cm.AddEvents( vCtrl, %{
2142 "OnPosChanged", "evparEvent",
2143 "OnMouse", "evparMouse",
2144 "OnKey", "evparKey",
2145 "OnFocus", "evparValUint"
2146 })
2147
2148 cm.AddComp( vForm )
2149 cm.AddProps( vForm, %{
2150 "Caption" , ustr, 0,
2151 "Border", uint, 0,
2152 "WindowState", uint, 0,
2153 "Menu" , vMenu, $PROP_LOADAFTERCHILD,
2154 "IconName", ustr, 0,
2155 "StartPos", uint, 0,
2156 "TopMost", uint, 0,
2157 "FormStyle", uint, 0,
2158 "ClientWidth", uint, $PROP_LOADAFTERCHILD, //$PROP_LOADAFTERCREATE,
2159 "ClientHeight", uint, $PROP_LOADAFTERCHILD//$PROP_LOADAFTERCREATE
2160 })
2161
2162 cm.AddEvents( vForm, %{
2163 "OnCreate" , "evparEvent",
2164 "OnDestroy" , "evparEvent",
2165 "OnCloseQuery" , "evparQuery",
2166 "OnLanguage" , "evparEvent",
2167 "OnShow" , "evparValUint",
2168 "OnActivate" , "evparValUint"
2169
2170 })
2171
2172 cm.AddPropVals( vForm, "Border", %{
2173 "fbrdNone", $fbrdNone,
2174 "fbrdSizeable", $fbrdSizeable,
2175 "fbrdDialog", $fbrdDialog,
2176 "fbrdSizeToolWin", $fbrdSizeToolWin
2177 })
2178
2179 cm.AddPropVals( vForm, "WindowState", %{
2180 "wsNormal", $wsNormal,
2181 "wsMaximized", $wsMaximized,
2182 "wsMinimized", $wsMinimized
2183 })
2184
2185 cm.AddPropVals( vForm, "StartPos", %{
2186 "spDesigned", $spDesigned,
2187 "spScreenCenter", $spScreenCenter,
2188 "spParentCenter", $spParentCenter
2189 })
2190
2191 cm.AddPropVals( vForm, "FormStyle", %{
2192 "fsChild", $fsChild,
2193 "fsPopup", $fsPopup
2194 })
2195
2196 }
2197 }
2198
2199
2200 func noenableproc( uint hwnd, uint lParam )
2201 {
2202 uint modallist as lParam->arr of uint
2203 if IsWindowVisible( hwnd ) && IsWindowEnabled( hwnd )
2204 {
2205 modallist += hwnd
2206 EnableWindow( hwnd, 0 )
2207 }
2208 }
2209
2210 method vForm.ShowPopup( vComp owner )
2211 {
2212 if &owner
2213 {
2214 this.Owner = owner
2215 }
2216 elif !&this.Owner
2217 {
2218 uint activewnd = GetActiveWindow()
2219 if activewnd
2220 {
2221 this.Owner = getctrl( activewnd )
2222 }
2223 elif *App.Comps
2224 {
2225 this.Owner = App.Comps[0]->vComp
2226 }
2227 else : this.Owner = App
2228 }
2229
2230 //if this.Owner && this.Visible : return
2231 //print( "formstyle \(this.pFormStyle)\n" )
2232 this.pFormStyle = $fsPopup
2233
2234 //this.Owner = owner
2235 this.Visible = 1
2236 }
2237
2238 method vForm.ShowPopup()
2239 {
2240 .ShowPopup( 0->vComp )
2241 }
2242
2243 method uint vForm.ShowModal( vComp owner )
2244 {
2245 arr modallist of uint
2246 uint thread
2247 uint activewnd = GetActiveWindow()
2248 //if &this.Owner && this.Visible : return 0
2249 //this.pFormStyle = $fsModal
2250 this.pResult = 0
2251 //uint flgnew
2252 .FormStyle = $fsModal
2253 if &owner
2254 {
2255 this.Owner = owner
2256 }
2257 elif !&this.Owner
2258 {
2259 if activewnd
2260 {
2261 this.Owner = getctrl( activewnd )
2262 }
2263 elif *App.Comps
2264 {
2265 this.Owner = App.Comps[0]->vComp
2266 }
2267 else : this.Owner = App
2268 }
2269
2270 // $fsModal
2271
2272
2273 //this.Owner = App
2274 /*if !&this.Owner() : flgnew = 1
2275 if &owner
2276 {
2277 this.Owner = owner
2278 if flgnew && owner.TypeIs( vForm )
2279 {
2280 this.Left = max( owner.Left + ( owner.Width - this.Width ) / 2, 20 )
2281 this.Top = max( owner.Top + ( owner.Height - this.Height ) / 2, 20 )
2282 }
2283 }
2284 else :this.Owner = App*/
2285 //this.Visible = 0
2286 EnumThreadWindows( thread = GetCurrentThreadId(), callback( &noenableproc, 2 ), &modallist )
2287
2288 this.Visible = 1
2289 SetActiveWindow( this.hwnd )
2290 MSG msg
2291 uint exit
2292 App.showmodalcnt++
2293 while (exit=GetMessage( &msg, 0, 0, 0 )) && !.Result && this.Visible
2294 {
2295 TranslateMessage( &msg )
2296 DispatchMessage( &msg )
2297 }
2298 App.showmodalcnt--
2299 uint i
2300 fornum i = 0, *modallist
2301 {
2302 if !IsWindowEnabled( modallist[i] )
2303 {
2304 EnableWindow( modallist[i], 1 )
2305 }
2306 }
2307 this.Visible = 0
2308 SetActiveWindow( ?( this.Owner.TypeIs( vForm ), this.Owner->vForm.hwnd, activewnd) )
2309 //print( "ex \(ex )\n" )
2310 if !exit : PostQuitMessage( 0 )
2311 //this.Visible = 0
2312 return .Result
2313 }
2314
2315 method uint vForm.ShowModal( )
2316 {
2317 return .ShowModal( 0->vForm )
2318 }
2319