Announcement

Collapse
No announcement yet.

Colouring of controls

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

  • Colouring of controls

    The following dissappointing e-mail came yesterday in connection with my order for the Charles Petzold book:
    --------------------------------------
    Dear Dieny,

    I apologize for any inconvenience caused. After your e-mail we had a meeting with the suppliers and due to stock shortage there will be delays. If this will be a problem to you I'll give you the option to cancel, but we hope that you will bear with us a bit longer.
    --------------------------------------------------------------------
    In order to keep the planet rotating/mutating in the "delays" period,
    a further question. This code is from the sample SMTP:
    Code:
        Case %WM_CTLCOLOREDIT
          SetTextColor CbWparam, %BLUE
          Function = GetStockObject(%WHITE_BRUSH)
    
        Case %WM_CTLCOLORSTATIC
          SelectObject CbWparam, hFont
          SetBkMode CbWparam, %TRANSPARENT
          SetTextColor CbWparam, %YELLOW
          Function = GetStockObject(%NULL_BRUSH)
    How can one SELECT *which* of the EDIT controls or STATIC control are to be so coloured, and so exclude others? CbCtl is only available "when the user clicks" etc.; the CbWparam does not appear to identify the control being handled in any meaningful way (ID nor HANDLE), or does it?
    Last edited by Gary Beene; 12 Jul 2014, 08:31 PM. Reason: Code: tags

  • #2

    dieny,

    i posted some code on how to do this several months ago.


    i hope this helps..

    regards..

    ------------------
    jim..
    [email protected]
    Jim..

    Comment


    • #3
      When handling %WM_CTLCOLORxxx messages, CBLPARAM holds the handle of the control.

      Therefore it sould be possible to use the API GetDlgCtrlID(CBLPARAM) to get the ID of the control, and work out the response required.

      Jim's example code works by storing an array of handles for the comparison - which does work - but (may) add unnecessary "overhead" to your code... YMMV.


      ------------------
      Lance
      PowerBASIC Support
      mailto:[email protected][email protected]</A>
      Lance
      mailto:[email protected]

      Comment


      • #4

        Thanks Lance. Much cleaner way to handle this and easier to
        maintain using the control ID equates. I've modified the
        original code using the API GetDlgCtrlID(CBLPARAM) and will email
        it to anyone that would like a copy. Just email me a note.

        Regards..

        ------------------
        Jim..
        [email protected]
        Jim..

        Comment


        • #5
          Thanks, Jim and Lance! Had Jim's first method in place and working before this a.m. the additional info from Lance arrived. That does save a mass of code, and works like a charm.


          ------------------

          Comment


          • #6
            Lance, from your previous comments I quote the following two bits:

            1. If your PB/DLL code is already generating the graphical coordinates for the image, it should be a hop/skip/jump to creating the whole thing with PB/DLL.

            2. Getting back to the original question by Dieny, the Delphi app he wants to replace will not be a quick job, but it is definately possible with PB/DLL and DDT (with additional API work for the "custom controls" such as a tab-control, toolbar, etc).

            In response to number 2 ("will not be a quick job") - this may be true, but I guess, from a bit of experience, a darn sight quicker than using Delphi ...

            As to number 1:

            I've received valuable info already as to colouring things, text and background, but I'm not sure that I have what is needed for the "hop/skip/jump" excercise. CallBack Function GmssCalcs is the callback of a button, and calls the other functions in turn. First of all, these "draw and colour" of the diagram needs to be done on-the-fly at run-time; it is not simply set up initially and then left - it must be redrawn to reflect the effects of user input. Thus, since some of these functions are only available inside a Callback function, one would perhaps repeat the Dialog Show Modeless Callback Xyz (if that is legitimate - showing it over and over again). On the other hand, using LABELS does not seem correct nor elegant. It seems that the STYLE of the labels affect their ability to be coloured in (BkColor) - it seems it must be %BS_CENTER - and a simple non-3D outline comes up only with style %BS_GROUPBOX, but then it does not display the colours specified. Calling RECTANGLE would seem the right way, but how?

            The RECTANGLE call in my code is experimental, but does not draw anything. The very last piece of code is all REM'd, being a copy of the complete Pascal code (Delphi) which draws any diagram specified in a string called PIX. This is generated by a DLL (PB/DLL!) and just gives the colour and the four coordinates for each rectangle (x, y, xx, yy). It works very well, and I'd like to do the same in the DDT version.

            MAIN QUESTION: IS Rectangle the answer, and if so, does one have freedom to redraw and define colours ad lib?

            The Delphi exe is of the order of 5-6 Mb. The PB/DLL version is at present 104Kb: admittedly there is quite a lot to come, but I can't see it getting to be much more than 1Mb.
            Code:
             '-------------------------------------------------------------------------------------
            CallBack Function PrepGMSScalc
             Local TextColor         As Long
             Local BackColor         As Long
             Local hFont&
             Local fFont&
             Local hBackColor        As Long
             Local hBgColor          As Long
             Local hBgSSS            As Long
             Local hBgMSS            As Long
             Static hBrushNavy       As Long
             Static hBrushDialog     As Long
             Static hBrushSilver     As Long
             Static hBrushGray       As Long
             Static hBrushCyan       As Long
             Static hBrushYellow     As Long
             Static hBrushWhite      As Long
            
             Select Case CbMsg
             Case %WM_INITDIALOG
            
            'Create brushes for colours required.
              Local Lb As LOGBRUSH
            
              Lb.lbStyle  = %BLACK_BRUSH
            
              Lb.lbColor   = %Navy
              hBrushNavy   = CreateBrushIndirect(Lb)
            
              Lb.lbColor   = %White
              hBrushWhite   = CreateBrushIndirect(Lb)
            
              Lb.lbColor   = %Silver
              hBrushSilver = CreateBrushIndirect(Lb)
            
              Lb.lbColor   = %Gray
              hBrushGray   = CreateBrushIndirect(Lb)
            
              Lb.lbColor   = %Silver
              hBrushDialog = CreateBrushIndirect(Lb)
            
              Lb.lbColor   = %Cyan
              hBrushCyan   = CreateBrushIndirect(Lb)
            
              Lb.lbColor   = %Yellow
              hBrushYellow = CreateBrushIndirect(Lb)
            
            ' Set fonts required:
            
              bFont& = MakeFont("Times New Roman", 14)
              eFont& = MakeFont("Courier New", 10)
              fFont& = MakeFont("MS Sans Serif", 10)
              gFont&= MakeFont("MS Sans Serif", 9)
            
              Local lf As LOGFONT
            
            ' Set font for outline frame to bold:
            ' First set, then retrieve the now current font
              Control Send CbHndl, 1, %WM_SETFONT, fFont&, 1
              Control Send CbHndl, 1, %WM_GETFONT, 0, 0 To hFont&
              GetObject hFont&, SizeOf(lf), ByVal VarPtr(lf)
              lf.lfWeight = %FW_BOLD
              hFont = CreateFontIndirect(lf)
              Control Send CbHndl, 1, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 33, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 35, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 46, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 48, %WM_SETFONT,hFont&, 1
            
            ' "SHEETWORK" heading
              Control Send CbHndl, 2, %WM_SETFONT, bFont&, 1
              Control Send CbHndl, 2, %WM_GETFONT, 0, 0 To hFont&
              GetObject hFont&, SizeOf(lf), ByVal VarPtr(lf)
              lf.lfWeight = %FW_BOLD
              hFont& = CreateFontIndirect(lf)
              Control Send CbHndl, 2, %WM_SETFONT,hFont&, 1
            
            ' Set font for 9pt bold body text:
              Control Send CbHndl, 3, %WM_SETFONT, gFont&, 1
              Control Send CbHndl, 3, %WM_GETFONT, 0, 0 To hFont&
              GetObject hFont&, SizeOf(lf), ByVal VarPtr(lf)
              lf.lfWeight = %FW_BOLD
              hFont& = CreateFontIndirect(lf)
              Control Send CbHndl, 3, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 4, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 5, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 8, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 18, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 21, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 28, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 38, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 39, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 40, %WM_SETFONT,hFont&, 1
              Control Send CbHndl, 45, %WM_SETFONT,hFont&, 1
            
            ' Set font for 9pt medium body text:
              Control Send CbHndl, 9, %WM_SETFONT, gFont&, 1
              Control Send CbHndl, 9, %WM_GETFONT, 0, 0 To hFont&
              GetObject hFont&, SizeOf(lf), ByVal VarPtr(lf)
              lf.lfWeight = %FW_MEDIUM
              hFont& = CreateFontIndirect(lf)
              Control Send CbHndl, 9, %WM_SETFONT,hFont&, 1
            
            '%WM_CTLCOLORMSGBOX
            '%WM_CTLCOLOREDIT
            '%WM_CTLCOLORLISTBOX
            '%WM_CTLCOLORBTN
            '%WM_CTLCOLORDLG
            '%WM_CTLCOLORSCROLLBAR
            '%WM_CTLCOLORSTATIC
            
            ' %WM_CTLCOLORxxx ; GetDlgCtrlID(CbLparam)
            
             Case %WM_CTLCOLORSTATIC
              Ci&=GetDlgCtrlID(CbLparam)
              SetBkMode CbWparam, %TRANSPARENT
              hBackColor = hBrushSilver
              hBgColor   = hBrushNavy
              hBgSSS     = hBrushGray
              hBgMSS     = hBrushCyan
              Select Case Ci&
              Case 1,5,9,12
               TextColor = %Black
               BackColor = hBackColor
              Case 2, 124
               If Ci&=2 Then
                TextColor = %White
                BackColor = hBgColor
               Else
                TextColor = %White
                BackColor = hBgMSS
                End If
              Case 8,15,21,45
               TextColor = %Navy
               BackColor = hBackColor
              Case 123
               TextColor = %Gray
               BackColor = hBgSSS
            '  Case 124
            '   TextColor = %White
            '   BackColor = hBgMSS
            '   Exit Function
               End Select
              SetTextColor CbWparam, TextColor
              Function = BackColor
             Case %WM_CTLCOLOREDIT
              Ci&=GetDlgCtrlID(CbLparam)
              SetBkMode CbWparam, %TRANSPARENT
              Select Case Ci&
              Case 6, 7
               TextColor = %Black
               BackColor = hBrushCyan
               End Select
              SetTextColor CbWparam, TextColor
              Function = BackColor
             Case %WM_CTLCOLORDLG
            ' paint the background of the Dialog
              Function = hBrushDialog
              End Select
             End Function
            '-------------------------------------------------------------------------------------
            Sub MakeGmssCalcScreen
             Local lf As LOGFONT
            
             r$=ScrnName$+", section"+Str$(ActiveSection)
             rtn&=Val(QsxInfo("PrintRoutine"))
             If rtn&=1 Then
              r$=e$+" (bookwork)"
             Else
              r$=r$+" (jobbing, option "
              x$=QsxInfo("JobOpt")
              r$=r$+x$+")"
              End If
            
             Control Add Frame, hDlg&, 1, r$, 6, 1, 412, 310
            
             Control Add Label, hDlg&, 2, "WORK and TUMBLE", 10, 12, 147, 13, %SS_CENTER
            
             Control Add Frame, hDlg&, -1, "", 10, 23, 148, 159
             Control Add Label, hDlg&, 3, "Depth  Width", 103, 31, 52, 10
             Control Add Line, hDlg&, -1, "", 11, 42, 146, 1, %SS_ETCHEDFRAME
             Control Add Label, hDlg&, 5, " Finished job size", 12, 46, 86, 10, %SS_Right
             Control Add TextBox, hDlg&, 6, "Fjd", 102, 46, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 7, "Fjw", 130, 46, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Line, hDlg&, -1, "", 11, 58, 146, 1, %SS_ETCHEDFRAME
             Control Add Label, hDlg&, 8, "Add bleed:", 14, 62, 42, 10, %SS_Left
             Control Add Label, hDlg&, 9, "Top and left", 56, 62, 42, 10, %SS_Right
             Control Add TextBox, hDlg&, 10, "Blt", 102, 62, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 11, "Bll", 130, 62, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Label, hDlg&, 12, "Bottom and right", 46, 74, 52, 10, %SS_Right
             Control Add TextBox, hDlg&, 13, "Blb", 102, 74, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 14, "Blr", 130, 74, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
            
             Control Add Label, hDlg&, 4, " Gross job size", 12, 86, 86, 10, %SS_Right
             Control Add TextBox, hDlg&, 31, "Gjd", 102, 86, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 32, "Gjw", 130, 86, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
            
             Control Add Line, hDlg&, -1, "", 11, 98, 146, 1, %SS_ETCHEDFRAME
             Control Add Label, hDlg&, 15, "Forme layout", 46, 102, 52, 10, %SS_Right
             Control Add TextBox, hDlg&, 16, "Fmd", 102, 102, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 17, "Fma", 130, 102, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Line, hDlg&, -1, "", 11, 115, 146, 1, %SS_ETCHEDFRAME
             Control Add Label, hDlg&, 18, " Net machine size", 12, 120, 86, 10, %SS_Right
             Control Add TextBox, hDlg&, 19, "Nmd", 102, 120, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 20, "Nmw", 130, 120, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Line, hDlg&, -1, "", 11, 133, 146, 1, %SS_ETCHEDFRAME
             Control Add Label, hDlg&, 21, "Add trim:", 14, 138, 42, 10, %SS_Left
             Control Add Label, hDlg&, 22, "Top and left", 56, 138, 42, 10, %SS_Right
             Control Add TextBox, hDlg&, 23, "Trt", 102, 138, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 24, "Trl", 130, 138, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Label, hDlg&, 25, "Grip and right", 46, 150, 52, 10, %SS_Right
             Control Add TextBox, hDlg&, 26, "Grp", 102, 150, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 27, "Trr", 130, 150, 24, 10, %SS_Right, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Line, hDlg&, -1, "", 11, 162, 146, 1, %SS_ETCHEDFRAME
             Control Add Label, hDlg&, 28, "Gross machine size", 12, 167, 86, 10, %SS_Right
             Control Add TextBox, hDlg&, 29, "Gmd", 102, 167, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add TextBox, hDlg&, 30, "Gmw", 130, 167, 24, 10, %SS_Right Or %ES_READONLY, _
                                                                        %WS_EX_CLIENTEDGE
             Control Add Frame, hDlg&, 33, "Quantities", 10, 182, 148, 30
             Control Add ComboBox, hDlg&, 34,, 15, 194, 138, 20, _
                                     %CBS_DROPDOWNLIST Or %CBS_DISABLENOSCROLL, _
                                     %WS_EX_RIGHT            '[CALL callbackfunction]
             Control Add Frame, hDlg&, 35, "Printing machines", 10, 213, 148, 68
             Control Add ComboBox, hDlg&, 36,, 15, 225, 138, 20, _
                                     %CBS_DROPDOWNLIST Or %CBS_DISABLENOSCROLL, _
                                     %WS_EX_RIGHT            '[CALL callbackfunction]
             Control Add Label, hDlg&, 37, "Machine speed 4644 impressions/hour", _
                                                                          14, 241, 140, 10, %SS_Center
             Control Add Label, hDlg&, 38, "Depth  Width", 50, 251, 60, 10, %SS_Center', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 39, "Maximum", 13, 260, 38, 10, %SS_Right', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 40, "Minimum", 13, 270, 38, 10, %SS_Right', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 41, "MaxDp", 53, 260, 24, 10, %SS_Center', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 42, "MinDp", 53, 270, 24, 10, %SS_Center', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 43, "MaxWd", 81, 260, 24, 10, %SS_Center', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 44, "MinWd", 81, 270, 24, 10, %SS_Center', %WS_EX_STATICEDGE
             Control Add Label, hDlg&, 45, "LscPrt", 107, 260, 48, 10, %SS_Center', %WS_EX_STATICEDGE
             Control Add Frame, hDlg&, 46, "Estimator", 10, 282, 148, 25
             Control Add Label, hDlg&, 47, "(Estimator name)", 14, 293, 140, 10, %SS_Center
             Control Add Frame, hDlg&, 48, "Cutting diagram", 234, 16, 180, 130, %BS_BOTTOM
            'Control Add Label, hDlg&, 123, "", 254, 33, 140, 100, %BS_GROUPBOX
            'Control Add Label, hDlg&, 124, "", 256, 35, 30, 20, %SS_CENTER
             End Sub
            '-------------------------------------------------------------------------------------
            CallBack Function GmssCalcs ()
             Local style As Long
             Style = %WS_POPUP Or _
                     %DS_SETFONT Or _
                     %DS_NOFAILCREATE Or _
                     %DS_MODALFRAME Or _
                     %DS_3DLOOK
             Dialog New pDlg, "", 0, 63, 530, 315, Style To BgDlg&
             Dialog Show Modeless BgDlg&
            
             Dialog End hDlg&
            
             Style = %WS_POPUP Or _
                     %DS_SETFONT Or _
                     %DS_NOFAILCREATE Or _
                     %DS_MODALFRAME Or _
                     %DS_3DLOOK   Or _
                     %DS_SETFOREGROUND
             Dialog New pDlg, "", 0, 63, 530, 315, Style, %WS_EX_TOPMOST To hDlg&
            
             ScrnName$="Gross machine size calculation"
             MakeGmssCalcScreen
             Pts&=Val(QsxInfo("Parts"))
             MakeRedMenu
             Control Add Label, hDlg&, 123, "640 x 890", 254, 33, 140, 100, %BS_GROUPBOX
             Control Add Label, hDlg&, 124, "1", 256, 35, 60, 30, %SS_CENTER
             Dialog Show Modeless hDlg& Call PrepGMSScalc
            ' DrawDiagram
            p&=rectangle(hDlg&,254,140,250,145)
             Dialog End BgDlg&, 1
             End Function
            '-------------------------------------------------------------------------------------
            Sub DrawDiagram
            ' A := copy(Pix, 1, 8);
            ' PaperCuts.left := ValueOf(copy(A,1,4));
            ' PaperCuts.top := ValueOf(copy(A,5,4));
            ' With PaperCuts.Canvas Do
            '  begin
            '   PaperCuts.Canvas.Brush.Style := bsSolid;
            '   A := copy(Pix, 9, length(Pix) - 8);
            '   While length(A) > 1 Do
            '    begin
            'More:
            '    A := trim(A) + ' ';
            '    B := copy(A,1,pos(' ', A));
            '    A := copy(A,length(B) + 1, length(A) - length(B));
            '    B := trim(B);
            '    If B = 'GRAY' then
            '     begin
            '      PaperCuts.Canvas.Brush.Color := clGray;
            '      GoTo More;
            '     End;
            '    If B = 'WHITE' then
            '     begin
            '      PaperCuts.Canvas.Brush.Color := clWhite;
            '      GoTo More;
            '     End;
            '    If B = 'YELLOW' then
            '     begin
            '      PaperCuts.Canvas.Brush.Color := clYellow;
            '      GoTo More;
            '     End;
            '    E := ValueOf(B);
            '    A := trim(A) + ' ';
            '    B := copy(A,1,pos(' ', A));
            '    A := copy(A,length(B) + 1, length(A) - length(B));
            '    B := trim(B);
            '    F := ValueOf(B);
            '    A := trim(A) + ' ';
            '    B := copy(A,1,pos(' ', A));
            '    A := copy(A,length(B) + 1, length(A) - length(B));
            '    B := trim(B);
            '    G := ValueOf(B);
            '    A := trim(A) + ' ';
            '    B := copy(A,1,pos(' ', A));
            '    A := copy(A,length(B) + 1, length(A) - length(B));
            '    B := trim(B);
            '    H := ValueOf(B);
            '    PaperCuts.Canvas.Rectangle(E, F, G, H);
            '    If length(trim(A)) > 0 Then GoTo More;
            '    End;
            ' End;
             End Sub
            '-------------------------------------------------------------------------------------
            ------------------
            Last edited by Gary Beene; 12 Jul 2014, 08:31 PM.

            Comment


            • #7
              Personally, I use a DDT LABEL control with the %SS_GRAYFRAME style. The DDT dialog itself should have the %WS_CLIPCHILDREN style.

              (By using a 'frame' to draw your image ensures that Windows does not overwrite your image with the background brush used by say, a rectangle control).

              Then, in the callback for the dialog, handle %WM_PAINT events, get the DC to the LABEL control (GetDC), and then draw your image using normal API drawing functions (LINETO, MOVETOEX, etc), and finally release the DC before leaving the %WM_PAINT event.

              When the image needs to be updated (say, in response to a control click elsewhere on the dialog), simply invalidate the dialog client area using InvalidateRect() followed by UpdateWindow(). This triggers a %WM_PAINT event, and the control is redrawn by the code described above.

              Clear as mud?


              ------------------
              Lance
              PowerBASIC Support
              mailto:[email protected][email protected]</A>
              Lance
              mailto:[email protected]

              Comment


              • #8
                Thanks, Lance, that was a giant step - but I stepped into a hole, it seems.
                If this code can be got into a working model, I will write a book to put Mr. Petzold out of business. The code already does ALMOST the thing - only the position of the resultant rectangle and LINETO are at the top left of the screen (0,0 presumably). My precalculated coordinated will replace the x& and
                y& in a loop, once the position of the GRAYRECT (and/or the GRAYFRAME) can be
                established. Can you help this one more time?
                Code:
                #Compile Exe
                
                #Include "WIN32API.INC"
                #Include "COMMCTRL.INC"
                #Include "COMDLG32.INC"
                
                Global hDlg&, IDx&
                
                CallBack Function MakaPic
                 Local Papi As POINTAPI
                 Papi.x = 0
                 Papi.y = 0
                 Select Case CbMsg
                 Case %WM_PAINT
                  Ci&=GetDlgCtrlID(CbLparam)
                  IDx&=GetDC (Ci&)
                  Control Get Loc IDx&, 2 To x&, y&
                  y&=Rectangle (IDx&, x&+4, y&+4, x&+60, y&+40)
                  r&=LineTo (IDx&, 15, 15)
                  s&=MoveToEx (IDx&, 20, 20, Papi)
                  n&=ReleaseDC (hDlg&, IDx&)
                  End Select
                 End Function
                
                Function WinMain (ByVal hInstance     As Long, _
                                  ByVal hPrevInstance As Long, _
                                  lpCmdLine           As Asciiz Ptr, _
                                  ByVal iCmdShow      As Long) As Long
                 Style& = %WS_SYSMENU Or _
                         %WS_MINIMIZEBOX
                 Dialog New 0, "Diagrams", 0, 0, 534, 370, style&, %WS_CLIPCHILDREN To hDlg&
                 Control Add Label, hDlg&, 1, "", 50, 70, 270, 200, %SS_GRAYFRAME
                 Control Add Label, hDlg&, 2, "", 54, 74, 262, 192, %SS_GRAYRECT
                 Dialog Show Modal hDlg& Call MakaPic
                MsgBox(Str$(IDx&))
                 End Function
                ------------------
                Last edited by Gary Beene; 12 Jul 2014, 08:32 PM.

                Comment


                • #9
                  Use GetDlgItem() to get the handle, instead of GetDlgCtrlID().


                  ------------------
                  Lance
                  PowerBASIC Support
                  mailto:[email protected][email protected]</A>
                  Lance
                  mailto:[email protected]

                  Comment


                  • #10
                    This seems to be a fairly satisfactory solution. Only the rectangle colours remain to be done. Is "FloodFill" is the tool for that?
                    Code:
                    #Compile Exe
                    
                    #Include "WIN32API.INC"
                    #Include "COMMCTRL.INC"
                    #Include "COMDLG32.INC"
                    
                    Global pDlg&, hDlg&, Ci&, IDx&, Wdth&, Dpth&
                    
                    CallBack Function MakaPic
                     Select Case CbMsg
                     Case %WM_PAINT
                      Ci&=GetDlgItem(hDlg&, 2)
                      IDx&=GetDC (Ci&)
                      Control Get Loc IDx&, 2 To x&, y&
                      w&=Rectangle (IDx&, x&, y&, x&+Wdth&, y&+Dpth&)
                      w&=Rectangle (IDx&, x&+Wdth&, y&, x&+Wdth&*2, y&+Dpth&)
                      n&=ReleaseDC (hDlg&, IDx&)
                      Exit Function
                      End Select
                     End Function
                     
                    CallBack Function FlipPic
                     Swap Wdth&, Dpth&
                     Call PopHdlg
                     End Function
                    
                    Sub PopHdlg
                     Control Kill hDlg&, 2                          '(kill and remake the label)
                     Control Add Label, hDlg&, 2, "", 16, 16, 230, 150, %SS_GRAYFRAME
                     End Sub
                    
                    Function WinMain (ByVal hInstance     As Long, _
                                      ByVal hPrevInstance As Long, _
                                      lpCmdLine           As Asciiz Ptr, _
                                      ByVal iCmdShow      As Long) As Long
                     Wdth&=120
                     Dpth&=80
                     Style& = %WS_SYSMENU Or _
                              %WS_MINIMIZEBOX
                     Dialog New 0, "Diagrams", 0, 0, 534, 370, style& To pDlg&
                     Style& = %WS_POPUP Or _
                              %DS_SETFONT Or _
                              %DS_NOFAILCREATE Or _
                              %DS_MODALFRAME Or _
                              %DS_3DLOOK
                     Dialog New pDlg&, "", 120, 50, 277, 236, Style& To hDlg&
                     Control Add Frame, hDlg&, 1, "Paper cutting diagram", 4, 4, 270, 200
                     Control Add Label, hDlg&, 2, "", 16, 16, 230, 150, %SS_GRAYFRAME
                     Control Add Button, hDlg&, 3, "Redo", 4, 210, 50, 20, %BS_DEFAULT Call FlipPic
                     Dialog Show Modeless hDlg& Call MakaPic
                     Dialog Show Modal pDlg&
                     Dialog Enable hDlg&
                     End Function
                    ------------------
                    Last edited by Gary Beene; 12 Jul 2014, 08:33 PM. Reason: Code: tags

                    Comment


                    • #11
                      The RECTANGLE() API fills the rectangle with the brush that is currently selected into the Device Context.

                      There is also the PATBLT() API to fill a rectangular area.



                      ------------------
                      Lance
                      PowerBASIC Support
                      mailto:[email protected][email protected]</A>
                      Lance
                      mailto:[email protected]

                      Comment


                      • #12
                        ...and the FillRect API fills a rectangle with the current Brush without using the current Pen.

                        -- Eric


                        ------------------
                        Perfect Sync: Perfect Sync Development Tools
                        Email: mailto:[email protected][email protected]</A>

                        "Not my circus, not my monkeys."

                        Comment

                        Working...
                        X