Custom Controls in OxygenBasic

[Arnold]

Hi Charles,

I found a very instructive example of a custom control which I would like to use for some kind of template:

How do you make a custom control?
https://www.freebasic.net/forum/viewtopic.php?t=12423

I ported the Firelines example to Oxygenbasic using O2 syntax and it will work in 32/64 bit. I have not fully tested the options and if they will work, but so far it looks good.

There is one question though. In line 128 and following I used:

...
    'Local ed As FIRELINES_DATA Ptr

    if wMsg <> WM_CREATE then
      sys ped = GetWindowLongPtr(hWnd, 0)
       'FIRELINES_DATA ed
       '@ed=@ped
       FIRELINES_DATA ed at ped
    end if               
                 
    select case wMsg
         
         case WM_CREATE
            'ped = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, SizeOf(FIRELINES_DATA))
            ped=Getmemory sizeof(FIRELINES_DATA)
           
            if ped then                                             
               SetWindowLongPtr(hWnd, 0, ped)      'Store the pointer for later use
            else                                             
               function = 0: exit function   
            end if                                                       
       
            'FIRELINES_DATA ed
            '&ed=@ped
            FIRELINES_DATA ed at ped
...

I had to use: FIRELINES_DATA ed at ped. Is this not the same as the two lines which I commented out? I get different results.

Roland

Edit: Modified the code with the corrections of Charles

Code: OxygenBasic

1. $ filename "Firelines.exe"
2.  
3. 'uses rtl32
4. 'uses rtl64
5.  
6. uses winutil
7.  
8.  
9. % PS_DASH=1
10. % PS_DOT=2
11. % PS_INSIDEFRAME=6
12. % HEAP_ZERO_MEMORY=8
13. % COLOR_3DFACE=15
14.  
15.  
16. % FIRELINES_SETLINE       = %WM_USER + 2048      '3072
17. % FIRELINES_SETVERTICAL   = %WM_USER + 2049      '3073
18. % FIRELINES_SETLINECOLOR  = %WM_USER + 2050      '3074
19. % FIRELINES_SETLINEWIDTH  = %WM_USER + 2051      '3075
20. % FIRELINES_SETLINESTYLE  = %WM_USER + 2052      '3076
21. % FIRELINES_SETROUNDNESS  = %WM_USER + 2053      '3077
22. % FIRELINES_SETSOLIDBACK  = %WM_USER + 2054      '3078
23. % FIRELINES_SETCTLCOLOR   = %WM_USER + 2056      '3079
24.  
25.  
26. Type FIRELINES_DATA  
27.    dword IsLine         'true=Line, FALSE=Box
28.   dword IsVertical     'true=Vertical, FALSE=Horizontal (lines only)
29.   dword LineColor      
30.    dword LineWidth    
31.    dword LineStyle      'solid, dash, dot
32.   sys   Roundness      'degree of the roundness of the box
33.   sys   UseSolidBack   'T/F: flag (solid or transparent fill - boxes only)
34.   dword CtlBackColor   'background color of the control
35.   dword hCtlBrush      'brush used to color the background of the entire control.
36. end Type
37.  
38. declare function FireLines( sys hWndParent, CtrlId, int vLeft,vTop,vWidth,vHeight) as sys
39.  
40.  
41. MainWindow 640,480,WS_OVERLAPPEDWINDOW
42.  
43. '----------------------------------------------------
44. function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
45.  
46.     select uMsg
47.         case WM_CREATE
48.             SetWindowText(hwnd, "Firelines Example")
49.             sys f1 = FireLines(hwnd, 1000, 10,10,100,100)            
50.             SendMessage(f1, FIRELINES_SETLINE, 0, 0)
51.             SendMessage(f1, FIRELINES_SETLINEWIDTH, 10,0)
52.             SendMessage(f1, FIRELINES_SETLINECOLOR, RED, 0)
53.             SendMessage(f1, FIRELINES_SETROUNDNESS, 360, 0)
54.            
55.             sys f2 = FireLines(hwnd, 1001, 200,200,150,150)
56.             SendMessage(f2, FIRELINES_SETLINECOLOR, BLUE, 0)
57.             SendMessage(f2, FIRELINES_SETCTLCOLOR, YELLOW, 0)
58.             SendMessage(f2, FIRELINES_SETLINE, 0, 0)
59.             SendMessage(f2, FIRELINES_SETLINEWIDTH, 10,0)
60.            
61.             sys f3 = Firelines(hwnd, 1002, 200, 50, 200, 100)
62.             SendMessage(f3, FIRELINES_SETLINE, 0, 0)
63.             SendMessage(f3, FIRELINES_SETLINECOLOR, MAGENTA, 0)
64.             SendMessage(f3, FIRELINES_SETROUNDNESS, 50, 0)
65.             SendMessage(f3, FIRELINES_SETLINEWIDTH, 50,0)
66.            
67.             sys f4 = Firelines(hwnd, 1003, 480, 100, 10, 200)
68.             SendMessage(f4, FIRELINES_SETVERTICAL, true, 0)
69.             SendMessage(f4, FIRELINES_SETLINEWIDTH, 20,0)
70.            
71.             sys f5 = Firelines(hwnd, 1004, 450, 160, 70, 10)                              
72.             SendMessage(f5, FIRELINES_SETLINEWIDTH, 20,0)
73.  
74.         case WM_CLOSE
75.             DestroyWindow(hwnd)
76.        
77.         case WM_DESTROY
78.             PostQuitMessage(0)
79.        
80.         case else
81.             return DefWindowProc(hwnd, uMsg, wParam, lParam)          
82.     end select
83.  
84. end function
85.  
86. '------------------------------------------------------------------
87.  
88. function FireLines( sys hWndParent, CtrlId, int vLeft,vTop,vWidth,vHeight) as sys              
89.  
90.     WNDCLASSEX wc
91.     string szClassName
92.  
93.     szClassName         = "FIRELINES"
94.    
95.     'if not already registered
96.    If GetClassInfoEx(GetModuleHandle(null, szClassName, &wc)) = 0 then  
97.        wc.cbSize        = sizeof(wc)
98.        wc.Style         = CS_HREDRAW Or CS_VREDRAW
99.        wc.lpfnWndProc   = @FireLinesProc
100.        wc.cbClsExtra    = 0
101.        wc.cbWndExtra    = sizeof(sys) '4/8   extra space after wc structure
102.       wc.hInstance     = GetWindowLongPtr(hWndParent, GWL_HINSTANCE)
103.        wc.hIcon         = null
104.        wc.hCursor       = null
105.        wc.hbrBackground = null
106.        wc.lpszMenuName  = null
107.        wc.lpszClassName = strptr szClassName
108.        wc.hIconSm       = null  
109.  
110.        If RegisterClassEx(&wc) = 0 then
111.           mbox "Cannot RegisterClassEx Firelines"
112.           exit function
113.        end If  
114.     end If
115.  
116.     sys hWnd = CreateWindowEx( WS_EX_TRANSPARENT, szClassName, "",
117.                                WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN,
118.                                vLeft, vTop, vWidth, vHeight,
119.                                hwndParent, CtrlId,
120.                                GetWindowLongPtr(hWndParent, GWL_HINSTANCE),
121.                                null)
122.  
123.      if hWnd=0 then mbox "Cannot createWindowEx Firelines"    
124.      return hWnd
125. end function
126.  
127.  
128.  
129. '------------------------------------------------------------------------------
130. function FireLinesProc( sys hWnd, uint wMsg, sys wParam, lParam) as sys callback
131.  
132.     sys hDC
133.     RECT tRect
134.     PaintStruct LpPaint
135.     sys hPen
136.     sys hBrush              
137.     dword LineStyle
138.                      
139.     'Local ed As FIRELINES_DATA Ptr
140.    FIRELINES_DATA *ed
141.  
142.     if wMsg <> WM_CREATE then
143.       @ed = GetWindowLongPtr(hWnd, 0)
144.     end if                
145.                  
146.     select case wMsg
147.          
148.          case WM_CREATE
149.             sys ped=Getmemory sizeof(FIRELINES_DATA)
150.            
151.             if ped then                                            
152.                SetWindowLongPtr(hWnd, 0, ped)      'Store the pointer for later use
153.            else                                              
154.                function = 0: exit function    
155.             end if                                                        
156.        
157.             @ed=ped
158.            
159.             ed.IsLine       = true
160.             ed.IsVertical   = false
161.             ed.LineWidth    = 1
162.             ed.LineStyle    = 0
163.             ed.LineColor    = Black
164.             ed.Roundness    = 0       'degree of round corner. 0 = square corner
165.            ed.UseSolidBack = 1
166.             ed.CtlBackColor = GetSysColor(COLOR_3DFACE)
167.             ed.hCtlBrush    = CreateSolidBrush( ed.CtlBackColor )            
168.  
169.          case WM_PAINT
170.             hDC = BeginPaint(hWnd, &LpPaint)
171.             SaveDC hDC
172.            
173.             GetClientRect hWnd, &tRect
174.            
175.             'create a pen that will draw the lines. Use the correct line style.
176.            Select case ed.LineStyle
177.               case 0:  LineStyle = PS_INSIDEFRAME
178.               case 1:  LineStyle = PS_DASH
179.               case 2:  LineStyle = PS_DOT
180.             end Select
181.            
182.             hPen = CreatePen (LineStyle, ed.LineWidth, ed.LineColor)
183.             SelectObject hDC, hPen
184.            
185.             'create a brush that will paint the inside of the box
186.            if ed.UseSolidBack = 0 then  ' hollow brush
187.               hBrush = GetStockObject(HOLLOW_BRUSH)
188.             else
189.                hBrush = CreateSolidBrush ( ed.CtlBackColor )
190.             end if
191.            
192.             SelectObject hDC, hBrush
193.             FillRect hDC, &tRect, hBrush
194.            
195.             if ed.IsLine then
196.                'we want to create a line
197.               MoveToEx hDC, tRect.left, tRect.top, null
198.                if ed.IsVertical then
199.                  'vertical
200.                 LineTo hDC, tRect.left, tRect.bottom
201.                else
202.                  'horizontal
203.                 LineTo hDC, tRect.right, tRect.top
204.                end if
205.                
206.             else
207.                'we want to create a box
208.               RoundRect hDC,
209.                          tRect.left, tRect.top, tRect.right, tRect.bottom,
210.                          ed.Roundness,
211.                          ed.Roundness
212.             end if
213.            
214.             RestoreDC hDC, -1        
215.            
216.             if hPen   then DeleteObject hPen
217.             if hBrush then DeleteObject hBrush
218.            
219.             EndPaint hWnd, &LpPaint
220.             function = 0
221.             exit function
222.  
223.          
224.          case WM_ERASEBKGND
225.             function = 1
226.             exit function
227.            
228.            
229.          case FIRELINES_SETLINE
230.             '0:Box, -1:Line
231.            ed.IsLine = wParam
232.             InvalidateRect hWnd, null, true
233.             UpdateWindow hWnd
234.            
235.          case FIRELINES_SETVERTICAL
236.             '0:False, -1:True
237.            ed.IsVertical = wParam
238.             InvalidateRect hWnd, null, true
239.             UpdateWindow hWnd
240.          
241.          case FIRELINES_SETLINECOLOR  
242.             ed.LineColor = wParam
243.             InvalidateRect hWnd, null, true
244.             UpdateWindow hWnd
245.            
246.          case FIRELINES_SETLINEWIDTH  
247.             ed.LineWidth = wParam
248.             InvalidateRect hWnd, null, true
249.             UpdateWindow hWnd
250.          
251.          case FIRELINES_SETLINESTYLE  
252.             ed.LineStyle = wParam
253.             InvalidateRect hWnd, null, true
254.             UpdateWindow hWnd
255.  
256.          case FIRELINES_SETROUNDNESS
257.             ed.Roundness = wParam
258.             if ed.Roundness < 0 then ed.Roundness = 0
259.             InvalidateRect hWnd, null, true
260.             UpdateWindow hWnd
261.  
262.          case FIRELINES_SETSOLIDBACK  
263.             ' 0:No brush, -1:Solid
264.            ed.UseSolidBack = wParam
265.             InvalidateRect hWnd, null, true
266.             UpdateWindow hWnd
267.  
268.          case FIRELINES_SETCTLCOLOR
269.             ed.CtlBackColor = wParam
270.             InvalidateRect hWnd, null, true
271.             UpdateWindow hWnd
272.  
273.          
274.          'forward the following messages back to the parent.
275.         case WM_MOUSEMOVE, WM_LBUTTONDOWN,  WM_LBUTTONUP, WM_LBUTTONDBLCLK
276.             PostMessage GetParent(hWnd), wMsg, wParam, lParam
277.             exit function
278.            
279.            
280.          case WM_DESTROY
281.             if @ed then                      
282.                if ed.hCtlBrush then DeleteObject ed.hCtlBrush
283.                freememory @ed
284.             end if
285.  
286.      end select
287.      function = DefWindowProc(hWnd, wMsg, wParam, lParam)
288. end function
289.  
290. '-----------------------------------------------------------------
291.  

[Aurel]

I tried to compile this example with 043 and get error on

wc.cbWndExtra    = sizeof(sys) '4/8   extra space after wc structure - what is this ?
or what is purpose if that extra space ?
       wc.hInstance     = GetWindowLongPtr(hWndParent, GWL_HINSTANCE)  <--- o2 complain that error is here?

by the way Arnold...
why you use console include in this program ?
Also i don't see about what custom control is this program...

[Arnold]

Hi Aurel,

I do not use A43 any more and I will not test this example with A43.

Quote from Win32 Help file (WNDCLASSEX):

cbClsExtra:
Specifies the number of extra bytes to allocate following the window-class structure. The operating system initializes the bytes to zero.

(This member is used to store / fetch a pointer of the data structure used in the custom callback procedure.)

hInstance:
Identifies the instance that the window procedure of this class is within.

GetWindowLong(Ptr):
The GetWindowLong function retrieves information about the specified window. The function also retrieves the 32-bit / (64-bit) value at the specified offset into the extra window memory of a window.

GWL_HINSTANCE: Retrieves the handle of the application instance.

If you do not read the Win32 Help file or other documentation then you are lost.

Roland
 

[Charles Pegge]

Hi Roland,

Since the location of ed is unknown beforehand, I would set ed like this. (not using at)

Code: [Select]

    Local ed As FIRELINES_DATA Ptr

    if wMsg <> WM_CREATE then
      @ed = GetWindowLongPtr(hWnd, 0)
    end if               
                 
    select case wMsg
         
         case WM_CREATE
            sys ped=Getmemory sizeof(FIRELINES_DATA)
            SetWindowLongPtr(hWnd, 0, ped)      'Store the pointer for later use       
...
         case WM_DESTROY
            if @ed
               if ed.hCtlBrush then DeleteObject ed.hCtlBrush
               freememory @ed
            end if

there are 2 forms of at

mytype v at p 'direct coupling to pointer p
if p changes then so does @v

mytype v at (p) 'the address is the value of the expression (p)
@v is independent of p thereafter

[Aurel]

Hi Arnold

Hi Aurel,
I do not use A43 any more and I will not test this example with A43.


what?
then which version u use?
and is this new version stable enough?

i am lost without win32help maybe ...yes
but o2 complain about this error in A043...

It looks that you ,me  or anyone else must add into any example which version we use ?
On this way just confuse ...i use this version  u use another ..someone else another.
And i simply don't want exeperiment all the time what work in which version..this is a nightmare for me.

[Arnold]

Thank you Charles, for the adaptions. They will help me with two other small examples. I modified the code of my first message, which can now be better compared to the original by Paul Squires.

[Aurel]

Is that hard to answer?
ok
forget i don't have in plan to bother anyone here anymore...

[Arnold]

Hi Aurel,

it seems I missed your question? I always use the latest version of OxygenbasicBasicProgress which you will get if you click on the Wizard at the top right corner. I assume you know that.

The version is: OxygenBasic Version: B0 2018-07-21 T 15:33:59. This is stated at the beginning of oxygen.bas. In a program this can also be seen by using the statement: print version.

I am not sure if in the latest version of A42/A43 corewin.inc is already provided. There are a few more points which will work a bit differently compared to the B0 version and it makes no sense to me to focus on both versions.

Roland

[Arnold]

Hello,

this is an impressive example of a custom control - 3D Progressbar - which I found on this site:

Börje Hagsten's Files:
http://www.reonis.com/POFFS/

For me, this was a very educational project, and by porting the code to Oxygenbasic I gained a lot of new knowledge about the WinApi. Due to the limited space for messages I splitted the code of the project a bit.

This is part 1 of Pgbar3d.inc:

Code: [Select]

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Progressbar include file, PGBAR3D.inc, version 2, version 2, for PB/DLL
' Ported to Oxygenbasic
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Public Domain, by Borje Hagsten, September 2001
' (first released in March 2001 - this is version 2)
' Feel free to use and enhance, but as always - use at own risk..
'
' LOG:
' Jan 14, 2003: Changed to DWORD for handles in some places and
'               now use GetWindowLongPtr(hParent, GWL_HINSTANCE)
'               to get proper instance handle at creation.
'
' NEW IN VERSION 2
' Now control looks good in 256 color mode too, thanks to own palette.
' New message, PGB_SETBARCOL replaces previous PGB_SETBARCOLMID and
' PGB_SETBARCOLEDGE. Makes it easier to set bar colors via color table,
' see messages below. New way to create control. No need to initialize
' control, just use CreatePGBar3D message directly. See sample on how
' to use it. Otherwise, trimmed code and improved some DC handling.
'
' COMMENTS:
' PGBAR3D is pretty advanced. Can also be used as label, with possibility to
' set separate text on bar/background for nice "fade in/out" effects.
' Should be quite easy
' to make changes according to the news in this version though.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤


uses corewin

'Oxygen
% DT_SINGLELINE = &H20
% DT_LEFT       = &H0
% DT_CENTER     = &H1
% DT_VCENTER    = &H4
% DT_NOCLIP     = &H100
% DT_NOPREFIX   = &H800
% NUMCOLORS     = 24          ' Number of colors the device supports
% RASTERCAPS    = 38          ' Bitblt capabilities
% RC_PALETTE    = &H00000100  ' supports a palette
% PS_SOLID      = 0
% SRCCOPY       = 0x00CC0020
% WM_GETFONT    = 49

type SIZE
   long cx
   long cy
end type

macro MakeLong(lo,hi) { ( (lo) or ( (hi)<<16 ) ) }

function RGB(int r, g, b) as int
    return (r + g*256 + b*65536)
end Function

function min(int a,b)
   if a<b then return a
   return b
end function

function max(int a,b)
   if a>b then return a
   return b
end function
'----------------------------------------------------------------------

'PGBAR3D
' wParam colors for %PGB_SETBARCOL message
%PGB_SILVER = 0
%PGB_RED    = 1
%PGB_GREEN  = 2
%PGB_BLUE   = 3
%PGB_CYAN   = 4 'blue-green
%PGB_VIOLET = 5 'red-blue
%PGB_GOLD   = 6 'yellow
%PGB_BRONZE = 7 'brown

'custom control messages
%PGB_SETMAX         = %WM_USER + 100 'wParam sets max number of steps
%PGB_STEPUP         = %WM_USER + 103 'increases step while < max - wParam and lParam shall be 0
%PGB_STEPDN         = %WM_USER + 104 'decreases step while > 0   - wParam and lParam shall be 0
%PGB_SETVALUE       = %WM_USER + 105 'wParam sets progessbar value, lParam controls redraw
%PGB_BUILDBARS      = %WM_USER + 109 'build/rebuild the scrollbars, lParam controls redraw
%PGB_REFRESH        = %WM_USER + 110 'redraw the control - wParam and lParam shall be 0

%PGB_GETMAX         = %WM_USER + 120 'returns max number of steps
%PGB_GETVALUE       = %WM_USER + 121 'returns step value
%PGB_GETTXTON       = %WM_USER + 122 'returns txtOnOff value
%PGB_GETTXTPOS      = %WM_USER + 123 'returns text position in control
%PGB_GETTXTCOLBAR   = %WM_USER + 124 'returns bar text color
%PGB_GETTXTCOLBKG   = %WM_USER + 125 'returns background text color
%PGB_GETCOLBKG      = %WM_USER + 126 'returns background color
%PGB_GETBARCOL      = %WM_USER + 127 'returns bar color scheme
%PGB_GETBARDIR      = %WM_USER + 128 'returns bar direction, 0:left/right 1:upside down 2:bottom/top 3:top/bottom
%PGB_GETGRADIENTDIR = %WM_USER + 129 'returns gradient direction - 0:horizontal, 1:vertical
%PGB_GETTXTANGLE    = %WM_USER + 130 'returns rotated font

%PGB_SETTXTON       = %WM_USER + 150 'lParam sets: 0 = no text, 1 = auto text (%), 2 = custom text
%PGB_SETTXTBAR      = %WM_USER + 151 'wParam points to text text for bar, lParam controls redraw
%PGB_SETTXTBKG      = %WM_USER + 152 'wParam points to text text for background, lParam controls redraw
%PGB_SETTXTPOS      = %WM_USER + 153 'wParam sets text position in control
%PGB_SETTXTCOLBAR   = %WM_USER + 154 'wParam sets bar text color

%PGB_SETTXTCOLBKG   = %WM_USER + 155 'wParam sets background text color
%PGB_SETCOLBKG      = %WM_USER + 156 'wParam sets background color, lParam controls rebuild of control
%PGB_SETBARCOL      = %WM_USER + 157 'wParam sets bar color scheme, lParam controls rebuild of control
%PGB_SETBARDIR      = %WM_USER + 159 'wParam sets bar direction, 0:left/right 1:upside down 2:bottom/top 3:top/bottom, lParam controls rebuild of control
%PGB_SETGRADIENTDIR = %WM_USER + 160 'wParam sets gradient direction - 0:horizontal, 1:vertical, lParam controls rebuild of control
%PGB_SETTXTANGLE    = %WM_USER + 161 'wParam sets set rotated font, lParam controls rebuild of control


TYPE PGB3DDATA             'for storing control specific data in memory block
  pStep       AS LONG         'for tracking what step we are on
  pMax        AS LONG         'for storing max number of steps, usually 100 (%)
  hbBack      AS DWORD        'handle for background brush
  barDC       AS DWORD        'memCD for Progressbar
  barBit      AS DWORD        'handle to Progressbar bitmap
  barDC2      AS DWORD        'memCD for Progressbar buffer
  barBit2     AS DWORD        'handle to Progressbar buffer bitmap
  memDc       AS DWORD        'memCD for main buffer
  hBit        AS DWORD        'handle to main buffer bitmap
  hRotateFont AS DWORD        'handle to rotated font style
  hImageBar   AS DWORD        'bar image handle
  hImageBkg   AS DWORD        'background image handle
  direction   AS LONG         'bar direction - left to right, or right to left?
  gradientDir AS LONG         'gradient direction - left to right, or right to left?
  txtAngle    AS LONG         'store given text angle
  bkgColor    AS LONG         'background color
  barCol      AS LONG         'bar color scheme
  txtColBar   AS LONG         'custom text color in bar
  txtColBkg   AS LONG         'custom text color on background
  txtOnOff    AS LONG         '0 = no text, 1 = auto text (%), 2 = custom text
  txtPos      AS LONG         'text position in control, see DrawText API..
  txtBkg      AS ASCIIZ * 255 'text to be painted on background, increase/decrease size to suit your needs
  txtBar      AS ASCIIZ * 255 'text to be painted on bar, increase/decrease size to suit your needs
  PalClr(192) AS LONG         'array for color sceme used by the control
end TYPE

declare function CreateGradientBars(sys hWnd) as sys
declare function CreatePGBar3D(sys hParent, id, string  txt, int vLeft,vTop,vWidth,vHeight, dword wStyle, optional dword wStyleEx=0, DlgUnits=0) as sys

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Create PGBAR3D control
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
function CreatePGBar3D(sys hParent, id, string  txt, int vLeft,vTop,vWidth,vHeight, dword wStyle,  optional dword wStyleEx=0, DlgUnits=0) as sys
   sys hBar
   WNDCLASSEX wc
   string szClassName
 
   szClassName      = "PGBAR3D"
   if GetClassInfoEx(GetModuleHandle(null), szClassName, &wc) = 0 then
     wc.cbSize        = sizeof(wc)
     wc.lpfnWndProc   = @PgbWndProc
     wc.cbWndExtra    = sizeof(sys)  'for pointer to user defined TYPE with control-specific data
     wc.hInstance     = GetWindowLongPtr(hParent, GWL_HINSTANCE)
     wc.hCursor       = LoadCursor(null,  IDC_ARROW )
     wc.lpszClassName = strptr szClassName

     if RegisterClassEx(&wc) = null then mbox "Error: RegisterdClassEx PGBAR3D failed" 
   end if
 
  if DlgUnits then
      RECT rc = {0, 0, 4, 8}
      MapDialogRect (hParent, @rc)
      float PixelX = rc.right/4
      float pixelY = rc.bottom/8
      'create control using dialog units
      hBar = CreateWindowEx(wStyleEx, "PGBAR3D",  null, wStyle,
                           int(vLeft*PixelX), int(vTop*PixelY), int(vWidth*PixelX), int(vHeight*PixelY),
                           hParent, id, GetWindowLongPtr(hParent, GWL_HINSTANCE),  null)
      if hBar = 0 then mbox "Error: CreateWindowEx PGBAR3D failed" 
   else
      'create control using pixels
      hBar = CreateWindowEx(wStyleEx, "PGBAR3D",  null, wStyle,
                           vLeft, vTop, vWidth, vHeight,
                           hParent, id, GetWindowLongPtr(hParent, GWL_HINSTANCE),  null)
      if hBar = 0 then mbox "Error: CreateWindowEx PGBAR3D failed"
   end if
   
   if hBar and len(txt) then SetWindowText(hBar, txt)
   function = hBar
end function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Progressbar procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
function PgbWndProc ( sys hWnd, uint wMsg, sys wParam, lParam) as sys callback

   local pgb AS PGB3DDATA PTR
   'PGB3DDATA *pgb

   if wMsg <> WM_CREATE then &pgb = GetWindowLongPtr(hWnd, 0) 'Get control specific data

   select case wMsg
      case WM_CREATE:  'store control specific data, PGB3DDATA structure, in memory

        sys ppgb=Getmemory sizeof(PGB3DDATA)       
        if ppgb then
           SetWindowLongPtr(hWnd, 0, ppgb)     'Store the pointer for later use
        else
           return -1  'failed to allocate memory, so return -1 to break the action
        end if

        sys hDC, hFontOld
        int xPos, yPos
        RECT rc, rcTxt
        PAINTSTRUCT ps
        SIZE lpSize
        zstring *tp

        @pgb = ppgb       'get address of PGB3DDATA structure
       
        pgb.txtOnOff   = 0     'some initial values - can be changed via custom messages
        pgb.txtPos     = DT_SINGLELINE OR DT_CENTER OR DT_VCENTER OR DT_NOCLIP OR DT_NOPREFIX
        pgb.txtColBar  = RGB(0, 0, 0)
        pgb.txtColBkg  = RGB(255, 255, 0)
        pgb.bkgColor   = RGB(128, 128, 128)              'Background color
        pgb.barCol     = 0
        pgb.hbBack     = CreateSolidBrush(pgb.bkgColor)  'Background brush

'CUSTOM CONTROL MESSAGES
     case PGB_STEPUP
        if pgb.pStep < pgb.pMax then                     'step up while < max
           pgb.pStep+=1
           SendMessage hWnd, PGB_REFRESH, 0, 0           'repaint window (bar)
        end if

     case PGB_STEPDN
        if pgb.pStep > 0 then                            'step down while above 0
           pgb.pStep-=1
           SendMessage hWnd, PGB_REFRESH, 0, 0           'repaint window (bar)
        end if

     case PGB_SETVALUE
        pgb.pStep = min(pgb.pMax, wParam)
        if lParam then SendMessage hWnd, PGB_REFRESH, 0, 0 'refresh if lParam says so

     case PGB_BUILDBARS
        CreateGradientBars(hWnd)                           'build the scrollbars
        if lParam then SendMessage hWnd, PGB_REFRESH, 0, 0 'refresh if lParam says so

     case PGB_REFRESH                                      'redraw control
        InvalidateRect hWnd, null, 0 : UpdateWindow hWnd

'BAR SETTINGS
     case PGB_SETMAX
        pgb.pMax = wParam            'set max number of steps

     case PGB_GETMAX
        return pgb.pMax              'Get max number of steps

     case PGB_GETVALUE
        return pgb.pStep             'return current step value

     case PGB_SETCOLBKG
        pgb.bkgColor = wParam                                 'Set background color via wParam
        if pgb.hbBack then DeleteObject pgb.hbBack            'delete old brush, if any
        pgb.hbBack = CreateSolidBrush(pgb.bkgColor)           'create background color brush
        if lParam then SendMessage hWnd, PGB_BUILDBARS, 1, 0  'refresh if lParam says so

     case PGB_SETBARCOL
        pgb.barCol = wParam * 24 + 1                          'Set bar color
        if lParam then SendMessage hWnd, PGB_BUILDBARS, 0, 1  'rebuild and refresh if lParam says so

     case PGB_GETBARCOL
        return pgb.barCol / 24                                'return bar color scheme
       
     case PGB_SETBARDIR
        pgb.direction = wParam                                'left to right = 0, default
        if lParam then SendMessage hWnd, PGB_BUILDBARS, 0, 1  'rebuild and refresh if lParam says so

     case PGB_GETBARDIR
        return pgb.direction                                  'return bar direction

     case PGB_SETGRADIENTDIR
        pgb.gradientDir = wParam                              'horizontal = 0, default
        if lParam then SendMessage hWnd, PGB_BUILDBARS, 0, 1  'rebuild and refresh if lParam says so

     case PGB_GETGRADIENTDIR
        return pgb.gradientDir       'return gradient direction




[Arnold]

This is part 2 of Pgbar3d.inc:

Code: [Select]


'TEXT MESSAGES
     case PGB_SETTXTON
        pgb.txtOnOff = lParam        'set text on/off

     case PGB_GETTXTON
        return pgb.txtOnOff          'return txtOnOff setting

     case PGB_SETTXTPOS
        pgb.txtPos = wParam          'set text position in control

     case PGB_GETTXTPOS
        return pgb.txtPos            'return txtPos setting

     case PGB_GETTXTCOLBAR
        return pgb.txtColBar         'return bar text color

     case PGB_GETTXTCOLBKG
        return pgb.txtColBkg         'return background text color

     case PGB_GETCOLBKG
        return pgb.bkgColor          'return background color

     case PGB_SETTXTBAR
        tp = wParam     
        pgb.txtBar = tp       
        if lParam then SendMessage hWnd, PGB_REFRESH, 0, 0  'refresh if lParam says so

     case PGB_SETTXTBKG
        tp = wParam
        pgb.txtBkg = tp
        if lParam then SendMessage hWnd, PGB_REFRESH, 0, 0  'refresh if lParam says so

     case PGB_SETTXTCOLBAR
        pgb.txtColBar = wParam                              'set bar's text color

     case PGB_SETTXTCOLBKG
        pgb.txtColBkg = wParam                              'set background's text color

     case PGB_SETTXTANGLE
        LOGFONT logF
        dword tFont

        pgb.txtAngle = wParam
        tFont = SendMessage(hWnd, WM_GETFONT, 0, 0)
        if tFont = null then tFont = GetStockObject(ANSI_VAR_FONT)      'null if system font..
        GetObject(tFont, sizeof(logF), &logF)

        logF.lfEscapement  = wParam * 10                     'angle is given in tenths of degrees
        logF.lforientation = wParam * 10                     'both should be same
        logF.lfWeight = FW_BOLD                              'whatever, this one looks something like system font..
        logF.lfFaceName = "Arial"                            'must be True Type font for rotation purposes
        pgb.hRotateFont = CreateFontIndirect(&logF)          'create the font and store its handle

        if lParam then SendMessage hWnd, PGB_BUILDBARS, 0, 1 'rebuild and refresh if lParam says so

     case PGB_GETTXTANGLE
        return pgb.txtAngle                          'return eventual text angle

'STANDARD CONTROL MESSAGES
     case WM_ERASEBKGND: return 1                    'we handle background redraw ourselves

     case WM_PAINT                                   'time to paint bar
        GetClientRect hWnd, &rc                      'get size of control
        FillRect pgb.memDC, &rc, pgb.hbBack          'clear background
        xPos = pgb.pStep * rc.right / pgb.pMax       'pre-calculate, since often used
        yPos = pgb.pStep * rc.bottom / pgb.pMax      'pre-calculate, since often used

        if pgb.txtOnOff then                         'WITH TEXT
           if pgb.txtOnOff = 1 then
              pgb.txtBar = str(pgb.pStep) + ""       'auto text to paint on bar
              pgb.txtBkg = pgb.txtBar                'auto text to paint on background
           end if
           
           rcTxt.left=rc.left                        'copy rect for drawtext - the easy way
           rcTxt.top=rc.top
           rcTxt.right=rc.right
           rcTxt.bottom=rc.bottom
                                           
           if pgb.hRotateFont then
              hFontOld = SelectObject(pgb.memDC, pgb.hRotateFont)     'store original font for later use
              hFontOld = SelectObject(pgb.barDC2, pgb.hRotateFont)    'is same in both DC's

              if pgb.direction = 1 then     'upside down
                 pgb.txtPos = DT_SINGLELINE OR DT_CENTER OR DT_VCENTER OR DT_NOCLIP OR DT_NOPREFIX
                 GetTextExtentPoint32(pgb.memDC, pgb.txtBar, len(pgb.txtBar), &lpSize)
                 rcTxt.bottom = rcTxt.bottom + lpSize.cy * 2
                 rcTxt.right  = rcTxt.right + lpSize.cx * 2

              elseif pgb.direction = 2 then 'bottom to top
                 pgb.txtPos = DT_SINGLELINE OR DT_LEFT OR DT_VCENTER OR DT_NOCLIP OR DT_NOPREFIX
                 GetTextExtentPoint32(pgb.memDC, pgb.txtBar, len(pgb.txtBar), &lpSize)
                 rcTxt.left    = (rcTxt.right - lpSize.cy) / 2
                 rcTxt.bottom = rcTxt.bottom + lpSize.cx * 1.25

              elseif pgb.direction = 3 then 'top to bottom
                 pgb.txtPos = DT_SINGLELINE OR DT_LEFT OR DT_VCENTER OR DT_NOCLIP OR DT_NOPREFIX
                 GetTextExtentPoint32(pgb.memDC, pgb.txtBar, len(pgb.txtBar), &lpSize)
                 rcTxt.left = (rcTxt.right + lpSize.cy) / 2
                 rcTxt.top = rcTxt.top - lpSize.cx / 1.35
              end if

           end if

           BitBlt pgb.barDC2, 0, 0, rc.right, rc.bottom,
                  pgb.barDC, 0, 0, SRCCOPY                         'paint original bar to buffer

           SetTextColor pgb.barDC2, pgb.txtColBar                  'set color on bar
           DrawText pgb.barDC2, pgb.txtBar, -1, rcTxt, pgb.txtPos  'draw text on bar

           SetTextColor pgb.memDC, pgb.txtColBkg                   'set color on background
           DrawText pgb.memDC, pgb.txtBkg, -1, rcTxt, pgb.txtPos   'draw text on background

           if pgb.direction = 0 then 'LEFT to RIGHT - WITH TEXT
              BitBlt pgb.memDC, 0, 0, xPos, rc.bottom,
                     pgb.barDC2, 0, 0, SRCCOPY                     'paint proper part of gradiant bar

           elseif pgb.direction = 1 then  'RIGHT to LEFT - WITH TEXT
              BitBlt pgb.memDC, rc.right - xPos, 0, xPos, rc.bottom,
                     pgb.barDC2, rc.right - xPos, 0, SRCCOPY

           elseif pgb.direction = 2 then  'BOTTOM to TOP - WITH TEXT
              BitBlt pgb.memDC, 0, rc.bottom - yPos, rc.right, rc.bottom,
                     pgb.barDC2, 0, rc.bottom - yPos, SRCCOPY

           elseif pgb.direction = 3 then  'TOP to BOTTOM - WITH TEXT
              BitBlt pgb.memDC, 0, 0, rc.right, yPos,
                     pgb.barDC2, 0, 0, SRCCOPY

           end if

        else                                         'WITHOUT TEXT
           if pgb.direction = 0 then      'LEFT to RIGHT - NO TEXT
              BitBlt pgb.memDC, 0, 0, xPos, rc.bottom,
                     pgb.barDC, 0, 0, SRCCOPY                      'paint proper part of gradiant bar

           elseif pgb.direction = 1 then  'RIGHT to LEFT - NO TEXT
              BitBlt pgb.memDC, rc.right - xPos, 0, xPos, rc.bottom,
                     pgb.barDC, rc.right - xPos, 0, SRCCOPY

           elseif pgb.direction = 2 then  'BOTTOM to TOP - NO TEXT
              BitBlt pgb.memDC, 0, rc.bottom - yPos, rc.right, rc.bottom,
                     pgb.barDC, 0, rc.bottom - yPos, SRCCOPY

           elseif pgb.direction = 3 then  'TOP to BOTTOM - NO TEXT
              BitBlt pgb.memDC, 0, 0, rc.right, yPos,
                     pgb.barDC, 0, 0, SRCCOPY

           end if

        end if

        BeginPaint hWnd, &ps                             'begin screen painting
        if pgb.PalClr(0) then                            'if we have palette (256 color mode)
           SelectPalette ps.hDC, pgb.PalClr(0), 0        'then use it in DC..
           RealizePalette ps.hDC
        end if

        BitBlt ps.hDC, 0, 0, rc.right, rc.bottom,
               pgb.memDC, 0, 0, SRCCOPY                  'paint it all to screen

        if hFontOld then
            SelectObject(pgb.memDC, hFontOld)            'select the original font back
            SelectObject(pgb.barDC2, hFontOld)           'was the same in both DC's
        end if

        EndPaint hWnd, &ps                               'finish up
        return 0

     case WM_DESTROY :                                                         'clean up, to avoid nasty memory leaks
        if pgb.hRotateFont then DeleteObject pgb.hRotateFont                   'may be a stockobject, but doesn't matter
        if pgb.hbBack      then DeleteObject pgb.hbBack                        'delete brush
        if pgb.hbit        then DeleteObject SelectObject(pgb.memDC, pgb.hbit)
        if pgb.memDC       then DeleteDC pgb.memDC                             'and memory DC's + bitmaps
        if pgb.barBit      then DeleteObject SelectObject(pgb.barDC, pgb.barBit)
        if pgb.barDC       then DeleteDC pgb.barDC
        if pgb.barBit2     then DeleteObject SelectObject(pgb.barDC2, pgb.barBit2)
        if pgb.barDC2      then DeleteDC pgb.barDC2
        if pgb.PalClr(0)   then DeleteObject pgb.PalClr(0)
        freememory &pgb
        return 0

   end select

   return DefWindowProc(hWnd, wMsg, wParam, lParam)
end function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Create actual ProgressBar, based on previously made settings
' Note: one could also load a couple of bitmaps here instead,
' for some terrific effects.. :-)
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
function CreateGradientBars( sys hWnd) as sys
  sys hDC, hPen
  int ic, jj
  float kk, L
  RECT rc
  PGB3DDATA *pgb
 
  &pgb = GetWindowLongPtr(hWnd, 0)                                    'Get control specific data

  if pgb.hbit    then DeleteObject SelectObject(pgb.memDC, pgb.hbit)
  if pgb.memDC   then DeleteDC pgb.memDC                              'delete old memDC's and bitmaps, if any
  if pgb.barBit  then DeleteObject SelectObject(pgb.barDC, pgb.barBit)
  if pgb.barDC   then DeleteDC pgb.barDC
  if pgb.barBit2 then DeleteObject SelectObject(pgb.barDC2, pgb.barBit2)
  if pgb.barDC2  then DeleteDC pgb.barDC2

  GetClientRect hWnd, rc                                              'get control height and width

  hDC = GetDc(hWnd)
  if hDC then                                                         'create 3 compatible memory DC's based on
     pgb.memDC   = CreateCompatibleDC(hDC)                            'control's DC, for faster action in WM_PAINT
     pgb.hbit    = CreateCompatibleBitmap(hDC, rc.right, rc.bottom)
     pgb.hbit    = SelectObject(pgb.memDC, pgb.hbit)
     pgb.barDC   = CreateCompatibleDC(hDC)
     pgb.barBit  = CreateCompatibleBitmap(hDC, rc.right, rc.bottom)
     pgb.barBit  = SelectObject(pgb.barDC, pgb.barBit)
     pgb.barDC2  = CreateCompatibleDC(hDC)
     pgb.barBit2 = CreateCompatibleBitmap(hDC, rc.right, rc.bottom)
     pgb.barBit2 = SelectObject(pgb.barDC2, pgb.barBit2)
     SetBkMode pgb.memDC, TRANSPARENT                                 'set text background modes
     SetBkMode pgb.barDC2, TRANSPARENT

'------------------------------------------------------------------------------
' 'need own palette if in 256 color mode
'------------------------------------------------------------------------------
     jj = 1
     for ic = 117 to 255 STEP 6         '0, gray table 1-24
        pgb.PalClr(jj) = RGB(ic, ic, ic) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '1, red table 25-48
        pgb.PalClr(jj) = RGB(ic, ic - 117, ic - 117) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '2, green table 49-72
        pgb.PalClr(jj) = RGB(ic - 117, ic, ic - 117) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '3, blue table 73-96
        pgb.PalClr(jj) = RGB(ic - 117, ic - 117, ic) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '4, blue-green table 97-120
        pgb.PalClr(jj) = RGB(ic - 117, ic, ic) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '5, violet table 121-144
        pgb.PalClr(jj) = RGB(ic, ic - 117, ic) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '6, gold table 145-168
        pgb.PalClr(jj) = RGB(min(ic + 64, 255), ic, ic - 117) : jj+=1
     next
     for ic = 117 to 255 STEP 6         '7, brown table 169-192
        pgb.PalClr(jj) = RGB(min(ic + 16, 255), ic - 48, ic - 117) : jj+=1
     next
     jj-=1

     if GetDeviceCaps(hDC, NUMCOLORS) > -1 and                         'if needed, create own palette
     (GetDeviceCaps(hDC, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then
        if pgb.PalClr(0) then DeleteObject pgb.PalClr(0)
        pgb.PalClr(0) = MakeLong(&H0300, jj)
        pgb.PalClr(0) = CreatePalette pgb.PalClr(0)
        for ic = 1 to jj
           pgb.PalClr(ic) = pgb.PalClr(ic) + &H02000000
        next
     end if
     ReleaseDc hWnd, hDC                                               'release the temporary DC

     if pgb.PalClr(0) then 'if we have palette (256 color mode), then use it in memDCs..
        SelectPalette pgb.barDC, pgb.PalClr(0), 0
        RealizePalette pgb.barDC
        SelectPalette pgb.barDC2, pgb.PalClr(0), 0
        RealizePalette pgb.barDC2
     end if

'------------------------------------------------------------------------------
     if pgb.gradientDir = 0 then   'HORIZONTAL BAR
        jj = rc.bottom - 1
     else                          'VERTICAL BAR
        jj = rc.right - 1
     end if
     kk = pgb.barCol
     L = 1 / ((jj / 2) / 24)       'calculate steps for color

     for ic = 0 to jj                                    'draw the whole gradient bar
        hPen = CreatePen(PS_SOLID, 1, pgb.PalClr(kk))    'create pen
        hPen = SelectObject(pgb.barDC, hPen)             'select pen into DC, store original pen
        if pgb.gradientDir = 0 then                      'HORIZONTAL BAR
           MoveToEx pgb.barDC, 0, ic, null               'move into position
           LineTo pgb.barDC, rc.right, ic                'and draw a line from left to right
        else                                             'VERTICAL BAR
           MoveToEx pgb.barDC, ic, 0, null               'move into position
           LineTo pgb.barDC, ic, rc.bottom               'and draw a line from top to bottom
        end if
        DeleteObject SelectObject(pgb.barDC, hPen)       'delete pen to avoid memory leaks

        if ic < jj / 2 -1 then
           kk = MIN(pgb.barCol + 23, int(kk + L))
        else
           kk = MAX(pgb.barCol, int(kk - L))
        end if
     next

     return true                                         'return true on success
  end if

end function


[Arnold]

This is the first example (Pgbar3d.o2bas). The app uses the modified dialogs.inc which is presented here:

https://www.oxygenbasic.org/forum/index.php?topic=1525.msg18825#msg18825

Code: OxygenBasic

1. '====================================================================
2. ' Test program for custom control Progressbar include file: PGBAR3D.inc
3. '====================================================================
4.  
5. $ filename "Pgbar3d.exe"
6.  
7. 'uses rtl32
8. 'uses rtl64
9.  
10. '% review
11. uses dialogs
12. uses pgbar3d
13.  
14.  
15. %ID_BUTNSTART   = 101
16. %ID_BUTNREVERSE = 102
17. %ID_CHKTXT      = 110
18. %ID_OPTFAST     = 120
19. %ID_OPTSLOW     = 121
20. %ID_BARLEFT     = 201
21. %ID_BARTOP      = 202
22. %ID_BARRIGHT    = 203
23. %ID_BARBOTTOM   = 204
24. %ID_BARMID      = 205
25.  
26.  
27. INITCOMMONCONTROLSEXt icce
28. 'Load the common controls library...
29. icce.dwSize = sizeof(INITCOMMONCONTROLSEXt)
30. icce.dwICC = 0xffff
31. InitCommonControlsEx(&icce)
32.  
33. char* cmdline
34. &cmdline=GetCommandLine()
35. sys hInstance = GetModuleHandle(null)
36.  
37. sub winmain()
38.  
39.    Dialog( 0, 0, 200, 138, "PGBAR3D v2 demo",
40.            WS_CAPTION or WS_SYSMENU or DS_CENTER or DS_SETFONT,
41.            8, "MS Sans Serif" )
42.    PushButton( "Start" ,   ID_BUTNSTART,   100, 52, 75, 14 )
43.    PushButton( "Reverse" , ID_BUTNREVERSE,  25, 52, 75, 14 )
44.    RadioButton("Fast",     ID_OPTFAST,      30, 28, 40, 10 )
45.    RadioButton("Slow",     ID_OPTSLOW,      30, 38, 40, 10 )
46.    AutoCheckBox("Text on/off", ID_CHKTXT,   97, 28, 50, 10 )
47.  
48.    CreateModalDialog( null, @DialogProc, 0)
49. end sub
50.  
51. winmain()
52.  
53. '---------------------------------------------------------------------------------
54.  
55. sub doEvents()
56.    MSG tMsg  
57.    while PeekMessage(&tMsg, null, 0,0, PM_NOREMOVE)
58.       sys bRet = GetMessage (&tMsg, null, 0, 0)
59.       if bRet = 0 then   'WM_QUIT
60.        PostQuitMessage(tMsg.wParam)
61.         exit while
62.       elseif bRet = -1 then
63.         'show an error message
64.        print "Error in doEvents"
65.       else
66.         TranslateMessage(&tMsg)
67.         DispatchMessage(&tMsg)
68.       end if
69.    wend
70. end sub
71.  
72.  
73. function DialogProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
74.  
75.   select case uMsg
76.  
77.     case WM_INITDIALOG
78.         SendMessage(GetDlgItem(hDlg, ID_OPTFAST), BM_SETCHECK, true, 0)
79.         EnableWindow(GetDlgItem(hDlg, ID_BUTNREVERSE), false)
80.  
81.         CreatePGBar3D (hDlg, ID_BARLEFT, "", 5, 20, 14, 98,
82.                       WS_CHILD OR WS_VISIBLE, WS_EX_CLIENTEDGE,1)                          'LEFT BAR, VERTICAL
83.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETMAX, 100, 0)                      'max number of steps
84.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETBARDIR, 2, 0)                     'bar direction, bottom - top
85.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETGRADIENTDIR, 1, 0)                'vertical gradient
86.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETBARCOL, PGB_GOLD, 0)              'bar color scheme
87.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETTXTCOLBKG, RGB(255, 255, 0), 0)   'backgound text color
88.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETTXTCOLBAR, RGB(0, 0, 255), 0)     'bar text color
89.        SendMessage(GetDlgItem(hDlg, ID_BARLEFT), PGB_SETTXTANGLE, 90, 0)                  'text angle, vertical up
90.  
91.         CreatePGBar3D (hDlg, ID_BARTOP, "", 5, 4, 190, 14,
92.                        WS_CHILD OR WS_VISIBLE, WS_EX_CLIENTEDGE,1)                         'TOP BAR, HORIZONTAL
93.        SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_SETMAX, 100, 0)                       'max number of steps
94.        SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_SETBARDIR, 0, 0)                      'bar direction, left - right
95.        SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_SETGRADIENTDIR, 0, 0)                 'horizontal gradient
96.        SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_SETBARCOL, PGB_CYAN, 0)               'bar color scheme
97.        SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_SETTXTCOLBKG, RGB(0,255,255), 0)      'backgound text color
98.        SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_SETTXTCOLBAR, RGB(0,0,0), 0)          'bar text color
99.  
100.         CreatePGBar3D (hDlg, ID_BARRIGHT, "", 181, 20, 14, 98,
101.                        WS_CHILD OR WS_VISIBLE, WS_EX_CLIENTEDGE,1)                         'RIGHT BAR, VERTICAL
102.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETMAX, 100, 0)                     'max number of steps
103.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETBARDIR, 3, 0)                    'bar direction, top - bottom
104.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETGRADIENTDIR, 1, 0)               'vertical gradient
105.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETBARCOL, PGB_RED, 0)              'bar edge color
106.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETCOLBKG, RGB(191,191,191), 0)     'background color
107.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETTXTCOLBKG, RGB(255,0,0), 0)      'backgound text color
108.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETTXTCOLBAR, RGB(255,255,0), 0)    'bar text color
109.        SendMessage(GetDlgItem(hDlg, ID_BARRIGHT), PGB_SETTXTANGLE, 270, 0)                'text angle, vertical down
110.  
111.         CreatePGBar3D (hDlg, ID_BARBOTTOM, "", 5, 120, 190, 14,
112.                       WS_CHILD OR WS_VISIBLE, WS_EX_CLIENTEDGE,1)                          'BOTTOM BAR, HORIZONTAL
113.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETMAX, 100, 0)                    'max number of steps
114.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETBARDIR, 1, 0)                   'bar direction, right - left
115.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETGRADIENTDIR, 0, 0)              'horizontal gradient
116.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETCOLBKG, RGB(191,191,191), 0)    'background color
117.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETBARCOL, PGB_BLUE, 0)            'bar mid color
118.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETTXTCOLBKG, RGB(0,0,196), 0)     'backgound text color
119.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETTXTCOLBAR, RGB(255,255,255), 0) 'bar text color
120.        SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_SETTXTANGLE, 180, 0)               'text angle, upside down
121.  
122.         CreatePGBar3D (hDlg, ID_BARMID, "", 22, 70, 157, 48,
123.                        WS_CHILD OR WS_VISIBLE, WS_EX_CLIENTEDGE,1)                         'MID BAR, HORIZONTAL
124.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETMAX, 100, 0)                       'max number of steps
125.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETBARDIR, 2, 0)                      'bar direction, bottom - top
126.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETGRADIENTDIR, 0, 0)                 'horizontal gradient
127.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETCOLBKG, RGB(0,0,0), 0)             'background color
128.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETBARCOL, PGB_SILVER, 0)             'bar edge color
129.        SendMessage(GetDlgItem(hDlg, ID_BARMID),  PGB_SETTXTCOLBKG, RGB(0,255,255), 0)     'backgound text color
130.  
131.         string txt
132.         txt = "Click Start to see action"                                  'set background text in middle progressbar
133.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETTXTBKG, txt, 0)
134.         txt = "Hope you'll find it useful!"                                'set bar text in middle progressbar
135.        SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETTXTBAR, txt, 0)
136.         SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETTXTON, 0, 2)       'tell control to use custom text
137.  
138.         SendMessage(GetDlgItem(hDlg, ID_BARLEFT),   PGB_BUILDBARS, 0, 0)   'finally, build the bars - IMPORTANT!
139.        SendMessage(GetDlgItem(hDlg, ID_BARTOP),    PGB_BUILDBARS, 0, 0)
140.         SendMessage(GetDlgItem(hDlg, ID_BARRIGHT),  PGB_BUILDBARS, 0, 0)
141.         SendMessage(GetDlgItem(hDlg, ID_BARBOTTOM), PGB_BUILDBARS, 0, 0)
142.         SendMessage(GetDlgItem(hDlg, ID_BARMID),    PGB_BUILDBARS, 0, 0)
143.  
144.     case WM_COMMAND
145.        sys id=loword(wParam)
146.        sys event=hiword(wParam)
147.        int I,J,K, slow
148.        static int allSteps
149.        string txt
150.    
151.        if event=BN_CLICKED then
152.           select case id          
153.             case ID_BUTNSTART
154.                allSteps = SendMessage(GetDlgItem(hDlg, ID_BARTOP), PGB_GETMAX, 0, 0 )  'get number of steps, usually 100            
155.               EnableWindow(GetDlgItem(hDlg, ID_BUTNSTART), false)                     '<- disable start button
156.               txt = "Please wait.."                                             '<- set new text in middle progressbar
157.               SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETTXTBKG, txt, 1)
158.                for K = 0 to 4                                                    '<- run one control at the time                
159.                  for I = 1 to allSteps
160.                      slow = SendMessage(GetDlgItem(hDlg, ID_OPTSLOW), BM_GETCHECK, 0, 0)     '<- check settings for slow/fast
161.                     SendMessage(GetDlgItem(hDlg, ID_BARLEFT + K), PGB_STEPUP, 0, 0)
162.                     if mod(I,2) = 0 then doEvents()                              '<- to avoid dialog "freeze" in loop..
163.                    Sleep 1
164.                     if slow then Sleep 39                                        '<- if "slow" has been selected
165.                  next
166.                next
167.                EnableWindow(GetDlgItem(hDlg, ID_BUTNREVERSE), true)              '<- enable reverse button
168.  
169.             case ID_BUTNREVERSE              
170.                EnableWindow(GetDlgItem(hDlg, ID_BUTNREVERSE), false)
171.                for K = 0 to 4                  
172.                   for I = 1 to allSteps
173.                     slow = SendMessage(GetDlgItem(hDlg, ID_OPTSLOW), BM_GETCHECK, 0, 0)
174.                      SendMessage(GetDlgItem(hDlg, (ID_BARMID - K)), PGB_STEPDN, 0, 0)
175.                     if mod(I,2) = 0 then doEvents()
176.                     Sleep 1
177.                     if slow then SLEEP 39                                         'if "slow" has been selected
178.                  next
179.                next
180.                txt = "Click Start to see action"                                  'set new text in middle progressbar
181.               SendMessage(GetDlgItem(hDlg, ID_BARMID), PGB_SETTXTBKG, txt, 1)
182.                EnableWindow(GetDlgItem(hDlg, ID_BUTNSTART), true)                 '<- enable start button
183.  
184.             case ID_CHKTXT 'text on/off
185.               J=SendMessage(GetDlgItem(hDlg, ID_CHKTXT), BM_GETCHECK, 0, 0)      '<- set auto text (%) on/off
186.               for K = 0 to 3
187.                   SendMessage(GetDlgItem(hDlg, (ID_BARLEFT + K)), PGB_SETTXTON, 0, J)
188.                   SendMessage(GetDlgItem(hDlg, (ID_BARLEFT + K)), PGB_REFRESH, 0, 0)
189.                next
190.  
191.           end select
192.        end if
193.        
194.     case WM_CLOSE
195.        EndDialog( hDlg, null )              
196.   end select
197.  
198.   return 0
199. end function
200.  

[Arnold]

This is the second example (Pgbar3d3.o2bas). Attached is the complete project as a zip file. The examples should work in 32-bit and in 64-bit mode. Note: this is only one possible way to code these demos. I wanted to reproduce the results of the original as accurately as possible.

Roland

Code: OxygenBasic

1. ' Test program for custom control Progressbar include file: pgbar3d.inc
2.  
3. $ filename "pgbar3d3.exe"
4.  
5. 'uses rtl32
6. 'uses rtl64
7.  
8. uses WinUtil
9. uses pgbar3d
10.  
11.  
12. % ID_BUTNSTART   = 101
13. % ID_BUTNREVERSE = 102
14. % ID_OPTFAST     = 120
15. % ID_OPTSLOW     = 121
16. % ID_BAR1        = 202
17. % ID_BAR2        = 203
18. % ID_BAR3        = 204
19.  
20. INITCOMMONCONTROLSEXt icce
21. 'Load the common controls library...
22. icce.dwSize = sizeof(INITCOMMONCONTROLSEXt)
23. icce.dwICC = 0xffff
24. InitCommonControlsEx(&icce)
25.  
26. char* cmdline
27. &cmdline=GetCommandLine()
28. sys hInstance = GetModuleHandle(null)
29.  
30. function CreateNew(string ctlclass, string Caption, sys hParent, id, int x,y,w,h, optional int Style=0, ExtStyle=0, sys lpParam=0) as sys
31.    sys hCtrl
32.    if style=0 then
33.       style=WS_CHILD or WS_VISIBLE or WS_TABSTOP
34.    else
35.       style=WS_VISIBLE or style
36.    end if  
37.    hCtrl=CreateWindowEx(ExtStyle, ctlclass, Caption, Style, x,y,w,h, hParent, id, hInstance, lpParam)
38.    if hCtrl=null then mbox "Error: Cannot create " ctlclass
39.    return hCtrl
40. end function
41.  
42. sub doEvents()
43.    MSG tMsg  
44.    while PeekMessage(&tMsg, null, 0,0, PM_NOREMOVE)
45.       sys bRet = GetMessage (&tMsg, null, 0, 0)
46.       if bRet = 0 then   'WM_QUIT
47.        PostQuitMessage(tMsg.wParam)
48.         exit while
49.       elseif bRet = -1 then
50.         'show an error message
51.        print "Error in doEvents"
52.       else
53.         TranslateMessage(&tMsg)
54.         DispatchMessage(&tMsg)
55.       end if
56.    wend
57. end sub
58.  
59.  
60. MainWindow 295,150, WS_CAPTION or WS_SYSMENU
61.  
62. function WndProc(sys hwnd, uint uMsg, sys wParam, lParam) as sys callback
63.     int i
64.     string txt
65.     static int slow
66.    
67.     select uMsg
68.         case WM_CREATE
69.            sys hFont=CreateFont(8,4, 0,0,0,0,0,0, ANSI_CHARSET, FALSE, FALSE, DEFAULT_QUALITY, DEFAULT_PITCH or FF_ROMAN, "MS Sans Serif")
70.    
71.            SetWindowText(hwnd, "PGBAR3D trippel-bar demo")
72.            CreateNew("BUTTON",   "Start",hwnd, ID_BUTNSTART,         160, 90, 110, 20)
73.            CreateNew("BUTTON",   "Reverse",hwnd, ID_BUTNREVERSE,      40, 90, 110, 20)
74.            CreateNew("BUTTON",   "Fast",hwnd, ID_OPTFAST,             50, 40, 50, 15, WS_CHILD or BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY)
75.            CreateNew("BUTTON",   "Slow",hwnd, ID_OPTSLOW,             50, 60, 50, 15, WS_CHILD or BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY)
76.            SendMessage(GetDlgItem(hwnd, ID_BUTNSTART), WM_SETFONT, hFont, true)
77.            SendMessage(GetDlgItem(hwnd, ID_BUTNREVERSE), WM_SETFONT, hFont, true)
78.            SendMessage(GetDlgItem(hwnd, ID_OPTFAST), WM_SETFONT, hFont, true)
79.            SendMessage(GetDlgItem(hwnd, ID_OPTSLOW), WM_SETFONT, hFont, true)                                
80.  
81.            SendMessage(GetDlgItem(hwnd, ID_OPTFAST), BM_SETCHECK, true, 0)
82.            EnableWindow(GetDlgItem(hwnd, ID_BUTNREVERSE), false)
83.  
84.            CreateNew("STATIC", "", hwnd, -1,  10, 10, 270, 24,  WS_CHILD or WS_VISIBLE,  WS_EX_CLIENTEDGE)    
85.  
86.            CreatePGBar3D (hwnd, ID_BAR1, "",  11, 11, 89, 22,   WS_CHILD or WS_VISIBLE, 0)  'BAR1
87.           SendMessage (GetDlgItem(hwnd, ID_BAR1), PGB_SETMAX, 33, 0)                       'max number of steps
88.           SendMessage (GetDlgItem(hwnd, ID_BAR1), PGB_SETBARCOL, PGB_RED, 0)               'bar color scheme
89.  
90.            CreatePGBar3D (hwnd, ID_BAR2, "", 100, 11, 89, 22, WS_CHILD or WS_VISIBLE,   0)  'BAR2
91.           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETMAX, 33, 0)                       'max number of steps
92.           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETBARCOL, PGB_GOLD, 0)              'bar color scheme
93.           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTON, 0, 2)                      'show own text
94.           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTCOLBKG, RGB(255,255,0), 0)     'backgound text color
95.           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTCOLBAR, RGB(0,0,0), 0)         'bar text color
96.  
97.            CreatePGBar3D (hwnd, ID_BAR3, "", 189, 11, 89, 22, WS_CHILD or WS_VISIBLE,  0)   'BAR3
98.           SendMessage (GetDlgItem(hwnd, ID_BAR3), PGB_SETMAX, 33, 0)                       'max number of steps
99.           SendMessage (GetDlgItem(hwnd, ID_BAR3), PGB_SETBARCOL, PGB_GREEN, 0)             'bar color scheme
100.  
101.            SendMessage (GetDlgItem(hwnd, ID_BAR1), PGB_BUILDBARS, 0, 0)         'finally, build the bars - IMPORTANT!          
102.           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_BUILDBARS, 0, 0)
103.            SendMessage (GetDlgItem(hwnd, ID_BAR3), PGB_BUILDBARS, 0, 0)
104.  
105.            case WM_COMMAND
106.               sys id=loword(wParam)
107.               sys event=hiword(wParam)
108.              
109.               if event=BN_CLICKED then
110.                 select case id
111.                   case ID_BUTNSTART
112.                      EnableWindow(GetDlgItem(hwnd, ID_BUTNSTART), false)
113.                      for I = 1 to 100
114.                         slow = SendMessage(GetDlgItem(hwnd, ID_OPTSLOW), BM_GETCHECK, 0, 0)
115.                         if I>0 and I <= 33 then
116.                           SendMessage (GetDlgItem(hwnd, ID_BAR1), PGB_STEPUP, 0, 0)
117.                         elseif I>33 and I < 67 then
118.                           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_STEPUP, 0, 0)
119.                         else
120.                           SendMessage (GetDlgItem(hwnd, ID_BAR3), PGB_STEPUP, 0, 0)
121.                         end if
122.                         txt = str(I) + "%"                      
123.                         SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTBKG, txt, 1)
124.                         SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTBAR, txt, 1)
125.                         if mod(I,2) = 0 then doEvents()
126.                         Sleep 5
127.                         if slow then Sleep 35                                    '<- if "slow" has been selected
128.                     next I
129.                      EnableWindow(GetDlgItem(hwnd, ID_BUTNREVERSE), true)        '<- enable reverse button
130.  
131.                   case ID_BUTNREVERSE
132.                      EnableWindow(GetDlgItem(hwnd, ID_BUTNREVERSE), false)
133.                      for I = 99 to 0 step -1
134.                         slow = SendMessage(GetDlgItem(hwnd, ID_OPTSLOW), BM_GETCHECK, 0, 0)
135.                         if I>66 then
136.                           SendMessage (GetDlgItem(hwnd, ID_BAR3), PGB_STEPDN, 0, 0)
137.                         elseif I>33 then
138.                           SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_STEPDN, 0, 0)
139.                         else
140.                           SendMessage (GetDlgItem(hwnd, ID_BAR1), PGB_STEPDN, 0, 0)
141.                         end if
142.                         txt = str(I) + "%"                      
143.                         SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTBKG, txt, 1)
144.                         SendMessage (GetDlgItem(hwnd, ID_BAR2), PGB_SETTXTBAR, txt, 1)
145.                         if mod(I,2) = 0 then doEvents()
146.                         Sleep 5
147.                         if slow then Sleep 35                                    '<- if "slow" has been selected
148.                     next I
149.                      EnableWindow(GetDlgItem(hwnd, ID_BUTNSTART), true)          '<- enable start button
150.                  
151.                 end select
152.               end if
153.              
154.         case WM_CLOSE
155.            DeleteObject(hFont)
156.            DestroyWindow(hwnd)
157.        
158.         case WM_DESTROY
159.            PostQuitMessage(0)
160.        
161.         case else
162.            return DefWindowProc(hwnd, uMsg, wParam, lParam)
163.            
164.     end select
165.  
166. end function
167.  

[Arnold]

Edit: Deleted. Not relevant anymore.

[Aurel]

-I am curious: does this message have any reference to the method of creating a custom control?

I am not sure what  you mean by that but probably someone else can reply...

Nice control by bjorne
i am interested for richedit and edm32

[Aurel]

Oh what a heck   
download links from that site not work for me ?