Colouring of controls

[DienyduToit]

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:

    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?

[Jim Huguley]

dieny,

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


i hope this helps..

regards..

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

[Lance Edmonds]

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>

[Jim Huguley]

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]

[DienyduToit]

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.


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

[DienyduToit]

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.

 '-------------------------------------------------------------------------------------
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
'-------------------------------------------------------------------------------------

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

[Lance Edmonds]

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>

[DienyduToit]

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?

#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

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

[Lance Edmonds]

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


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

[DienyduToit]

This seems to be a fairly satisfactory solution. Only the rectangle colours remain to be done. Is "FloodFill" is the tool for that?

#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

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

[Lance Edmonds]

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>

[Eric Pearson]

...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>