Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Palette in DDT (Petzold, V ed. - GRAY2.C)

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

  • Palette in DDT (Petzold, V ed. - GRAY2.C)

    Two days ago I began experiments with palettes.
    To have a layout, I "translated" a sample (GRAY2.C) from Petzold, fifth ed.
    Hope, it will be useful to somebody else.

    PS. Palettes are important to avoid problems with colors in 256-colors' regime.

    Code:
       
       #Compile Exe
       #Register None
       #Dim All
       #Include "win32api.inc"
       %nParts = 50
    
       CallBack Function DlgProc
          Static hBrush As Long, i As Long, j As Long, MyClr() As Long
          Static ps As PAINTSTRUCT, tRect As Rect, zText As Asciiz * 80, hFont As Long
          Select Case CbMsg
             Case %WM_INITDIALOG
                ReDim MyClr(0 To %nParts + 1)
                MyClr(0) = MakLng(&H0300, UBound(MyClr))
                For i = 1 To %nParts
                   MyClr(i) = Rgb(0, 0, 255 - 255 * i / (%nParts - 1))
                Next
                MyClr(%nParts + 1) = Rgb(255, 192, 64)
                MyClr(0) = CreatePalette (ByVal VarPtr(MyClr(0)))
                For i = 1 To UBound(MyClr): MyClr(i) = MyClr(i) + &H02000000: Next
             Case %WM_SIZE
                InvalidateRect CbHndl, ByVal %Null, %TRUE: UpdateWindow CbHndl
             Case %WM_ERASEBKGND: Function = 1: Exit Function
             Case %WM_PAINT
                BeginPaint CbHndl, ps
                SelectPalette ps.hdc, MyClr(0), %FALSE
                RealizePalette ps.hdc
                GetClientRect CbHndl, tRect
                j = tRect.nBottom: tRect.nBottom = 0
                For i = 1 To %nParts
                   tRect.nTop = tRect.nBottom
                   tRect.nBottom = i * j / %nParts
                   hBrush = CreateSolidBrush (MyClr(i))
                   FillRect ps.hDc, tRect, hBrush
                   DeleteObject hBrush
                Next
                SetBkMode ps.hDc, %TRANSPARENT
                SetTextColor ps.hDc, MyClr(%nParts + 1)
                GetClientRect CbHndl, tRect
                hFont = CreateFont(tRect.nBottom / 3, tRect.nRight / 8, 80,0, _
                      1000, %True, %False, %False, %RUSSIAN_CHARSET, %OUT_CHARACTER_PRECIS, _
                      %CLIP_DEFAULT_PRECIS, %PROOF_QUALITY, %FIXED_PITCH, "Arial")
                SelectObject ps.hDC, hFont
                zText = "Hello"
                DrawText ps.hDc, zText, -1, tRect, %DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER
                EndPaint CbHndl, ps
                DeleteObject hFont
                Function = 0: Exit Function
             Case %WM_QUERYNEWPALETTE
                BeginPaint CbHndl, ps
                SelectPalette ps.hdc, MyClr(0), %FALSE
                RealizePalette ps.hdc
                InvalidateRect CbHndl, ByVal %Null, %TRUE
                EndPaint CbHndl, ps
                Function = %True
             Case %WM_PALETTECHANGED
                If CbWparam = CbHndl Then Exit Function
                BeginPaint CbHndl, ps
                SelectPalette ps.hdc, MyClr(0), %FALSE
                RealizePalette ps.hdc
                UpdateColors ps.hdc
                EndPaint CbHndl, ps
                Exit Function
             Case %WM_DESTROY
                DeleteObject MyClr(0)
          End Select
       End Function
    
       Function PbMain
          Local hDlg As Long
          Dialog New 0, "",,, 600, 400, %WS_SYSMENU Or %WS_MAXIMIZEBOX Or _
             %WS_THICKFRAME Or %WS_BORDER Or %WS_MINIMIZEBOX To hDlg
          Dialog Show Modal hDlg Call DlgProc
       End Function
    [This message has been edited by Semen Matusovski (edited April 17, 2000).]
Working...
X