Oxygen Basic

Programming => Example Code => Topic started by: Arnold on November 04, 2018, 08:49:21 AM

Title: Custom Controls in OxygenBasic
Post by: Arnold on November 04, 2018, 08:49:21 AM
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.  
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 04, 2018, 10:59:08 PM
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...
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 05, 2018, 12:05:58 AM
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
 
Title: Re: Custom Controls in OxygenBasic
Post by: Charles Pegge on November 05, 2018, 01:16:09 AM

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
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 05, 2018, 02:19:38 AM
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.
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 05, 2018, 04:06:53 AM
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.
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 05, 2018, 06:00:03 AM
Is that hard to answer?
ok
forget i don't have in plan to bother anyone here anymore...
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 05, 2018, 10:12:35 AM
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
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 11, 2018, 03:20:37 AM
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
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 11, 2018, 03:22:12 AM
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
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 11, 2018, 03:24:18 AM
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.  
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 11, 2018, 03:27:56 AM
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.  
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 11, 2018, 11:21:56 AM
Edit: Deleted. Not relevant anymore.
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 11, 2018, 02:20:27 PM
-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 ;)
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 11, 2018, 02:24:14 PM
Oh what a heck   >:(
download links from that site not work for me ?
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 11, 2018, 02:31:26 PM
OH man...
Stupid chromium based browser refuse to open http linked file..geee
I can with my old KMeleon  :D
work...
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 11, 2018, 02:42:22 PM
Hmmm this control is really nice and fast but require lot of work  ::)
Title: Re: Custom Controls in OxygenBasic
Post by: Charles Pegge on November 12, 2018, 07:48:51 PM

Many thanks, Roland :)

Is it safe to use this dialogs.inc with previous examples (September 2018) ?
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 13, 2018, 04:14:32 AM
Hi Charles,

actually I intended to use the same file (of September 2018). I noticed that I have added the line 234:

  int e = int(title) : if e != 0 or title=0 then mbox "Warning: title in Dialog probably not a string"

which should give a warning if using wrong parameters, but I am not sure if this will really help.
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 13, 2018, 04:19:35 AM
Hello,

this is another interesting example of a customized control which I found in this tutorial by Martin Mitáš:

Custom Controls in Win32 API
https://www.codeproject.com/Articles/559385/Custom-Controls-in-Win32-API-The-Basics

The demo is the second example of the tutorial demonstrating double buffering. It uses a slightly different approach. I think if anyone is willing to examine the examples shown in my first message, the replies 8-11 and this example, and is willing to work through the mentioned tutorial (the complete set of course), he/she will be able to understand, create and use own customized controls, independent of the used programming language. I myself am happy that the Internet is such a great source of information these days, and I am grateful that there are people who share their knowledge.

Roland

Code: OxygenBasic
  1. 'Custom Control demonstrating the double buffering
  2. 'https://www.codeproject.com/Articles/617212/Custom-Controls-in-Win32-API-The-Painting
  3.  
  4. $ filename "dblbuf.exe"
  5.  
  6. 'uses rtl32
  7. 'uses rtl64
  8.  
  9. uses winutil
  10.  
  11.  
  12. % DT_CENTER=1
  13. % DT_VCENTER=4
  14. % DT_SINGLELINE=32
  15. % SWP_NOZORDER=4
  16. % GCL_HBRBACKGROUND = -10
  17. % SRCCOPY=0xCC0020
  18. % WM_NCCREATE=129
  19. % WM_NCDESTROY=130
  20. % WM_PRINTCLIENT=792
  21. % WM_STYLECHANGED=125
  22. % SIZE_RESTORED=0
  23. % SIZE_MAXIMIZED=2
  24.  
  25.  
  26. function RGB(int r, g, b) as int
  27.     return (r + g*256 + b*65536)
  28. end Function
  29.  
  30.  
  31. '=======================
  32. 'MAIN CODE
  33. '=======================
  34.  
  35. dim nCmdline as asciiz ptr, hInstance as sys
  36. &nCmdline = GetCommandLine
  37. hInstance = GetModuleHandle(0)
  38.  
  39. MainWindow 350,250,WS_OVERLAPPEDWINDOW
  40.  
  41. '-----------------------------------------------------------------------------
  42.  
  43. ' Window class
  44. % CUSTOM_WC = "CustomControl"
  45.  
  46. /* Style to request using double buffering. */
  47. % XXS_DOUBLEBUFFER   0x0001
  48.  
  49. % CUSTOM_ID     100
  50. % MARGIN          7
  51.  
  52.  
  53. % CELLSIZE        48
  54. % DARKCOLOR       RGB(0,47,127)
  55. % LIGHTCOLOR      RGB(241,179,0)
  56.  
  57.  
  58. type CustomData
  59.     sys   hwnd
  60.     dword style
  61.     sys   hbrLight
  62.     sys   hbrDark
  63. end type
  64.  
  65. 'Register the window class
  66. sub CustomRegister()
  67.     WNDCLASSEX wc
  68.  
  69.     ' Note we do not use CS_HREDRAW and CS_VREDRAW.
  70.    ' This means when the control is resized, WM_SIZE (as handled by DefWindowProc())
  71.    ' invalidates only the newly uncovered area.
  72.    ' With those class styles, it would invalidate complete client rectangle.
  73.    wc.cbSize        = sizeof(WNDCLASSEX)
  74.     wc.lpszClassName = &CUSTOM_WC           'strptr "CustomControl"
  75.    wc.style         = CS_GLOBALCLASS    
  76.     wc.lpfnWndProc   = @CustomProc
  77.     wc.cbWndExtra    = sizeof(sys) 'pointer to CustomData    
  78.    wc.hCursor       = LoadCursor(null, IDC_ARROW)
  79.    
  80.     if RegisterClassEx(&wc) = 0 then mbox "Error: Cannot Register CustomControl"
  81. end sub
  82.  
  83. 'Unregister the window class
  84. sub CustomUnregister()
  85.    if UnregisterClass(CUSTOM_WC, null) = 0 then mbox "Error: Cannot Unregister CustomControl"
  86. end sub
  87.  
  88.  
  89. function WndProc(sys hwnd, uint uMsg, sys wParam, lParam) as sys callback
  90.     static sys hwndCustom
  91.    
  92.     select uMsg
  93.  
  94.         case WM_CREATE
  95.            SetWindowText(hwnd, "Double Buffering Example")
  96.  
  97.            CustomRegister()        
  98.            hwndCustom = CreateWindowEx(0,CUSTOM_WC, null, WS_CHILD or WS_VISIBLE or 0,
  99.                                  0, 0, 0, 0, hwnd, CUSTOM_ID, hInstance, null)
  100.            if hwndCustom = 0 then mbox "Error: Cannot create hwndCustom"
  101.        
  102.         case WM_SIZE
  103.            if wParam = SIZE_MAXIMIZED or wParam = SIZE_RESTORED then
  104.              word cx = loword(lParam)
  105.              word cy = hiword(lParam)
  106.              SetWindowPos(hwndCustom, null, MARGIN, MARGIN,
  107.                          (cx-2*MARGIN), (cy-2*MARGIN), SWP_NOZORDER)
  108.            end if
  109.  
  110.         case WM_CLOSE
  111.            DestroyWindow(hwnd)
  112.  
  113.         case WM_DESTROY
  114.            PostQuitMessage(0)
  115.                    
  116.         case else
  117.            return DefWindowProc(hwnd, uMsg, wParam, lParam)
  118.  
  119.     end select
  120.    
  121. end function
  122.  
  123. sub CustomPaint(sys *pDat, sys hDC, sys *rcDirt, bool bErase)
  124.     int x, y
  125.     RECT r
  126.     sys hBrush
  127.    
  128.     RECT rcDirty at &rcDirt
  129.     CustomData pData at pDat
  130.    
  131.     ' Note we paint only the cells overlaping with the dirty rectangle.
  132.    for y = (rcDirty.top / CELLSIZE) to (rcDirty.bottom / CELLSIZE)
  133.         for x = (rcDirty.left / CELLSIZE) to (rcDirty.right / CELLSIZE)
  134.             if mod((x+y),2)=0 then hBrush=pData.hbrLight else hBrush=pData.hbrDark
  135.             SetRect(&r, x * CELLSIZE, y * CELLSIZE, (x+1) * CELLSIZE, (y+1) * CELLSIZE)
  136.             FillRect(hDC, &r, hBrush)
  137.         next x
  138.     next y
  139. end sub
  140.  
  141. sub CustomDoubleBuffer(sys *pDat, sys *pPaintStruc)    
  142.     CustomData pData : &pData = &pDat
  143.     PAINTSTRUCT pPaintStruct : &pPaintStruct = &pPaintStruc
  144.  
  145.     int cx = pPaintStruct.rcPaint.right - pPaintStruct.rcPaint.left
  146.     int cy = pPaintStruct.rcPaint.bottom - pPaintStruct.rcPaint.top
  147.  
  148.     sys hMemDC
  149.     sys hBmp
  150.     sys hOldBmp
  151.     POINT ptOldOrigin
  152.  
  153.  
  154.     ' Create new bitmap-back device context, large as the dirty rectangle.
  155.    hMemDC = CreateCompatibleDC(pPaintStruct.hdc)
  156.     hBmp = CreateCompatibleBitmap(pPaintStruct.hdc, cx, cy)
  157.     hOldBmp = SelectObject(hMemDC, hBmp)
  158.  
  159.     ' Do the painting into the memory bitmap.
  160.    OffsetViewportOrgEx(hMemDC, -(pPaintStruct.rcPaint.left),
  161.                         -(pPaintStruct.rcPaint.top), &ptOldOrigin)
  162.     CustomPaint(&pData, hMemDC, &pPaintStruct.rcPaint, true)
  163.     SetViewportOrgEx(hMemDC, ptOldOrigin.x, ptOldOrigin.y, null)
  164.  
  165.     ' Blit the bitmap into the screen. This is really fast operation and altough
  166.    ' the CustomPaint() can be complex and slow there will be no flicker any more.
  167.    BitBlt(pPaintStruct.hdc, pPaintStruct.rcPaint.left, pPaintStruct.rcPaint.top,
  168.            cx, cy, hMemDC, 0, 0, SRCCOPY)
  169.  
  170.     ' Clean up.
  171.    SelectObject(hMemDC, hOldBmp)
  172.     DeleteObject(hBmp)
  173.     DeleteDC(hMemDC)
  174. end sub
  175.  
  176. function CustomProc(sys hwnd, uint uMsg, sys wParam, lParam) as sys callback
  177.  
  178.     CustomData *pData               'Pointer to CustomData structure
  179.  
  180.     if uMsg != WM_CREATE then
  181.        &pData=GetWindowLongPtr(hwnd, 0)
  182.     end if
  183.  
  184.     select case uMsg
  185.         case WM_NCCREATE
  186.             sys pdat=getmemory sizeof(CustomData)
  187.             if pDat then
  188.               SetWindowLongPtr(hwnd, 0, pdat)  'Store the pointer for later use
  189.            else
  190.                 return false
  191.             end if
  192.  
  193.             &pData=pdat                        'address of pData stucture
  194.  
  195.             pData.hwnd = hwnd
  196.  
  197.             CREATESTRUCT cstr at lParam
  198.             pData.style=cstr.style
  199.            
  200.             pData.hbrDark = CreateSolidBrush(DARKCOLOR)
  201.             pData.hbrLight = CreateSolidBrush(LIGHTCOLOR)            
  202.             return true
  203.  
  204.         case WM_ERASEBKGND
  205.             return false  ' Defer erasing into WM_PAINT
  206.  
  207.         case WM_PAINT
  208.             PAINTSTRUCT ps
  209.             BeginPaint(hwnd, &ps)
  210.            
  211.             ' We let application to choose whether to use double buffering or not by using the style XXS_DOUBLEBUFFER.
  212.            if(pData.style and XXS_DOUBLEBUFFER) then                        
  213.                 CustomDoubleBuffer(&pData, &ps)
  214.             else          
  215.                 CustomPaint(&pData, ps.hdc, &ps.rcPaint, ps.fErase)
  216.             end if
  217.             EndPaint(hwnd, &ps)
  218.             return 0
  219.  
  220.         case WM_PRINTCLIENT
  221.             RECT rc
  222.             GetClientRect(hwnd, &rc)
  223.             CustomPaint(&pData, wParam, &rc, true)
  224.             return 0
  225.  
  226.         case WM_STYLECHANGED
  227.             if wParam = GWL_STYLE then                      
  228.                 pData.style = lParam
  229.             end if
  230.             break
  231.  
  232.         case WM_NCDESTROY      
  233.             if &pData then
  234.                 DeleteObject(pData.hbrDark)
  235.                 DeleteObject(pData.hbrLight)
  236.                 freememory(&pData)
  237.             end if
  238.             CustomUnregister()
  239.             return 0
  240.  
  241.     end select
  242.    
  243.     return DefWindowProc(hwnd, uMsg, wParam, lParam)
  244. end function
  245.  
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 14, 2018, 04:01:06 AM
That should be useful:
l demonstrating double buffering
to see how work with resizing without flickering...

Arnold
Is there any flickering in this example because i cannot compile this program  ::)
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on November 14, 2018, 04:13:43 AM
Hi Aurel,

there is no flickering. But I do not understand why you insist to use version A43. This is like using Windows 95 with an app for Windows 10.

Roland
Title: Re: Custom Controls in OxygenBasic
Post by: Aurel on November 14, 2018, 04:47:39 AM
Quote
But I do not understand why you insist to use version A43

Hi Arnold

It is simple why i 'insist'...
there are lot of changes and then i must fix every changes in my programs
and that is why i hate to do that it becomes like nightmare to me
every time something not work or not work properly....
sorry but i must say that I am not happy about that . >:(
Title: Re: Custom Controls in OxygenBasic
Post by: Arnold on June 23, 2019, 01:51:26 AM
Hi Charles,

with the new release you dropped the notation like:

as zstring * 64

http://www.jose.it-berater.org/smfforum/index.php?topic=5474.msg23928#msg23928

this is not a real problem, but probably has some impact with some files in the latest Oxygenbasic distribution. At the moment I had to modify in Pgbar3d.inc in folder \examples\WinDynDialogs the type in about line 30:

Code: [Select]
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
  txtBkg[255] AS ASCIIZ        'text to be painted on background, increase/decrease size to suit your needs
  txtBar[255] AS ASCIIZ       '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

I need to check some other files if they contain a notation similar to this one.

Roland

Title: Re: Custom Controls in OxygenBasic
Post by: Charles Pegge on June 23, 2019, 05:57:06 AM
Got it. I can't see any more.