FWH/xHarbour Menus

[E. Bartzokas]

Hi all,
I have found some C lang. code in \FWH\SOURCE\WINAPI called MENUS.C, and have played a little with this code.
I managed to give a nicer look (at least in my opinion) to the menus.

This code can be simply pasted preferably inside the main program (see below), and it will work.
In my case, I use a nice (modified) CLR_HCYAN background, and with about 10 lines of code which I added in
DIALOG.PRG, I managed to create all my dialogs with a very impressive background brush, also in tones of
this CLR_HCYAN background. Most of my users have found the new look of my programs as very relaxing,
and that they do not cause eye problems (in other words, they said that their eyes can see better now).

Anyone who likes to use the code, is able to do it (I am not the original author of the code), however, there
is just one problem (please consider that I haven't used "C" for thousands of years)...
The problem is that the highlighted item (the one you place the mouse over it) has the usual blue background,
(the complete ractangle of the menu item is blue), but the background under the menu item string, holds the
modified CLR_HCYAN color, which I found as a big problem.

If someone can modify the code, and make the background under the letters, as BLUE to match the rectangle's
blue background, will be highly appreciated.

Here's the code... I would like to thank anyone involved into this, and of course, anyone who wishes to use
the code in his programs is welcome. (I guess that when fixed by our C gurus, the corrected code will be
also posted here.

Greetings to all fellow programmers and friends!
Evans Bartzokas
Corinth, Greece

Code: Select all  Expand view

// Complete menu system.
// It changes the default colors of FWH/XHB menus.
// Just paste into any MAIN() program, and compile...

// Copyright notice:
// This code originally comes from FWH/SOURCE/WINAPI/MENUS.C
// It has been modified by Evans Bartzokas, in hopes that
// it would be of some use to our fellow programmers/friends.


#PRAGMA BEGINDUMP
 
 
 #define OEMRESOURCE
 #define OBM_CHECK   32760
 
 #include <WinTen.h>
 #include <Windows.h>
 #include <ClipApi.h>
 
 BOOL bStrAt( BYTE bChar, LPSTR szText );
 LPSTR StrToken( LPSTR szText, WORD wOcurrence, BYTE bSeparator, LPWORD pwLen );
 
 void WindowBoxIn( HDC hDC, RECT * pRect );
 void WndDrawBox( HDC hDC, RECT * rct, HPEN hPUpLeft, HPEN hPBotRit );
 void WindowInset( HDC hDC, RECT * pRect );
 void WindowRaised( HDC hDC, RECT * pRect );
 void DrawBitmap( HDC, HBITMAP, WORD, WORD, WORD, WORD, DWORD );
 void DrawMasked( HDC, HBITMAP, WORD, WORD );
 void DrawGrayed( HDC, HBITMAP, int, int );
 void MyRectDisable( HDC, LPRECT );
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_CREATEMENU( PARAMS )
 {
    _retnl( ( LONG ) CreateMenu() );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_CREATEPOPUPMENU( PARAMS )
 {
    _retnl( ( LONG ) CreatePopupMenu() );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_TRACKPOPUP( PARAMS )
 {
   _retl( TrackPopupMenu( ( HMENU ) _parnl( 1 ), _parni( 2 ), _parni( 4 ),
          _parni( 3 ), _parni( 5 ), ( HWND ) _parni( 6 ), NULL ) );
 }
 
 //----------------------------------------------------------------------------//
 
 
 HARBOUR HB_FUN_ENABLEMENUITEM( PARAMS )
 {
    _retl( EnableMenuItem( ( HMENU ) _parnl( 1 ), _parni( 2 ), _parni( 3 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 
 HARBOUR HB_FUN_CHECKMENUITEM( PARAMS )   // ()
 {
    _retl( CheckMenuItem( ( HMENU ) _parnl( 1 ), _parni( 2 ), _parni( 3 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_GETMITEMCOUNT( PARAMS )   // ()
 {
    _retni( GetMenuItemCount( ( HMENU ) _parnl( 1 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_GETMITEMID( PARAMS )    // hMenu, nPos
 {
    _retni( GetMenuItemID( ( HMENU ) _parnl( 1 ), _parni( 2 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_GETSYSTEMMENU( PARAMS )    // ()
 {
    _retnl( ( LONG ) GetSystemMenu( ( HWND ) _parnl( 1 ), _parl( 2 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_DESTROYMENU( PARAMS )   //  ()   hMenu
 {
    _retl( DestroyMenu( ( HMENU ) _parnl( 1 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_GETSUBMENU( PARAMS )    // hMenu, nPos
 {
    _retnl( ( LONG ) GetSubMenu( ( HMENU ) _parnl( 1 ), _parni( 2 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 
 HARBOUR HB_FUN_GETMENUSTRING( PARAMS )    // ()   hMenu, nId, nPosOrValue
 {
    BYTE bBuffer[ 200 ];
    WORD wLen = GetMenuString( ( HMENU ) _parnl( 1 ), _parni( 2 ), ( char * ) bBuffer,
                               199, _parni( 3 ) );
 
    _retclen( ( char * ) bBuffer, wLen );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_GETMENUSTATE( PARAMS )    // ()   hMenu, nId, nFlags
 {
    _retni( GetMenuState( ( HMENU ) _parnl( 1 ), _parni( 2 ), _parni( 3 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 
 HARBOUR HB_FUN_DRAWMENUBAR( PARAMS )    // ()    hWnd
 {
    DrawMenuBar( ( HWND ) _parnl( 1 ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_HILITEMENUITEM( PARAMS )  // ()  hWnd, hMenu, idItem, nHiliteFlags
 {
    _retl( HiliteMenuItem( ( HWND ) _parnl( 1 ), ( HMENU ) _parnl( 2 ),
                           _parni( 3 ), _parni( 4 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_LOADMENU( PARAMS )
 {
    _retnl( ( LONG ) LoadMenu( ( HINSTANCE ) _parnl( 1 ),
                      ( LPSTR ) IF( ISCHAR( 2 ), _parc( 2 ),
                                    MAKEINTRESOURCE( _parni( 2 ) ) ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_APPENDMENU( PARAMS )
 {
    _retl( AppendMenu( ( HMENU ) _parnl( 1 ), ( UINT ) _parnl( 2 ), _parnl( 3 ),
                        IF( ISCHAR( 4 ), _parc( 4 ), ( LPSTR ) _parnl( 4 ) ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_SETMENU( PARAMS )
 {
    _retl( SetMenu( ( HWND ) _parnl( 1 ), ( HMENU ) _parnl( 2 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_MODIFYMENU( PARAMS )
 {
    _retl( ModifyMenu( ( HMENU ) _parnl( 1 ), ( UINT ) _parni( 2 ),
           _parni( 3 ), ( UINT ) _parni( 4 ),
           IF( ISCHAR( 5 ), _parc( 5 ), ( LPSTR ) _parnl( 5 ) ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_INSERTMENU( PARAMS ) // ( hMenu, nIdItem, nFlags, nNewItem, cPrompt ) --> lSuccess
 {
    _retl( InsertMenu( ( HMENU ) _parnl( 1 ), _parni( 2 ), _parni( 3 ),
                       _parni( 4 ), _parc( 5 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_REMOVEMENU( PARAMS ) // ( hMenu, nItem, nFlags ) --> lSuccess
 {
    _retl( RemoveMenu( ( HMENU ) _parnl( 1 ),
                       ( UINT ) _parni( 2 ),
                       ( UINT ) _parni( 3 ) ) );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_MENUDRAWITEM( PARAMS ) // ( pDrawItemStruct, cPrompt, lTop, hBitmap )
 {
    LPDRAWITEMSTRUCT lpdis = ( LPDRAWITEMSTRUCT ) _parnl( 1 );
    LPSTR szPrompt = _parc( 2 );
    BOOL bTab = bStrAt( 9, szPrompt );
    WORD wLen;
    BOOL bTop = _parl( 3 );
    HPEN hNormal;
    HBRUSH hBrush;
    LOGBRUSH lb;
    RECT rct;
    HBITMAP hBmp = ( HBITMAP ) _parnl( 4 );
 
    switch( lpdis->itemAction )
    {
       case ODA_DRAWENTIRE:
       case ODA_SELECT:
            lb.lbStyle = BS_SOLID;  
 
            lb.lbColor =  GetSysColor( COLOR_MENU );  //  (SELECTED (BLUE COLOR) ITEMS)
            hBrush = CreateBrushIndirect( &lb );
            FillRect( lpdis->hDC, &lpdis->rcItem, hBrush );
            DeleteObject( hBrush );
 
            if( lpdis->itemState & ODS_SELECTED &&
                ! ( lpdis->itemState & ODS_GRAYED ) )
            {
               lb.lbColor = GetSysColor( COLOR_HIGHLIGHT );
               SetBkColor( lpdis->hDC, GetSysColor( COLOR_HIGHLIGHT ) );
               SetTextColor( lpdis->hDC, GetSysColor( COLOR_HIGHLIGHTTEXT ) );
               lpdis->rcItem.left += 19;
           
            }
           
            else
             
            lb.lbColor =  16770508 ;  //  GetSysColor( COLOR_MENU ); ( ALL UNSELECTED ITEMS )
            hBrush = CreateBrushIndirect( &lb );
            FillRect( lpdis->hDC, &lpdis->rcItem, hBrush );
            DeleteObject( hBrush );
 
            if( lpdis->itemState & ODS_SELECTED &&
               ! ( lpdis->itemState & ODS_GRAYED ) )
               lpdis->rcItem.left -= 19;
 
            rct.top    = lpdis->rcItem.top;
            rct.left   = lpdis->rcItem.left;
            rct.right  = 17;
            rct.bottom = lpdis->rcItem.bottom - 1;
 
            if( lpdis->itemState & ODS_SELECTED )
               if( ! ( lpdis->itemState & ODS_GRAYED ) &&
                   ! ( lpdis->itemState & ODS_CHECKED ) )
                  if( hBmp )
                     WindowRaised( lpdis->hDC, &rct );
                  else
                  {
                      lb.lbColor = 16770508 ;  //  GetSysColor( COLOR_HIGHLIGHT );
                      hBrush = CreateBrushIndirect( &lb );
                      rct.right += 2;
                      rct.bottom++;
                      FillRect( lpdis->hDC, &rct, hBrush );
                      rct.right -= 2;
                      rct.bottom--;
                      DeleteObject( hBrush );
                  }
 
            if( lpdis->itemState & ODS_CHECKED )
            {
               HBITMAP hBmp = LoadBitmap( 0, MAKEINTRESOURCE( OBM_CHECK ) );
 
               if( ! ( lpdis->itemState & ODS_SELECTED ) )
                  DrawGrayed( lpdis->hDC, hBmp, lpdis->rcItem.top + 1,
                              lpdis->rcItem.left + 1 );
               else
                  DrawMasked( lpdis->hDC, hBmp, lpdis->rcItem.top + 1,
                              lpdis->rcItem.left + 1 );
               DeleteObject( hBmp );
               WindowInset( lpdis->hDC, &rct );
            }
 
            if( hBmp )
            {

               if( ! ( lpdis->itemState & ODS_CHECKED ) )
                  DrawMasked( lpdis->hDC, hBmp, lpdis->rcItem.top + 1,
                              lpdis->rcItem.left + 1 );
               else
                  if( ! ( lpdis->itemState & ODS_SELECTED ) )
                     DrawGrayed( lpdis->hDC, hBmp, lpdis->rcItem.top + 1,
                                 lpdis->rcItem.left + 1 );
                  else

                     DrawMasked( lpdis->hDC, hBmp, lpdis->rcItem.top + 1,
                                 lpdis->rcItem.left + 1 );
            }
 
            lpdis->rcItem.top  += 2;
            lpdis->rcItem.left += 21;
            if( !bTab )
            {

   
                     // V. ADDED STARTS
               SetBkColor( lpdis->hDC, 16770508 );      // HCYAN1
                     // V. ADDED ENDS

               DrawText( lpdis->hDC, szPrompt, -1, &lpdis->rcItem, DT_LEFT );


            }
            else
            {
               lpdis->rcItem.right -= 21;    // THOSE ITEMS THAT HAVE TABS. eg. (F5)
               StrToken( szPrompt, 1, 9, &wLen ); // 32 bits does not fill wLen before
                     // V. ADDED STARTS
               SetBkColor( lpdis->hDC, 16770508 );
                     // V. ADDED ENDS
               DrawText( lpdis->hDC, StrToken(szPrompt, 1, 9, &wLen), wLen, &lpdis->rcItem, DT_LEFT );

               StrToken( szPrompt, 2, 9, &wLen ); // 32 bits does not fill wLen before

               DrawText( lpdis->hDC, StrToken(szPrompt, 2, 9, &wLen), wLen, &lpdis->rcItem, DT_RIGHT );
               lpdis->rcItem.right += 21;
            }
           
            lpdis->rcItem.top  -= 2;
            lpdis->rcItem.left -= 21;
 
            if( lpdis->itemState & ODS_GRAYED )
           
                MyRectDisable( lpdis->hDC, &lpdis->rcItem );   // Function below, added by V.
 
            _retl( TRUE );
            break;
 
       case ODA_FOCUS:
            _retl( FALSE );
            break;
    }
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_MENUMEASUREITEM( PARAMS ) // ( pMeasureItemStruct, nLen )
 {
    LPMEASUREITEMSTRUCT lp = ( LPMEASUREITEMSTRUCT ) _parnl( 1 );
 
    lp->itemWidth  = _parni( 2 );
    lp->itemHeight = GetSystemMetrics( SM_CYMENU ); // 18
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_GETMEAITEM( PARAMS ) // ( pMeasureItemStruct ) --> nMenuItemID
 {
    LPMEASUREITEMSTRUCT lp = ( LPMEASUREITEMSTRUCT ) _parnl( 1 );
 
    _retnl( lp->itemID );
 }
 
 //----------------------------------------------------------------------------//
 
 
 HARBOUR HB_FUN_GETDRAWITEM( PARAMS ) // ( pDrawItemStruct ) --> nMenuItemID
 {
    LPDRAWITEMSTRUCT lpdis = ( LPDRAWITEMSTRUCT ) _parnl( 1 );
 
    _retnl( lpdis->itemID );
 }
 
 //----------------------------------------------------------------------------//
 
 
 HARBOUR HB_FUN_GETDRAWMENU( PARAMS ) // ( pDrawItemStruct ) --> hMenu
 {
    LPDRAWITEMSTRUCT lpdis = ( LPDRAWITEMSTRUCT ) _parnl( 1 );
 
    _retnl( ( LONG ) lpdis->hwndItem );
 }
 
 //----------------------------------------------------------------------------//
 
 HARBOUR HB_FUN_ISMENU( PARAMS )
 {
    _retl( IsMenu( ( HMENU ) _parnl( 1 ) ) );
 }

void MyRectDisable( HDC hDC, LPRECT rc )  // Added by V.
{

   HDC hDCMono;
   HBITMAP hBmpMono, hBmpMonoOld;
   HBRUSH  hbrLight, hbrShadow, hbrOld;
   COLORREF cOld;

   hDCMono  = CreateCompatibleDC( hDC );
   hBmpMono = CreateBitmap( rc->right - rc->left, rc->bottom - rc->top, 1, 1, NULL );
   hbrLight  = CreateSolidBrush( GetSysColor( COLOR_BTNHIGHLIGHT ) );
   hbrShadow = CreateSolidBrush( GetSysColor( COLOR_BTNSHADOW ) );

   hBmpMonoOld = ( HBITMAP )SelectObject( hDCMono, hBmpMono );
   // cOld = SetBkColor( hDC, GetSysColor( COLOR_BTNFACE ) );
   cOld = SetBkColor( hDC, RGB(118,204,228) );           // V. BACKGROUND FOR DISABLED ITEM
   BitBlt( hDCMono, 0, 0, rc->right - rc->left, rc->bottom - rc->top, hDC, rc->left, rc->top, SRCCOPY );
   // SetBkColor( hDC, GetSysColor( COLOR_BTNHIGHLIGHT ) );
   SetBkColor( hDC, RGB(128,128,128)); // GetSysColor( COLOR_BTNHIGHLIGHT ) );  // V. FOREGROUND FOR DISPLAYED ITEM
   BitBlt( hDCMono, 0, 0, rc->right - rc->left, rc->bottom - rc->top, hDC, rc->left, rc->top, SRCPAINT );
   BitBlt( hDCMono, 0, 0, rc->right - rc->left, rc->bottom - rc->top, hDCMono, 0, 0, DSTINVERT );

   // 0xE20746 op code is (Dst ^ (Src & (Pat ^ Dst)))
   hbrOld = ( HBRUSH ) SelectObject( hDC, hbrLight );
   BitBlt( hDC, rc->left + 1, rc->top + 1, rc->right - rc->left, rc->bottom - rc->top, hDCMono, 0, 0, 0XE20746 );
   SelectObject( hDC, hbrShadow );
   BitBlt( hDC, rc->left , rc->top , rc->right - rc->left, rc->bottom - rc->top, hDCMono, 0, 0, 0XE20746 );

   SetBkColor( hDC, cOld );
   SelectObject( hDC, hbrOld );
   SelectObject( hDCMono, hBmpMonoOld );
   DeleteObject( hBmpMono );
   DeleteObject( hbrLight );
   DeleteObject( hbrShadow );
   DeleteDC( hDCMono );
}

 
 #PRAGMA ENDDUMP
 

[Otto]

Evans,
Now as you have worked on menu-source do you think it is possible to have tooltips on menus and menuitems.
Thanks in advance
Otto

[E. Bartzokas]

Hi Otto,
I'll work with tooltips on menus, and menuitems, however,
I'm still puzzled with the background color of the selected subitem.

It appears that no one (yet) has been involved in resolving this specific issue, but it doesn't
mean that nobody is interested. Just imagine the possibility to give the users the ability
to select their own background color for menus, which actually is my aim.

I'm sure you've tested the code I have posted here (for menus). If you're interested, I can
send you the DIALOG.PRG (all my additions are marked properly in the file), to test the
new brush I'm using...

If you want, I can also post it here, as soon as you tell me so (of course, this applies to
anyone interested to change the appearance of any program, without the use of any special
libraries, but the original and beloved FWH code.

I wish I could easily find out how to post a screenshot of my program, to show you how
it looks! (any advise of how I can post an image is welcome).

Kind regards to all
Evans

Evans,
Now as you have worked on menu-source do you think it is possible to have tooltips on menus and menuitems.
Thanks in advance
Otto

[E. Bartzokas]

Hi Otto,
I'll work with tooltips on menus, and menuitems, however,
I'm still puzzled with the background color of the selected subitem.

It appears that no one (yet) has been involved in resolving this specific issue, but it doesn't
mean that nobody is interested. Just imagine the possibility to give the users the ability
to select their own background color for menus, which actually is my aim.

I'm sure you've tested the code I have posted here (for menus). If you're interested, I can
send you the DIALOG.PRG (all my additions are marked properly in the file), to test the
new brush I'm using...

If you want, I can also post it here, as soon as you tell me so (of course, this applies to
anyone interested to change the appearance of any program, without the use of any special
libraries, but the original and beloved FWH code.

I wish I could easily find out how to post a screenshot of my program, to show you how
it looks! (any advise of how I can post an image is welcome).

Kind regards to all
Evans

Evans,
Now as you have worked on menu-source do you think it is possible to have tooltips on menus and menuitems.
Thanks in advance
Otto

[Otto]

Hello Evans,
thank you for your offer.

I use this screen capture tool. You have to save the screen captures as jpg files and store them on a ftp-server.
Put then the link into .
Best regards,
Otto

Form the homepage:
Version 2.1 (Fully functional evaluation version)
TNT Screen Capture is free for private use!

http://www.ec-software.com/downloads_tnt.html

Best regards,
Otto

[frose]

screen capture without tool:
print screen-key - complete screen
Alt-print screen-key - currently selected window

[E. Bartzokas]

Thanks To All for the image posting advises...

1. Here's a link to the Main Window (MDI WINDOW), main menu.
Please notice the HCYAN background under the text of highlighted menuitem.
This is what I was trying to get rid of!
http://img207.imageshack.us/my.php?image=menu1d.jpg

2. Here's the menu of an MDI WINDOW. Also please notice the annoying HCYAN backround
which I didn't manage to fix yet.
http://img43.imageshack.us/my.php?image=menu2.jpg

3. Here we have a dialog with my modified DIALOG.PRG.
Please notice that the HCYAN brush is just a nice looking brush, however, I could easily
modify the program to allow users select the brush they wish to utilize in their dialogs
(even workstation to workstation).
Also, mind that the modified DIALOG.PRG, will only use a brush, if the dialog uses the
standard windows' colors. If a different background color or brush is used for a dialog,
then the program will act as expected, and will not use the default brush resource.
http://img20.imageshack.us/my.php?image=dialog1.jpg

- The DIALOG.PRG can be posted here (as modified by me) as a stand alone file.
Anyone interested just let me know.

- The annoying background of the highlighted menuitem (the one that the cursor is over it),
is something that I need help from our friends to resolve.
Look like the time I was using C language has long gone... (to my embarashment of course)
Please give me a hand to resolve this issue.

Thanks to all in advance.

Evans Bartzokas
Corinth, Greece

[StefanHaupt]

Evans,

- The DIALOG.PRG can be posted here (as modified by me) as a stand alone file.
Anyone interested just let me know.

I´m interested

[E. Bartzokas]

Stefan and all hi,
Here's the file DIALOG.PRG. Please notice that the brush used in DIALOG.PRG (as modified) is called
WPAPER2.BMP. It should be added to your .RC file as follows,
WPAPER2 BITMAP "./Bitmaps/WPAPER2.BMP"
It can be downloaded from this link:
http://img32.imageshack.us/my.php?image=wpaper2.png

The code for DIALOG.PRG (include this DIALOG.PRG to your .XBP file) will be posted in my next message to follow...

Kind regards
Evans Bartzokas
ps. Any comments from other friends...?

[E. Bartzokas]

* DIALOG.PRG (Modified for using a brush to standard window color dialogs)
* The brush is called WPAPER2 and it should be included in the .RC file !

// Add this line to your .RC file
// WPAPER2 BITMAP "./Bitmaps/WPAPER2.BMP"



#include "FiveWin.ch"
#include "Constant.ch"

#define WM_USER 1024 // 0x0400
#define FM_CLOSEUP WM_USER+1042

#define LTGRAY_BRUSH 1
#define GRAY_BRUSH 2

#define WM_CTLCOLOR 25 // 0x19 // Don't remove Color Control
#define WM_ERASEBKGND 20 // 0x0014 // or controls will not shown
// colors !!!
#define WM_DRAWITEM 43 // 0x002B
#define WM_MEASUREITEM 44 // 0x002C
#define WM_SETFONT 48
#define WM_SETICON 128
#define WM_NCPAINT 133 // 0x085
#define WM_PRINTCLIENT 792

#define CBN_SELCHANGE 1
#define CBN_CLOSEUP 8

#define GWL_STYLE -16
#define GW_CHILD 5
#define GW_HWNDNEXT 2
#define GWL_EXSTYLE -20

#define COLOR_BTNFACE 15
#define COLOR_BTNTEXT 18
#define SC_HELP 61824
#define FN_ZIP 15001

#define WS_EX_CONTEXTHELP 1024

#define SWP_NOZORDER 4
#define SWP_NOREDRAW 8
#define SWP_NOACTIVATE 16

#define SC_CLOSE 61536 // 0xF060

#ifdef __XPP__
#define Super ::TWindow
#endif

extern Set

//----------------------------------------------------------------------------//

CLASS TDialog FROM TWindow

CLASSDATA lRegistered AS LOGICAL

DATA cResName, cResData
DATA hResources
DATA lCentered, lModal, lModify
DATA bStart
DATA lHelpIcon // Windows 95 help icon pressed
DATA lResize16 // resize 32 bits resources to look like 16 bits ones
DATA lTransparent // transparent controls when using bitmaped brushes

METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cResName, hResources,;
lVbx, nStyle, nClrText, nClrBack, oBrush, oWnd, lPixels,;
oIco, oFont, nHelpId, nWidth, nHeight, lTransparent ) CONSTRUCTOR

METHOD Define( nTop, nLeft, nBottom, nRight, cCaption, nStyle,;
nClrText, nClrPane, oBrush ) CONSTRUCTOR

METHOD Activate( bClicked, bMoved, bPainted, lCentered, bValid, lModal,;
bInit, bRClicked, bWhen, lResize16 )

METHOD AdjTop() INLINE WndAdjTop( ::hWnd )

METHOD ChangeFocus() INLINE PostMessage( ::hWnd, FM_CHANGEFOCUS )

METHOD Close( nResult )

METHOD Command( nWParam, nLParam )

METHOD CtlColor( hWndChild, hDCChild )

METHOD cToChar( hActiveWnd )
METHOD DefControl( oControl )

METHOD Destroy() INLINE Super:Destroy(), If( ! ::lModal, .t., nil )

METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(),;
If( ::bStart != nil,;
Eval( ::bStart, ::bStart := nil ),), .f.

METHOD End( nResult )

METHOD EraseBkGnd( hDC )

METHOD GetHotPos( nChar, hCtrlAt )

METHOD GetItem( nId ) INLINE GetDlgItem( ::hWnd, nId )

METHOD GotFocus() INLINE ::lFocused := .t.,;
If( ::bGotFocus != nil, Eval( ::bGotFocus ), nil )

#ifdef __CLIPPER__
METHOD HandleEvent( nMsg, nWParam, nLParam ) EXTERN ;
DlgHandleEvent( nMsg, nWParam, nLParam )
#else
METHOD HandleEvent( nMsg, nWParam, nLParam )
#endif

METHOD Help( nWParam, nLParam )

METHOD Initiate( hWndFocus, hWnd )

METHOD KeyChar( nKey, nFlags )

METHOD KeyDown( nKey, nFlags )

METHOD LostFocus() INLINE ::lFocused := .f.,;
If( ::bLostFocus != nil, Eval( ::bLostFocus ), nil )

METHOD MouseMove( nRow, nCol, nKeyFlags )

METHOD Paint()

METHOD PrintClient( hDC ) INLINE 1

METHOD QueryEndSession() INLINE ! ::End()

METHOD SetControl( oCtrl ) INLINE ;
::oClient := oCtrl, ::ReSize()

METHOD SetFont( oFont )

METHOD SysCommand( nWParam, nLParam )

METHOD VbxFireEvent( pEventInfo ) INLINE VBXEvent( pEventInfo )

METHOD Help95()

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cResName, hResources,;
lVbx, nStyle, nClrText, nClrBack, oBrush, oWnd, lPixels,;
oIco, oFont, nHelpId, nWidth, nHeight, lTransparent ) CLASS TDialog

DEFAULT hResources := GetResources(), lVbx := .f.,;
nClrText := GetSysColor( COLOR_BTNTEXT ), nClrBack := GetSysColor( COLOR_BTNFACE ),;
lPixels := .f., nTop := 0, nLeft := 0, nBottom := 10, nRight := 40,;
nWidth := 0, nHeight := 0, lTransparent := .f.

#ifdef __HARBOUR__
DEFAULT nStyle := nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU )
#else
DEFAULT nStyle := nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )
#endif

if nWidth != 0 .or. nHeight != 0
if ! lPixels
lPixels = .t.
endif
nBottom = nHeight
nRight = nWidth
endif

::aControls = {}
::cResName = cResName
::cCaption = cCaption
::hResources = hResources
::lModify = .t.
::lVbx = lVbx
::lVisible = .f.
::nResult = 0
::nStyle = nStyle
::oWnd = oWnd
::oIcon = oIco
::oFont = oFont
::nLastKey = 0
::nHelpId = nHelpId
::lResize16 = .f.
::lTransparent = lTransparent
::lHelpIcon := .F. // added 06/sep/2006 V.

#ifdef __XPP__
DEFAULT ::lRegistered := .f.
#endif

if ValType( oIco ) == "C"
if File( oIco )
DEFINE ICON oIco FILENAME oIco
else
DEFINE ICON oIco RESOURCE oIco
endif
::oIcon := oIco
endif

// ? 'debug line 195', nclrtext, nclrback, valtype(obrush), valtype(nClrText)

if nClrBack == GetSysColor( COLOR_BTNFACE ) // V.
if valtype(nClrText) # 'C'
if valtype(obrush) == "U" // it is empty
// ? 'No Brush defined'
define brush obrush resource "WPAPER2"
endif
endif
endif nClrBack == GetSysColor( COLOR_BTNFACE ) // V.

::SetColor( nClrText, nClrBack, oBrush )

if lPixels // New PIXELS Clausule
::nTop = nTop
::nLeft = nLeft
::nBottom = nBottom
::nRight = nRight
else
// Compatibility
::nTop := int( nTop * DLG_CHARPIX_H )
::nLeft := int( nLeft * DLG_CHARPIX_W )
::nBottom := int( nBottom * DLG_CHARPIX_H )
::nRight := int( nRight * DLG_CHARPIX_W )
endif

if lVbx
if ! VbxInit( GetInstance(), "" )
MsgAlert( "VBX support not available" )
endif
endif

::Register( nOr( CS_VREDRAW, CS_HREDRAW ) )

SetWndDefault( Self ) // Set Default DEFINEd Window

return Self

//----------------------------------------------------------------------------//

METHOD Activate( bLClicked, bMoved, bPainted, lCentered, ;
bValid, lModal, bInit, bRClicked, bWhen, lResize16 ) CLASS TDialog

static nDlgCount := 0

local hActiveWnd, hWnd, bDlgProc

DEFAULT lCentered := .f., lModal := .t., ::hWnd := 0, lResize16 := .f.

// ? 'debug line 243', valtype(bInit) // binit has not been executed yet!!!
// "B" if assigned for a dialog
// "U" if empty

::nLastKey = 0

++nDlgCount

hActiveWnd = If( ::oWnd != nil, ::oWnd:hWnd,;
If( nDlgCount > 1 .or. lWRunning(),;
GetActiveWindow(), GetWndApp() ) )

::lCentered = lCentered
::lModal = lModal
::bLClicked = bLClicked
::bRClicked = bRClicked
::bWhen = bWhen
::bValid = bValid
::bInit = bInit
::bPainted = bPainted
::bMoved = bMoved
::nResult = nil
::lValidating = .f.
::lVisible = .t.
::lResize16 = lResize16
::lHelpIcon := .F. // added 06/sep/2006 V.

// ? 'DEBUG LINE 267', VALTYPE(::binit), lModal // block not executed yet!!! lModal is .T.
// "B" if assigned, "U" if empty

if ::bWhen != nil
if ! Eval( ::bWhen, Self )
::nResult = IDCANCEL
::lVisible = .f.
return nil // <<---------- Warning: Exiting!
endif
endif

// ::AEvalWhen() 16-12-04 moved to TDialog:Initiate()

if lModal
#ifndef __XPP__
// ? 'debug line 285', ::cResName, ::hResources, Self:hWnd

::nResult = if( ! Empty( ::cResName ),;
( DialogBox( ::hResources, ::cResName,; // bInit is executed here!
hActiveWnd, Self ) , iif(Valtype(::oBrush) == "O", FixSay(::hWnd), NIL) ) ,; // V.
( DialogBoxIndirect( GetInstance(),;
If( ! Empty( ::cResData ), ::cResData, ::cToChar( hActiveWnd ) ),;
hActiveWnd, Self ), iif(Valtype(::oBrush) == "O", FixSay(::hWnd), NIL) ) )

// hActiveWnd, Self ) , iif(Valtype(::oBrush) == "O", FixSay(::hWnd), NIL) ) ,; // V.

#else

bDlgProc = { | nMsg, nWParam, nLParam | ;
Self:HandleEvent( nMsg, nWParam, nLParam ) }
::nResult = if( ! Empty( ::cResName ),;
DialogBox( ::hResources, ::cResName,;
hActiveWnd, bDlgProc ),;
DialogBoxIndirect( GetInstance(),;
If( ! Empty( ::cResData ), ::cResData, ::cToChar( hActiveWnd ) ),;
hActiveWnd, bDlgProc ) )
#endif


// ? 'debug line 301', 'Block executed?' // YES it has been executed here !!!

#ifdef __CLIPPER__
if ::nResult == -1
#else
if ::nResult == 65535
#endif
CreateDlgError( Self )
endif
// ? 'debug line 315'
else
// ? 'debug line 316'
if ( Len( ::aControls ) > 0 .and. CanRegDialog() ) .or. ;
Len( ::aControls ) == 0

#ifndef __XPP__
::hWnd = if( ! Empty( ::cResName ),;
CreateDlg( ::hResources, ::cResName,;
hActiveWnd, Self ),;
CreateDlgIndirect( GetInstance(), ::cToChar( hActiveWnd ),;
hActiveWnd, Self ) )
#else
bDlgProc = { | nMsg, nWParam, nLParam | ;
Self:HandleEvent( nMsg, nWParam, nLParam ) }
::hWnd = if( ! Empty( ::cResName ),;
CreateDlg( ::hResources, ::cResName,;
hActiveWnd, bDlgProc ),;
CreateDlgIndirect( GetInstance(), ::cToChar( hActiveWnd ),;
hActiveWnd, bDlgProc ) )
if Empty( ::cResName )
::Initiate()
endif
#endif

if ::hWnd == 0
CreateDlgError( Self )
endif

if Len( ::aControls ) > 0 .and. ! RegDialog( ::hWnd )
::SendMsg( WM_CLOSE )
MsgAlert( "Not possible to create more non-modal Dialogs" )
endif

ShowWindow( ::hWnd )

else
MsgAlert( "Not possible to create more non-modal Dialogs" )
endif
endif

// ? 'check line 355'

nDlgCount--

if ::lModal
::lVisible = .f.
endif

return nil

//---------------------------------------------------------------------------//

METHOD DefControl( oCtrl ) CLASS TDialog

DEFAULT oCtrl:nId := oCtrl:GetNewId()

if AScan( ::aControls, { | o | o:nId == oCtrl:nId } ) > 0
#define DUPLICATED_CONTROLID 2
Eval( ErrorBlock(), _FWGenError( DUPLICATED_CONTROLID, ;
"No: " + Str( oCtrl:nId, 6 ) ) )
else
AAdd( ::aControls, oCtrl )
oCtrl:hWnd = 0
endif

return nil

//----------------------------------------------------------------------------//

METHOD Command( nWParam, nLParam ) CLASS TDialog

local oWnd, nNotifyCode, nID, hWndCtl

#ifdef __CLIPPER__
nNotifyCode = nHiWord( nLParam )
nID = nWParam
hWndCtl = nLoWord( nLParam )
#else
nNotifyCode = nHiWord( nWParam )
nID = nLoWord( nWParam )
hWndCtl = nLParam
#endif

do case
case ::oPopup != nil
::oPopup:Command( nID )

case hWndCtl == 0 .and. ::oMenu != nil .and. ;
If( nNotifyCode == BN_CLICKED, nID != IDCANCEL, .f. )
::oMenu:Command( nID )

case GetClassName( hWndCtl ) == "ToolbarWindow32"
oWndFromHwnd( hWndCtl ):Command( nWParam, nLParam )

case nID != 0
do case
case nNotifyCode == BN_CLICKED
if hWndCtl != 0 .and. nID != IDCANCEL
oWnd := oWndFromhWnd( hWndCtl )
if ValType( ::nResult ) == "O" // latest control which had focus
// There is a pending Valid, it is not a clicked button
if oWnd != nil
if ! oWnd:lCancel
if ::nResult:nID != nID .and. ! ::nResult:lValid()
return nil
endif
endif
else
if ::nResult:nID != nID .and. ! ::nResult:lValid()
return nil
endif
endif
endif

if AScan( ::aControls, { |o| o:nID == nID } ) > 0
#ifdef __XPP__
PostMessage( hWndCtl, FM_CLICK, 0, 0 )
#else
SendMessage( hWndCtl, FM_CLICK, 0, 0 )
#endif
elseif nID == IDOK
::End( IDOK )
endif
else
if nID == IDOK
::GoNextCtrl( GetFocus() )
elseif hWndCtl != 0 .and. ; // There is a control for IDCANCEL
AScan( ::aControls, { |o| o:nID == nID } ) > 0
SendMessage( hWndCtl, FM_CLICK, 0, 0 )
else
::End( IDCANCEL )
endif
endif

case nNotifyCode == CBN_SELCHANGE
SendMessage( hWndCtl, FM_CHANGE, 0, 0 )

case nNotifyCode == CBN_CLOSEUP
SendMessage( hWndCtl, FM_CLOSEUP, 0, 0 )

#ifdef __CLIPPER__

case nID == FN_ZIP // FiveWin notifications codes
::Zip( nLParam )

case nID == FN_UNZIP
::UnZip( nPtrWord( nLParam ) )

#endif
endcase
endcase

return nil

//----------------------------------------------------------------------------//

METHOD CtlColor( hWndChild, hDCChild ) CLASS TDialog

local uVal

#ifndef __CLIPPER__
if ::oWnd != nil .and. Upper( ::oWnd:ClassName() ) $ "TFOLDER,TPAGES" ;
.and. GetClassName( hWndChild ) $ "Button,Static" ;
.and. IsAppThemed()
uVal = DrawThemed( hWndChild, hDCChild )
SendMessage( hWndChild, FM_COLOR, hDCChild )
return uVal
endif
#endif

return Super:CtlColor( hWndChild, hDCChild )

//----------------------------------------------------------------------------//

METHOD cToChar( hActiveWnd ) CLASS TDialog

local cResult
local aControls := ::aControls
local n := GetDlgBaseUnits()
local aRect := GetWndRect( hActiveWnd )

DEFAULT ::cCaption := ""

#ifndef __CLIPPER__
cResult = cDlg2Chr( Len( aControls ),;
int( 8 * ( ::nTop - aRect[ 1 ] ) / nHiWord( n ) ),;
int( 4 * ( ::nLeft - aRect[ 2 ] ) / nLoWord( n ) ),;
int( 8 * ( ::nBottom - aRect[ 1 ] ) / nHiWord( n ) ),;
int( 4 * ( ::nRight - aRect[ 2 ] ) / nLoWord( n ) ),;
::cCaption + If( Len( ::cCaption ) % 2 != 0, " ", "" ),;
::nStyle )
#else
cResult = cDlg2Chr( Len( aControls ),;
int( 8 * ( ::nTop - aRect[ 1 ] ) / nHiWord( n ) ),;
int( 4 * ( ::nLeft - aRect[ 2 ] ) / nLoWord( n ) ),;
int( 8 * ( ::nBottom - aRect[ 1 ] ) / nHiWord( n ) ),;
int( 4 * ( ::nRight - aRect[ 2 ] ) / nLoWord( n ) ),;
::cCaption, ::nStyle )
#endif

for n = 1 to Len( aControls )
cResult += aControls[ n ]:cToChar()
next

return cResult

//----------------------------------------------------------------------------//

METHOD Define( nTop, nLeft, nBottom, nRight, cCaption, nStyle, lVbx,;
nClrText, nClrBack, oBrush ) CLASS TDialog

DEFAULT lVbx := .f.,;
nClrText := GetSysColor( COLOR_BTNTEXT ), nClrBack := GetSysColor( COLOR_BTNFACE )

::hWnd = 0
::nTop = nTop
::nLeft = nLeft
::nBottom = nBottom
::nRight = nRight
::cCaption = cCaption
::nStyle = nStyle
::lVbx = lVbx
::nLastKey = 0
::oBrush := oBrush // added 06/04/2009 V.
::lHelpIcon := .F. // added 06/sep/2006 V.

::SetColor( nClrText, nClrBack, oBrush )

return Self

//----------------------------------------------------------------------------//

METHOD End( nResult ) CLASS TDialog

DEFAULT nResult := 2 // Cancel

// ? 'END entrance', valtype(::obrush) --> "O" if not empty


if ! ::lModal
// if ::oWnd == nil .or. Upper( ::oWnd:ClassName() ) != "TMDICHILD"
PostMessage( ::hWnd, WM_CLOSE, nResult )
// endif
else
if ValType( ::bValid ) == "B"
if ! Eval( ::bValid, Self )
return .f.
endif
endif
::nResult = nResult
EndDialog( ::hWnd, nResult )
::hWnd = 0 // A.L. 22/04/03
endif

if valtype(::obrush) == "O" // V.
::obrush:End()
::obrush := NIL // becomes --> "U"
endif // V.

#ifdef __HARBOUR__
SysRefresh()
hb_gcAll() // Garbage collector
#endif


// ? 'END finished', valtype(::obrush) --> "U"

return .t.

//----------------------------------------------------------------------------//
// Conection with Borland's VBX DLL - at run-time !!!

DLL STATIC FUNCTION VbxInitDialog( hWnd AS WORD, hInstance AS WORD,;
cResName AS STRING ) AS BOOL PASCAL LIB "BIVBX10.DLL"

DLL STATIC FUNCTION VbxInit( hInstance AS WORD, cPrefix AS STRING ) ;
AS BOOL PASCAL LIB "BIVBX10.DLL"

DLL STATIC FUNCTION VbxTerm() AS VOID PASCAL LIB "BIVBX10.DLL"

//----------------------------------------------------------------------------//

static function CreateDlgError( Self )

local cRes := If( ValType( ::cResName ) == "N", Str( ::cResName ), ::cResName )
local cPad := Replicate( Chr( 32 ), 22 )

#define CANNOTCREATE_DIALOG 3
Eval( ErrorBlock(), ;
_FwGenError( CANNOTCREATE_DIALOG, CRLF + cPad + ;
If( ! Empty( cRes ), "Resource: " + cRes,;
"Title: " + If( Empty( ::cCaption ), "", ::cCaption ) ) ) )
return nil

//----------------------------------------------------------------------------//

METHOD GetHotPos( nChar, hCtrlAt ) CLASS TDialog

local hCtrl := GetWindow( ::hWnd, GW_CHILD )
local nAt, cText

while hCtrl != 0
if hCtrl != hCtrlAt .and. GetParent( hCtrl ) == ::hWnd .and. ;
IsWindowEnabled( hCtrl ) .and. ;
( nAt := At( "&", cText := GetWindowText( hCtrl ) ) ) != 0 .and. ;
Lower( SubStr( cText, nAt + 1, 1 ) ) == Lower( Chr( nChar ) )
while Upper( GetClassName( hCtrl ) ) == "STATIC" .and. hCtrl != 0
hCtrl = GetWindow( hCtrl, GW_HWNDNEXT )
end
return hCtrl
else
hCtrl = GetWindow( hCtrl, GW_HWNDNEXT )
endif
end

return 0

//----------------------------------------------------------------------------//

METHOD Help( nWParam, nLParam ) CLASS TDialog

local hWndChild := HelpCtrlHwnd( nLParam ), nAtChild

static lShow := .f.

::lHelpIcon = .f.

if ! lShow
lShow = .t.
if ( nAtChild := AScan( ::aControls, { | o | o:hWnd == hWndChild } ) ) != 0
::aControls[ nAtChild ]:HelpTopic()
else
::HelpTopic()
endif
lShow = .f.
endif

return nil

//----------------------------------------------------------------------------//

METHOD Initiate( hWndFocus, hWnd ) CLASS TDialog

local lFocus := .t., lResult, hCtrl, lEnd := .f., aRect

if hWnd != nil
::hWnd = hWnd
endif

if ! ::lModal
#ifdef __CLIPPER__
::Link( .f. ) // Just to keep a reference at aWindows. No need to subclass it
#else
::Link()
#endif
endif

if ::lVbx
if ! VbxInitDialog( ::hWnd, GetResources(), ::cResName )
MsgAlert( "Error on VBX's initialization" )
endif
endif

if ::oFont == nil
::GetFont()
else
::SetFont( ::oFont )
endif
::lHelpIcon := .F. // added 06/sep/2006 V.
if ::lTransparent
FixSays( ::hWnd )
AEval( ::aControls,;
{ | o | If( ! Upper( o:ClassName() ) $ ;
"TGET;TMULTIGET;TBTNBMP;TCOMBOBOX;TWBROWSE;TCBROWSE;TXBROWSE;TLISTBOX;TSAY;",;
o:lTransparent := .t.,) } )
endif

// We can resist to use something more, more faster !!! <g>
// AEval( ::aControls, { | oCtrl | oCtrl:Initiate( ::hWnd ) } )
#ifdef __CLIPPER__
ASend( ::aControls, "INITIATE", ::hWnd )
#else
#ifdef __C3__
ASend( ::aControls, "INITIATE", ::hWnd )
#else
ASend( ::aControls, "INITIATE()", ::hWnd )
#endif
#endif

#ifndef __CLIPPER__ // This makes FW resources dialogs look the same with FWH/FW++
#define SCALE_FACTOR 1.16668
if ::lResize16 .and. ! Empty( ::cResName )
::nWidth = ::nWidth * SCALE_FACTOR
hCtrl = GetWindow( ::hWnd, GW_CHILD )
if hCtrl != 0
do while ! lEnd
aRect = GetCoors( hCtrl )
SetWindowPos( hCtrl, 0, aRect[ 1 ], aRect[ 2 ] * SCALE_FACTOR,;
( aRect[ 4 ] - aRect[ 2 ] ) * SCALE_FACTOR,;
aRect[ 3 ] - aRect[ 1 ], nOr( SWP_NOZORDER,;
SWP_NOREDRAW, SWP_NOACTIVATE ) )
hCtrl = GetWindow( hCtrl, GW_HWNDNEXT )
lEnd = ! ( ( hCtrl != 0 ) .and. ( GetParent( hCtrl ) == ::hWnd ) )
end
endif
endif
#endif

if ::lCentered
WndCenter( ::hWnd )
else
if Empty( ::cResName )
::Move( ::nTop, ::nLeft )
endif
endif

if ::cCaption != nil
SetWindowText( ::hWnd, ::cCaption )
endif

::Help95() // activates the help icon on the caption

if ! Empty( ::cResName )
::nStyle := GetWindowLong( ::hWnd, GWL_STYLE )
endif

if lAnd( ::nStyle, WS_VSCROLL )
DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self
endif
if lAnd( ::nStyle, WS_HSCROLL )
DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self
endif

if ::oIcon != nil
SendMessage( ::hWnd, WM_SETICON, 0, ::oIcon:hIcon )
endif

if ::bInit != nil
FixSay(::hWnd)
lResult = Eval( ::bInit, Self )
if ValType( lResult ) == "L" .and. ! lResult
lFocus = .f.
endif
endif

::AEvalWhen()

return lFocus // .t. for default focus

//----------------------------------------------------------------------------//

METHOD EraseBkGnd( hDC ) CLASS TDialog

if ! Empty( ::bEraseBkGnd )
return Eval( ::bEraseBkGnd, hDC )
endif

if ::oBrush != nil
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
return 1 // Leave a 1 here 26/01/04 A.L. !!!
endif

return nil

//----------------------------------------------------------------------------//

METHOD Close( nResult ) CLASS TDialog

if ! ::lModal
if ValType( ::bValid ) == "B"
if ! Eval( ::bValid, Self )
#ifdef __CLIPPER__
return nil // keep nil here
#else
return .f.
#endif
endif
endif
::nResult = nResult
::lVisible = .f.
DestroyWindow( ::hWnd )
return .t.
endif

return nil

//----------------------------------------------------------------------------//

METHOD KeyChar( nKey, nFlags ) CLASS TDialog

if nKey == VK_ESCAPE
if ! Empty( ::bKeyChar )
Eval( ::bKeyChar, nKey, nFlags, Self )
endif
if ::oWnd == nil
// ::End() 14/March/06
else
if ::oWnd:ChildLevel( TMdiChild() ) != 0
::End()
else
if ::oWnd:ChildLevel( TDialog() ) != 0
::End()
#ifdef __HARBOUR__
elseif Upper( ::oWnd:ClassName() ) == "TMDIFRAME" // To avoid ESC being ignored
::End()
#endif
else
return Super:KeyChar( nKey, nFlags )
endif
endif
endif
else
return Super:KeyChar( nKey, nFlags )
endif

return nil

//----------------------------------------------------------------------------//

METHOD KeyDown( nKey, nFlags ) CLASS TDialog

if nKey == VK_ESCAPE
if ! Empty( ::bKeyDown )
Eval( ::bKeyDown, nKey, nFlags, Self )
endif
if ! Empty( ::bKeyDown )
Eval( ::bKeyDown, nKey, nFlags, Self )
endif
if ::oWnd == nil
::End()
else
if ::oWnd:ChildLevel( TMdiChild() ) != 0
::End()
else
if ::oWnd:ChildLevel( TDialog() ) != 0
::End()
#ifdef __HARBOUR__
elseif Upper( ::oWnd:ClassName() ) == "TMDIFRAME" // To avoid ESC being ignored
::End()
#endif
else
return Super:KeyDown( nKey, nFlags )
endif
endif
endif
else
return Super:KeyDown( nKey, nFlags )
endif

return nil

//----------------------------------------------------------------------------//

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TDialog

if ::lHelpIcon != nil .and. ! ::lHelpIcon
if ::oCursor != nil
SetCursor( ::oCursor:hCursor )
else
CursorArrow()
endif
endif

::SetMsg( ::cMsg )

::CheckToolTip()

if ::bMMoved != nil
return Eval( ::bMMoved, nRow, nCol, nKeyFlags )
endif

return .f.

//----------------------------------------------------------------------------//

METHOD Paint() CLASS TDialog

local uVal

if ValType( ::bPainted ) == "B"
uVal = Eval( ::bPainted, ::hDC, ::cPS, Self )
endif
if valtype(::oBrush) == "O" // V.
// ? 'restoring colors'
FixSay(Self:hWnd)
RestColors(Self)
endif // V.

return uVal

//----------------------------------------------------------------------------//

METHOD SetFont( oFont ) CLASS TDialog

local hDlg := ::hWnd
local hCtrl := GetWindow( hDlg, GW_CHILD )
local hFont := If( ::oFont != nil, ::oFont:hFont, 0 )

Super:SetFont( oFont )

if hFont != 0
while hCtrl != 0 .and. GetParent( hCtrl ) == hDlg
SendMessage( hCtrl, WM_SETFONT, hFont, 1 )
hCtrl = GetWindow( hCtrl, GW_HWNDNEXT )
end
endif

return nil

//----------------------------------------------------------------------------//

METHOD SysCommand( nWParam, nLParam ) CLASS TDialog

if nWParam == SC_CLOSE .and. ::lModal
return .f.
endif

if nWParam == SC_HELP
::lHelpIcon = .F. // CHANGED 06/SEP/2006 V.
return .f.
endif

return Super:SysCommand( nWParam, nLParam )

//----------------------------------------------------------------------------//

METHOD Help95() CLASS TDialog
::lHelpIcon := .F. // added 06/sep/2006 V.

if ::lHelpIcon == nil
::lHelpIcon := .f.
endif

if ::lHelpIcon
SetWindowLong( ::hWnd, GWL_EXSTYLE,;
nOr( GetWindowLong( ::hWnd, GWL_EXSTYLE ), WS_EX_CONTEXTHELP ) )
endif

return nil

//----------------------------------------------------------------------------//

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TDialog

do case
case nMsg == WM_INITDIALOG
return ::Initiate( nWParam, nLParam )

case nMsg == WM_PAINT
return ::Display()

case nMsg == WM_PRINTCLIENT
return ::PrintClient( nWParam )

case nMsg == WM_LBUTTONDOWN
if ::lHelpIcon
::Help()
endif

otherwise
return Super:HandleEvent( nMsg, nWParam, nLParam )
endcase

return nil

//----------------------------------------------------------------------------//



#PRAGMA BEGINDUMP

#include <WinTen.h>
#include <windows.h>
#include <ClipApi.h>

//typedef int (FAR WINAPI *FARPROC)();


void WindowBoxBlack( HDC hDC, RECT * pRect );

LRESULT static CALLBACK LabelProc( HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam )
{
if( uMsg == WM_ERASEBKGND )
{
return 1;
}

else if( uMsg == 0x0128 ) // SAYs were erased when pressing ALT WM_UPDATEUISTATE
{
LONG lResult = CallWindowProc( ( FARPROC ) GetProp( hWnd, "__FWTRANS" ), hWnd, uMsg, wParam, lParam );
InvalidateRect( hWnd, NULL, TRUE );
return lResult;
}

else if( uMsg == WM_PAINT )
{
PAINTSTRUCT ps;
char text[ 256 ];
RECT rct;
HDC hDC = BeginPaint( hWnd, &ps );
HGDIOBJ hOldFont;

GetWindowText( hWnd, text, 255 );
GetClientRect( hWnd, &rct );
SetBkMode( hDC, TRANSPARENT );
SelectObject( hDC, GetStockObject( DEFAULT_GUI_FONT ) );

SendMessage( GetParent( hWnd ), WM_CTLCOLORSTATIC, ( WPARAM ) hDC, ( LPARAM ) hWnd );
hOldFont = SelectObject( hDC, ( HGDIOBJ ) SendMessage( hWnd, WM_GETFONT, 0, 0 ) );

if( ( GetWindowLong( hWnd, GWL_STYLE ) & SS_BLACKFRAME ) == SS_BLACKFRAME )
{
RECT rct;

GetClientRect( hWnd, &rct );
WindowBoxBlack( hDC, &rct );
}

else if( GetWindowLong( hWnd, GWL_STYLE ) & SS_CENTER )
DrawText( hDC, text, lstrlen( text ), &rct, DT_CENTER | DT_WORDBREAK );

else if( GetWindowLong( hWnd, GWL_STYLE ) & SS_RIGHT )
DrawText( hDC, text, lstrlen( text ), &rct, DT_RIGHT | DT_WORDBREAK );

else if( GetWindowLong( hWnd, GWL_STYLE ) & SS_LEFTNOWORDWRAP )
DrawText( hDC, text, lstrlen( text ), &rct, DT_LEFT );

else
DrawText( hDC, text, lstrlen( text ), &rct, DT_LEFT | DT_WORDBREAK );

SelectObject( hDC, hOldFont );

EndPaint( hWnd, &ps );

return 0;
}
else
return CallWindowProc( ( FARPROC ) GetProp( hWnd, "__FWTRANS" ), hWnd, uMsg, wParam, lParam );
}


HARBOUR HB_FUN_FIXSAYS()
{
HWND hDlg = ( HWND ) _parnl( 1 );
HWND hCtrl = GetWindow( hDlg, GW_CHILD );
char className[ 64 ];
WNDPROC pLabelProc = NULL;

while( hCtrl != NULL )
{
GetClassName( hCtrl, className, sizeof( className ) );

/* if( ! lstrcmp( "Static", className ) ) // * && ! ( ( GetWindowLong( hCtrl, GWL_STYLE ) & WS_BORDER ) == WS_BORDER ) */

if( ! lstrcmp( "Static", className ) && ! ( ( GetWindowLong( hCtrl, GWL_STYLE ) & SS_ICON ) == SS_ICON ) && ! ( ( GetWindowLong( hCtrl, GWL_STYLE ) & WS_BORDER ) == WS_BORDER ) )
{
if( GetWindowLong( hCtrl, GWL_WNDPROC ) != ( LONG ) LabelProc )
{
pLabelProc = ( WNDPROC ) SetWindowLong( hCtrl, GWL_WNDPROC,
( LONG ) LabelProc );
SetProp( hCtrl, "__FWTRANS", ( HANDLE ) pLabelProc );
}
}

hCtrl = GetWindow( hCtrl, GW_HWNDNEXT );
}

while( hCtrl != NULL )
{
GetClassName( hCtrl, className, sizeof( className ) );

if( ! lstrcmp( "Checkbox", className ) ) /* && ! ( ( GetWindowLong( hCtrl, GWL_STYLE ) & WS_BORDER ) == WS_BORDER ) */

{
if( GetWindowLong( hCtrl, GWL_WNDPROC ) != ( LONG ) LabelProc )
{
pLabelProc = ( WNDPROC ) SetWindowLong( hCtrl, GWL_WNDPROC,
( LONG ) LabelProc );
SetProp( hCtrl, "__FWTRANS", ( HANDLE ) pLabelProc );
}
}

hCtrl = GetWindow( hCtrl, GW_HWNDNEXT );
}

}

#PRAGMA ENDDUMP



Function RESTCOLORS(odlg)
*------------------------
local i, n, frnt, bck

n := Len(odlg:acontrols)

for i := 1 to n
// bck := odlg:acontrols[i]:nClrPane // rdlg:aControls[i]:ClassName() == 'TSAY'
// ? i, bck, odlg:acontrols[i]:ClassName() , , odlg:acontrols[i]:ccaption, odlg:acontrols[i]:lTransparent
if UPPER(odlg:acontrols[i]:ClassName()) == "TSAY" .or. ;
UPPER(odlg:acontrols[i]:ClassName()) == "TMETER"

frnt := odlg:acontrols[i]:nClrText
bck := odlg:acontrols[i]:nClrPane

if bck # 14215660
odlg:acontrols[i]:lTransparent := .F.
odlg:acontrols[i]:setcolor(frnt, bck)
odlg:acontrols[i]:Refresh()
// ? 'painted...', odlg:acontrols[i]:ClassName() , , odlg:acontrols[i]:ccaption
endif
endif

next i

Return NIL



Function FixSay( oDlgxxx )
*-------------------------
if valtype(odlgxxx) == "O"
Return FixSays( oDlgxxx:hWnd )
endif
Return FixSays( oDlgxxx )

[StefanHaupt]

Evans,

thanks for your contribution, but I get these errors compiling with bcc

Error E2342 Source\\Dialog.prg 1018: Type mismatch in parameter 'lpPrevWndFunc' (wanted 'long (__stdcall *)(HWND__ *,unsigned int,unsigned int,long)', got 'int (__stdcall *)()') in function LabelProc
Error E2342 Source\\Dialog.prg 1066: Type mismatch in parameter 'lpPrevWndFunc' (wanted 'long (__stdcall *)(HWND__ *,unsigned int,unsigned int,long)', got 'int (__stdcall *)()') in function LabelProc

[E. Bartzokas]

Stefan,
I apologize but I am using an older version of FWH (Feb of 2006)
You may find where I've made changes in my own DIALOG.PRG, and
apply these changes to your DIALOG.PRG.
I'm sure that the two files (DIALOG.PRG) must be different by now!
You can spot the changes if you search for "// V." (this V. stands for Vagelis or Evans)

Please let me know if you succeed.
Thanks and once again sorry for the inconvenience.
ps. Please notice that the "C" code which is at the bottom of the DIALOG.PRG, which
I've posted here, is neccessary. You will have to copy it and paste it to your DIALOG.PRG

Evans,

thanks for your contribution, but I get these errors compiling with bcc

Error E2342 Source\\Dialog.prg 1018: Type mismatch in parameter 'lpPrevWndFunc' (wanted 'long (__stdcall *)(HWND__ *,unsigned int,unsigned int,long)', got 'int (__stdcall *)()') in function LabelProc
Error E2342 Source\\Dialog.prg 1066: Type mismatch in parameter 'lpPrevWndFunc' (wanted 'long (__stdcall *)(HWND__ *,unsigned int,unsigned int,long)', got 'int (__stdcall *)()') in function LabelProc

[StefanHaupt]

Hi Evans,

the error does not depend on the fwh source, it´s an error in your c module. Do you use borland or ms c ? Maybe it´s a incompatibility between the two compilers.

[E. Bartzokas]

Stefan hi,
I am using xHarbour builder, so I guess, I'm using PELES.
I have no means of testing the C code with Borland.
The C code, is for making the static dialog SAYs transparent, and I have copied it from this news group.

Again, sorry for the inconvenience.
Perhaps Antonio can help more with this...

Kind regards
Evans

Hi Evans,

the error does not depend on the fwh source, it´s an error in your c module. Do you use borland or ms c ? Maybe it´s a incompatibility between the two compilers.

[StefanHaupt]

Hi Evans,

Stefan hi,
I am using xHarbour builder, so I guess, I'm using PELES.

Ok, that explains the error, there must be some different definitions in the header files. Thanks anyway for your support.

Maybe any c-guru in this forum can help to support this piece of code to borland c.