Announcement

Collapse
No announcement yet.

Draw Rect with mouse, and grid sample..

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Draw Rect with mouse, and grid sample..

    http://www.powerbasic.com/support/pb...ad.php?t=23727

    The rectangle shows on my machine but disappears upon mouse release, and I think this was intended behavior.

    If you comment out the second of these two lines the rectangle remains on the dialog, but other things begin to happen raise their head, like you have to use Escape to close the dialog, the mouse won't move out of the client area, etc.
    CASE %WM_LBUTTONUP 'mouse button released - end draw
    selRectEnd CBHNDL
    Last edited by Rodney Hicks; 4 Aug 2009, 05:24 AM.
    Rod
    In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

  • #2
    Could not locate this old code, so posted here, ready to compile under PBWIN901.
    Cut paste the object.rc file at the bottom and create the object.pbr file.

    Code:
    'MESSAGE http://www.powerbasic.com/support/forums/Archives/Archive-000002/HTML/20020808-7-000391.html
    'FORUM:  Source Code
    'TOPIC:  Archive: Objects Demo
    'NAME:   Jules Marchildon, Member
    'DATE:   December 08, 1999 06:59 AM
    
    '-------------------------------------------------------------------
    ' OBJECTS.C
    ' Stefano Maruzzi 1996
    ' Drawing objects on the screen
    ' Translated OBJECTS.C to OBJECTS.BAS 
    ' Last updated to compile with PBWIN901
    '------------------------------------------------------------------------
    
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
    #INCLUDE "COMDLG32.INC"
    #RESOURCE "OBJECT.PBR"
    
    
    ' Microsoft Visual C++ generated include file.
    ' Used by objects.rc
    %MAXINDEXSHAPES  = 100
    %MN_EXIT         = 40001
    %MN_RECTANGLE    = 40002
    %MN_ELLIPSE      = 40003
    %MN_ABOUT        = 40004
    %MN_RED          = 40005
    %MN_GREEN        = 40006
    %MN_BLUE         = 40007
    %MN_CHOOSECOLOR  = 40008
    %MN_CLEARALL     = 40009
    %MN_OBJECTNUM    = 40010
    %MN_AREA         = 40011
    %MN_OBJECTTYPE   = 40012
    
    %MAXSHAPES     = 100
    %OB_RECTANGLE  = 0
    %OB_ELLIPSE    = 1
    
    ' NOTE: the following three items are not in "WIN32API.INC"
    %MFS_DISABLED  = 3
    %MFS_ENABLED   = 0
    %MFS_UNCHECKED = 0
    
    %TPM_TOPALIGN  = 0   ' <-- add if missing from your Include file
    
    
    TYPE SHAPE
       rc     AS RECT
       iShape AS LONG
       clr    AS LONG
    END TYPE
    
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION WINMAIN (BYVAL hInstance AS LONG, BYVAL hPrevInstance AS LONG, _
                      BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) EXPORT AS LONG
    
    LOCAL hwnd          AS LONG
    LOCAL iTemp         AS LONG
    LOCAL msg           AS tagMSG
    LOCAL szClassName   AS ASCIIZ * 128
    LOCAL szWindowTitle AS ASCIIZ * 128
    LOCAL wc            AS WNDCLASSEX
    
    
    szClassName = "OBJECTS"
    szWindowTitle = "GDI objects"
    
    wc.cbSize = SIZEOF(wc)
    wc.style = %CS_VREDRAW OR %CS_HREDRAW
    wc.lpfnWndProc = CODEPTR(ClientWndProc)
    wc.cbClsExtra = 0
    wc.cbWndExtra = 0
    wc.hInstance = hInstance
    wc.hIcon = LoadIcon(hInstance, "objects")
    wc.hIconSm = LoadIcon(hInstance, "objects")
    wc.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
    wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
    wc.lpszMenuName = %NULL
    wc.lpszClassName = VARPTR(szClassName)
    
    IF RegisterClassEx(wc) = 0 THEN
        CALL MessageBeep(0)
        FUNCTION = %FALSE
        EXIT FUNCTION
    END IF
    iTemp = LoadMenu(hInstance, "mainmenu")
    
    hwnd = CreateWindowEx(  %WS_EX_CLIENTEDGE OR %WS_EX_WINDOWEDGE, _
                            szClassName,                    _
                            szWindowTitle,                  _
                            %WS_OVERLAPPEDWINDOW,           _
                            %CW_USEDEFAULT,                 _
                            0,                              _
                            %CW_USEDEFAULT,                  _
                            0,                              _
                            %NULL,                          _
                            iTemp,                          _
                            hInstance,                      _
                            BYVAL %NULL)
    
    CALL ShowWindow(hwnd, %SW_SHOWNORMAL)
    
    ' message loop
    WHILE GetMessage(msg, %NULL, 0, 0)
        CALL TranslateMessage(msg)
        CALL DispatchMessage(msg)
    WEND
    
    FUNCTION = %FALSE
    
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION ClientWndProc(BYVAL hwnd AS LONG,    _
                           BYVAL msg AS DWORD,    _
                           BYVAL wParam AS LONG,  _
                           BYVAL lParam AS LONG) AS LONG
    
    STATIC fDrawing      AS LONG
    STATIC fDrag         AS LONG
    STATIC iPos          AS LONG
    STATIC iDrag         AS LONG
    STATIC xStart        AS LONG
    STATIC yStart        AS LONG
    STATIC hInstance     AS LONG
    STATIC iCnt          AS LONG
    
    
    DIM Shapes(%MAXSHAPES + 1)  AS STATIC SHAPE
    DIM acrCustClr(0 TO 16)     AS STATIC DWORD
    
    
    LOCAL i              AS LONG
    LOCAL x              AS LONG
    LOCAL y              AS LONG
    LOCAL hrgn           AS LONG
    LOCAL hdc            AS LONG
    LOCAL hpopup         AS LONG
    LOCAL iSize          AS LONG
    LOCAL rgbColor       AS DWORD
    
    LOCAL pt             AS POINTAPI
    LOCAL npoint         AS POINTAPI
    LOCAL mii            AS MENUITEMINFO
    LOCAL cc             AS CHOOSECOLORAPI
    LOCAL ps             AS PAINTSTRUCT
    LOCAL szText         AS ASCIIZ * 40
    LOCAL LPCREATESTRUCT AS CREATESTRUCT PTR
    
    SELECT CASE msg
    CASE %WM_CREATE
         LPCREATESTRUCT = lParam
         hInstance = @LPCREATESTRUCT.hInstance
    
        ' radio check the %MN_RECTANGLE item
        CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RECTANGLE, %MN_ELLIPSE, %MN_RECTANGLE, %MF_BYCOMMAND)
    
        ' radio check the %MN_RED item
        CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RED, %MN_CHOOSECOLOR, %MN_RED, %MF_BYCOMMAND)
    
        ' define the next color
        Shapes(iPos).clr =  RGB(255, 0, 0)
    
        ' define the next shape
        Shapes(iPos).iShape =  %OB_RECTANGLE
    
    CASE %WM_COMMAND
        SELECT CASE LOWRD(wParam)
        CASE %MN_EXIT
            CALL PostQuitMessage(0)
    
        CASE %MN_CLEARALL
            ' zero the counter
            iPos = 0
    
            ' zero the memory block
            ERASE Shapes
            DIM Shapes(%MAXSHAPES + 1) AS STATIC SHAPE
    
            ' start with red color
            Shapes(iPos).clr = RGB(255, 0, 0)
    
            ' define the current shape
            Shapes(iPos).iShape = %OB_RECTANGLE
    
            ' disable the Clear all menuitem
            mii.cbSize = SIZEOF(mii)
            mii.fMask  = %MIIM_STATE
            mii.fState = %MFS_DISABLED
    
            ' %MN_CLEARALL
            CALL SetMenuItemInfo(GetMenu(hwnd), %MN_CLEARALL, %FALSE, mii)
    
            ' Added next 3 items to clear up menu misinformation
            ' clear the ChooseColor menuitem
            CALL ClearChooseColor(hwnd, mii)
    
            ' radio check the %MN_RECTANGLE item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RECTANGLE, %MN_ELLIPSE, %MN_RECTANGLE, %MF_BYCOMMAND)
    
            ' check red menuitem
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RED, %MN_BLUE, %MN_RED, %MF_BYCOMMAND)
    
            ' invalidate the window
            CALL InvalidateRect(hwnd, BYVAL %NULL, %TRUE)
            CALL UpdateWindow(hwnd)
        CASE %MN_ABOUT
            'CALL DialogBoxParam(hInstance, "about", hwnd, CODEPTR(AboutDlgProc), 0&)
    
        CASE %MN_CHOOSECOLOR
            rgbColor = 0 'RGB(0, 0, 0) <-- Returns zero why call it??
    
            ' prepare the 16 custom colors
            cc.lStructSize = SIZEOF(cc)
            cc.hwndOwner = hwnd
            cc.hInstance = %NULL
            cc.rgbResult = rgbColor
            cc.lpCustColors = VARPTR(acrCustClr(0))
            cc.Flags = %CC_ENABLEHOOK
            cc.lCustData = 0
            cc.lpfnHook = CODEPTR(ColorsHookProc)
            cc.lpTemplateName = %NULL
    
            ' show the color common dialog
            IF ChooseColor(cc) = 0 THEN
               EXIT SELECT
            END IF
    
            ' radio check the %MN_RED item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RED, %MN_CHOOSECOLOR, %MN_CHOOSECOLOR, %MF_BYCOMMAND)
    
            ' store the color value
            'acrCustClr(iCnt) = cc.rgbResult  <-- this is wrong
    
            ' increase the counter
            IF iCnt = 15 THEN
                iCnt = 0
            ELSE
                INCR iCnt
            END IF
    
            ' define the brush color
            Shapes(iPos).clr = cc.rgbResult
    
        CASE %MN_RED
            ' clear the ChooseColor menuitem in case it's checked
            CALL ClearChooseColor(hwnd, mii)
    
            ' radio check the %MN_RED item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RED, %MN_BLUE, %MN_RED, %MF_BYCOMMAND)
    
            ' define the current shape
            Shapes(iPos).clr = RGB(255, 0, 0)
    
        CASE %MN_GREEN
            ' clear the ChooseColor menuitem in case it's checked
            CALL ClearChooseColor(hwnd, mii)
    
            ' radio check the %MN_GREEN item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RED, %MN_BLUE, %MN_GREEN, %MF_BYCOMMAND)
    
            ' define the current shape
            Shapes(iPos).clr = RGB(0, 255, 0)
    
        CASE %MN_BLUE
            ' clear the ChooseColor menuitem in case it's checked
            CALL ClearChooseColor(hwnd, mii)
    
            ' radio check the %MN_BLUE item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RED, %MN_BLUE, %MN_BLUE, %MF_BYCOMMAND)
    
            ' define the current shape
            Shapes(iPos).clr = RGB(0, 0, 255)
    
        CASE %MN_RECTANGLE
            ' define the current shape
            Shapes(iPos).iShape = %OB_RECTANGLE
    
            ' radio check the %MN_RECTANGLE item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RECTANGLE, %MN_ELLIPSE, %MN_RECTANGLE, %MF_BYCOMMAND)
    
        CASE %MN_ELLIPSE
            ' define the current shape
            Shapes(iPos).iShape = %OB_ELLIPSE
    
            ' radio check the %MN_ELLIPSE item
            CALL CheckMenuRadioItem(GetMenu(hwnd), %MN_RECTANGLE, %MN_ELLIPSE, %MN_ELLIPSE, %MF_BYCOMMAND)
    
        END SELECT
    
    CASE %WM_CLOSE
        CALL PostQuitMessage(0)
    
    CASE %WM_CONTEXTMENU
        pt.x = npoint.x = LOWRD(lParam)
        pt.y = npoint.y = HIWRD(lParam)
    
        ' convert in client coordinates
        CALL ScreenToClient(hwnd, npoint)
    
        FOR i = 0 TO iPos - 1
            SELECT CASE Shapes(i).iShape
            CASE %OB_RECTANGLE
                IF PtInRect(Shapes(i).rc, npoint.x, npoint.y) THEN
                    hpopup = LoadMenu(hInstance, "popup")
                    hpopup = GetSubMenu(hpopup, 0)
    
                    ' preparing menuitem 1
                    mii.cbSize = SIZEOF(mii)
                    mii.fMask = %MIIM_TYPE
                    mii.fType = %MFT_STRING
                    szText = "Object#:" + LTRIM$(STR$(i))
                    mii.cch = VARPTR(szText)
                    mii.dwTypeData = VARPTR(szText)
                    CALL SetMenuItemInfo(hpopup, %MN_OBJECTNUM, %FALSE, mii)
    
                    ' preparing menuitem 2
                    mii.cbSize = SIZEOF(mii)
                    mii.fMask = %MIIM_TYPE
                    mii.fType = %MFT_STRING
                    szText = "Object type: rectangle"
                    mii.cch = VARPTR(szText)
                    mii.dwTypeData = VARPTR(szText)
                    CALL SetMenuItemInfo(hpopup, %MN_OBJECTTYPE, %FALSE, mii)
    
                    ' display the popup menu
                    CALL TrackPopupMenu(hpopup, %TPM_TOPALIGN, pt.x, pt.y, 0, hwnd, BYVAL %NULL)
                    FUNCTION = %FALSE
                    EXIT FUNCTION
                END IF
    
            CASE %OB_ELLIPSE
                ' create a region
                hrgn = CreateEllipticRgn(Shapes(i).rc.nLeft, _
                                         Shapes(i).rc.nTop,   _
                                         Shapes(i).rc.nRight, _
                                         Shapes(i).rc.nBottom)
    
                IF PtInRegion(hrgn, nPoint.x, nPoint.y) THEN
                    hpopup = LoadMenu(hInstance, "popup")
                    hpopup = GetSubMenu(hpopup, 0)
    
                    ' preparing menuitem 1
                    mii.cbSize = SIZEOF(mii)
                    mii.fMask = %MIIM_TYPE
                    mii.fType = %MFT_STRING
                    mii.cch = wsprintf(szText, "Object#:%d", i)
                    mii.dwTypeData = VARPTR(szText)
                    CALL SetMenuItemInfo(hpopup, %MN_OBJECTNUM, %FALSE, mii)
    
                    ' preparing menuitem 2
                    mii.cbSize = SIZEOF(mii)
                    mii.fMask = %MIIM_TYPE
                    mii.fType = %MFT_STRING
                    szText = "Object type: ellipse"
                    mii.cch = VARPTR(szText)
                    mii.dwTypeData = VARPTR(szText)
                    CALL SetMenuItemInfo(hpopup, %MN_OBJECTTYPE, %FALSE, mii)
    
                    ' display the popup menu
                    CALL TrackPopupMenu(hpopup, %TPM_TOPALIGN, pt.x, pt.y, 0, hwnd, BYVAL %NULL)
                    FUNCTION = %FALSE
                    EXIT FUNCTION
                END IF
            END SELECT
        NEXT
    
    CASE %WM_LBUTTONDOWN
        pt.x = LOWRD(lParam)
        pt.y = HIWRD(lParam)
    
        CALL SetCapture(hwnd)
        xStart = LOWRD(lParam)
        yStart = HIWRD(lParam)
    
        FOR i = 0 TO iPos - 1
            IF PtInRect(Shapes(i).rc, pt.x, pt.y) THEN
                fDrag = %TRUE
                iDrag = i
                FUNCTION = %TRUE
                EXIT FUNCTION
            END IF
        NEXT
    
        ' starting to draw a new object
        fDrawing = %TRUE
    
    CASE %WM_MOUSEMOVE
        ' current X position
        x = LOWRD(lParam)
        ' current Y position
        y = HIWRD(lParam)
    
        IF fDrag THEN
            hdc = GetDC(hwnd)
            CALL SetROP2(hdc, %R2_NOTXORPEN)
    
            ' erasing the previous rectangle
            CALL DrawFocusRect(hdc, Shapes(iDrag).rc)
    
            ' OffsetRect(Shapes(iDrag).rc, x - xStart, y - yStart)
            Shapes(iDrag).rc.nLeft   = Shapes(iDrag).rc.nLeft   + x - xStart
            Shapes(iDrag).rc.nRight  = Shapes(iDrag).rc.nRight  + x - xStart
            Shapes(iDrag).rc.nTop    = Shapes(iDrag).rc.nTop    + y - yStart
            Shapes(iDrag).rc.nBottom = Shapes(iDrag).rc.nBottom + y - yStart
    
            ' remember the previous location
            xStart = x
            yStart = y
    
            ' draw the rectangle in its current location
            CALL DrawFocusRect(hdc, Shapes(iDrag).rc)
    
            CALL ReleaseDC(hwnd, hdc)
            EXIT SELECT
        END IF
    
        IF fDrawing THEN
            hdc = GetDC(hwnd)
            CALL SetROP2(hdc, %R2_NOTXORPEN)
    
            ' erasing the previous rectangle
            CALL DrawFocusRect(hdc, Shapes(iPos).rc)
    
            ' going left?
            IF xStart > x THEN
                Shapes(iPos).rc.nLeft  = x
                Shapes(iPos).rc.nRight = xStart
            ELSE    ' going right
                Shapes(iPos).rc.nLeft  = xStart
                Shapes(iPos).rc.nRight = x
            END IF
    
            ' going down?
            IF yStart < y THEN
                Shapes(iPos).rc.nBottom = y
                Shapes(iPos).rc.nTop    = yStart
            ELSE    ' going right
                Shapes(iPos).rc.nBottom = yStart
                Shapes(iPos).rc.nTop    = y
            END IF
    
            ' show the new position
            CALL DrawFocusRect(hdc, Shapes(iPos).rc)
            CALL ReleaseDC(hwnd, hdc)
        END IF
    
    CASE %WM_LBUTTONUP
        ' current X position
        x = LOWRD(lParam)
    
        ' current Y position
        y = HIWRD(lParam)
    
        IF fDrag THEN
            fDrag = %FALSE
            CALL InvalidateRect(hwnd, BYVAL %NULL, %TRUE)
            CALL UpdateWindow(hwnd)
            CALL ReleaseCapture
            EXIT SELECT
        END IF
        IF fDrawing THEN
            CALL ReleaseCapture()
    
            ' going left?
            IF xStart > x THEN
                Shapes(iPos).rc.nLeft  = x
                Shapes(iPos).rc.nRight = xStart
            ELSE    ' going right
                Shapes(iPos).rc.nLeft  = xStart
                Shapes(iPos).rc.nRight = x
            END IF
    
            ' going down?
            IF yStart < y THEN
                Shapes(iPos).rc.nBottom = y
                Shapes(iPos).rc.nTop    = yStart
            ELSE    ' going right
                Shapes(iPos).rc.nBottom = yStart
                Shapes(iPos).rc.nTop    = y
            END IF
    
            INCR iPos
            IF iPos > %MAXSHAPES THEN
               iPos = %MAXSHAPES
            END IF
    
            ' define the next shape
            Shapes(iPos).iShape = Shapes(iPos - 1).iShape
    
            ' define the next color
            Shapes(iPos).clr = Shapes(iPos - 1).clr
    
            ' display the rectangle
            CALL InvalidateRect(hwnd, BYVAL %NULL, %TRUE)
            CALL UpdateWindow(hwnd)
    
            ' enable the Clear all menuitem
            mii.cbSize = SIZEOF(mii)
            mii.fMask = %MIIM_STATE
            mii.fState = %MFS_ENABLED
            ' %MN_RESTOREICON
            CALL SetMenuItemInfo(GetMenu(hwnd), %MN_CLEARALL, %FALSE, mii)
        END IF
    
        ' the drawing is over
        fDrawing = %FALSE
    
    CASE %WM_PAINT
        hdc = BeginPaint(hwnd, ps)
    
        FOR i = 0 TO iPos - 1
            ' set the brush color
            CALL SelectObject(hdc, CreateSolidBrush(Shapes(i).clr))
    
            SELECT CASE Shapes(i).iShape
            CASE %OB_RECTANGLE
                CALL Rectangle(hdc,          _
                             Shapes(i).rc.nLeft, _
                             Shapes(i).rc.nTop,  _
                             Shapes(i).rc.nRight, _
                             Shapes(i).rc.nBottom)
            CASE %OB_ELLIPSE
                CALL ELLIPSE(hdc,             _
                             Shapes(i).rc.nLeft,  _
                             Shapes(i).rc.nTop,   _
                             Shapes(i).rc.nRight, _
                             Shapes(i).rc.nBottom)
    
            END SELECT
        NEXT
    
        CALL EndPaint(hwnd, ps)
    
    CASE ELSE
    
    END SELECT
    
    FUNCTION = DefWindowProc(hwnd, msg, wParam, lParam)
    
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION ColorsHookProc(BYVAL hwnd AS LONG, _
                            BYVAL msg AS DWORD, _
                            BYVAL wParam AS LONG, _
                            BYVAL lParam AS LONG) AS LONG
    
    LOCAL rcDlg AS RECT
    LOCAL cxDlg AS LONG
    LOCAL cyDlg AS LONG
    
    SELECT CASE msg
    CASE %WM_INITDIALOG
        ' Center ChooseColor window
        CALL GetWindowRect(hwnd, rcDlg)
        cxDlg = rcDlg.nRight - rcDlg.nLeft
        cyDlg = rcDlg.nBottom - rcDlg.nTop
    
        CALL SetWindowPos(hwnd, %HWND_TOP,        _
                    (GetSystemMetrics(%SM_CXSCREEN) \ 2) - (cxDlg \ 2), _
                    (GetSystemMetrics(%SM_CYSCREEN) \ 2) - (cyDlg \ 2), _
                    0, 0,                         _
                    %SWP_NOSIZE)
        FUNCTION = %FALSE
        EXIT FUNCTION
    CASE %WM_COMMAND
        'SELECT CASE LOWRD(wParam)   '????
        '    CALL MessageBeep(0)
        'END SELECT
    END SELECT
    
    FUNCTION = %FALSE
    
    END FUNCTION
    
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    '
    ' clear the ChooseColor menuitem
    '
    SUB ClearChooseColor(BYVAL hwnd AS LONG, mii AS MENUITEMINFO)
      mii.cbSize = SIZEOF(mii)
      mii.fMask  = %MIIM_STATE
      mii.fState = %MFS_UNCHECKED
      CALL SetMenuItemInfo(GetMenu(hwnd), %MN_CHOOSECOLOR, %FALSE, mii)
    END SUB
    
    
    
    #IF 0   < object.rc  file>
    #INCLUDE "resource.h"
    #define MAXINDEXSHAPES                  100
    #define MN_EXIT                         40001
    #define MN_RECTANGLE                    40002
    #define MN_ELLIPSE                      40003
    #define MN_ABOUT                        40004
    #define MN_RED                          40005
    #define MN_GREEN                        40006
    #define MN_BLUE                         40007
    #define MN_CHOOSECOLOR                  40008
    #define MN_CLEARALL                     40009
    #define MN_OBJECTNUM                    40010
    #define MN_AREA                         40011
    #define MN_OBJECTTYPE                   40012
    /////////////////////////////////////////////////////////////////////////////
    //
    // MENU
    //
    MAINMENU MENU DISCARDABLE
    BEGIN
        POPUP "&Objects"
        BEGIN
            MENUITEM "&Rectangular objects",        MN_RECTANGLE
            MENUITEM "&Elliptic objects",           MN_ELLIPSE
            MENUITEM SEPARATOR
            MENUITEM "&Clear all",                  MN_CLEARALL, GRAYED
            MENUITEM SEPARATOR
            MENUITEM "E&xit",                       MN_EXIT
        END
        POPUP "&Colors"
        BEGIN
            MENUITEM "&Choose color...",            MN_CHOOSECOLOR
            MENUITEM SEPARATOR
            MENUITEM "&Red",                        MN_RED
            MENUITEM "&Green",                      MN_GREEN
            MENUITEM "&Blue",                       MN_BLUE
        END
        POPUP "&Help"
        BEGIN
            MENUITEM "&About Objects...",           MN_ABOUT
        END
    END
    
    POPUP MENU DISCARDABLE
    BEGIN
        POPUP "DUMMY"
        BEGIN
            MENUITEM "Object type:",                MN_OBJECTTYPE, INACTIVE
            MENUITEM "Object #:",                   MN_OBJECTNUM, INACTIVE
        END
    END
    #ENDIF
    Best regards
    Jules
    www.rpmarchildon.com

    Comment


    • #3
      Thank you Jules.

      I'm sorry I'm not able to compile the ressource file.

      Can you show me eaxctly which lines have to be included in the ressource file ?

      Thanks.
      Jean-Pierre LEROY

      Comment


      • #4
        Cut the line
        #IF 0 < object.rc file>
        to the end of the file and save it as "object.rc" in the same directory as the rest of the program.

        Just compile and run the program once you have done that.
        Rod
        In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

        Comment


        • #5
          I'm sorry I get this message :

          Code:
          PowerBASIC for Windows
          PB/Win  Version 9.01 
          Copyright (c) 1996-2009 PowerBasic Inc.
          Venice, Florida USA
          All Rights Reserved
          
          Error 427 in E:\MESPRO~1\PROJET~1\Dessins\OBJECT~1\Objects.bas(602:011):  Integer constant expected
          Line 602: #If 0   < Object.rc  file>
          Jean-Pierre LEROY

          Comment


          • #6
            Change the name of the file to "object.rc" from "object.bas"
            Rod
            In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

            Comment

            Working...
            X