• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

Source Code --- Date Picker modified from Roland's program

Started by Chris Chancellor, October 30, 2018, 07:43:05 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Chris Chancellor

Hello All

this is a Date Picker program which i had modified from Roland's program located at
https://www.oxygenbasic.org/forum/index.php?topic=1754.msg19508;topicseen#msg19508

i have also modified the include file for this  WinutilMod.inc so that users can change the Main window title
and its background color using variables  MainWindTitle and MainWindBGColor

Thanxx to Charles and Roland


the DatePicker.o2bas


' DatePick and MonthCalendar in TabPages
' DatePicker.o2bas
' https://www.oxygenbasic.org/forum/index.php?topic=1754.msg19508;topicseen#msg19508

$ filename = "DatePicker.exe"

uses rtl64


' Use a modified version of WinUtil.inc
uses winutilMod

' additional items
% COLOR_MENU=4
% DTN_DATETIMECHANGE= -759
% DTS_SHOWNONE=2
% DTS_LONGDATEFORMAT=4
% MCN_SELECT= -746
% MCN_SELCHANGE= -749
% TCIF_TEXT=1
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE=  dword -551      'Win64
% TCN_SELCHANGING=  dword -552    'Win64
% TCN_FIRST= dword -550           'Win64
% TCN_LAST= dword -580            'Win64
% TCS_TABS=0
% TCS_SINGLELINE=0
% TCS_FOCUSONBUTTONDOWN=4096

type TCITEM
  int   mask,dwState,dwStateMask
  char* pszText
  int   cchTextMax,iImage
  sys   lParam
end type
typedef TCITEM TC_ITEM

def varptr @ %1
def codeptr @ %1

' Identifiers
%IDTAB_MAIN       = 100
%IDTAB_PAGE_1     = 101
%IDTAB_PAGE_2     = 102
%ID_Exit          = 103

%ID_Datetime      = 1000
%ID_Monthcalendar = 1001


DECLARE FUNCTION CreateMainTabControl(BYVAL hWnd AS LONG) AS LONG
DECLARE SUB CreateTabPage1(BYVAL hTab AS LONG)
DECLARE SUB CreateTabPage2(BYVAL hTab AS LONG)
DECLARE FUNCTION OnEventTabPage1(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION OnEventTabPage2(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG


INITCOMMONCONTROLSEXt icce
'Load the common controls library...
icce.dwSize = sizeof(INITCOMMONCONTROLSEXt)
icce.dwICC = 0xffff
InitCommonControlsEx(&icce)

char* cmdline
@cmdline=GetCommandLine()
sys hInstance = GetModuleHandle(null)

indexbase 0
sys g_hTab[1]  '2 TabPages







' Display the main window to cover the 2 tabs
' Note that MainWindow function is located in the WinUtilMod.inc
  MainWindTitle = "Date Picker"
' for Green background for main window
  MainWindBGColor = 3

  MainWindow  395,320, WS_OVERLAPPEDWINDOW





'-------------------------------------------------
FUNCTION WndProc(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG callback

    LOCAL PageNo AS LONG, hButton AS LONG
    NMHDR *ptnmhdr
    WNDCLASSEX wcx
    sys hDC

    SELECT CASE (wMsg)

        CASE %WM_CREATE
           'Register the Tab page holder windows...
           string szClassName  = "TabPageChild"
           wcx.cbSize        = sizeof(WNDCLASSEX)
           wcx.lpfnWndProc   = @TabPageProc
           wcx.hInstance     = hInstance
           wcx.hbrBackground =   COLOR_MENU +1
           wcx.lpszClassName = strptr szClassName
           if RegisterClassEx(&wcx) = 0 then mbox "Cannot register TabPage Window"

           hButton = CreateWindowEx(0, "BUTTON", "Exit",%WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR
                                                        %WS_VISIBLE OR %BS_PUSHBUTTON,
                                    111,240,80,30,
                                    hWnd, %ID_Exit, hInst, BYVAL %NULL)

           CALL CreateMainTabControl(hWnd)           
           CALL SetFocus(GetDlgItem(hWnd,%ID_Exit))

        CASE %WM_COMMAND
            SELECT CASE LOWORD(wParam)
                CASE %ID_Exit
                    IF HIWORD(wParam) = %BN_CLICKED THEN
                        CALL SendMessage(hWnd,%WM_CLOSE,0,0)
                    END IF
            END SELECT

        CASE %WM_NOTIFY
            @ptnmhdr = lParam



'This does work
            if ptnmhdr.code >= %TCN_LAST and ptnmhdr.code <= %TCN_FIRST then
                SELECT CASE ptnmhdr.idFrom
                  CASE %IDTAB_MAIN
                    if ptnmhdr.code = TCN_SELCHANGING then
                   
                        PageNo =SendMessage(GetDlgItem(hWnd,%IDTAB_MAIN),%TCM_GETCURSEL,0,0)
                        CALL ShowWindow(g_hTab(PageNo),%SW_HIDE)
                    elseif ptnmhdr.code = TCN_SELCHANGE then
                   
                        PageNo = SendMessage(GetDlgItem(hWnd,%IDTAB_MAIN),%TCM_GETCURSEL,0,0)
                        CALL ShowWindow(g_hTab(PageNo),%SW_SHOW)
                    end if
                END SELECT
            end if



     ' added to display background color for the main window
     CASE %WM_ERASEBKGND     
          hDC = wParam
  '       Pass the DC of the region to repaint
          DrawGradient hDC           
          FUNCTION = 1
          EXIT FUNCTION





        CASE %WM_CLOSE
            CALL SendMessage(hWnd,%WM_DESTROY,0,0)

        CASE %WM_DESTROY
            CALL PostQuitMessage(0)

    END SELECT
        FUNCTION = DefWindowProc(hWnd,wMsg,wParam,lParam)
END FUNCTION



'------------------------------------------------------------------------------
FUNCTION CreateMainTabControl(BYVAL hWnd AS LONG) AS LONG

    LOCAL hMainTab AS LONG,i AS LONG
    LOCAL Style AS DWORD,StyleEx AS DWORD,ttc_item AS TC_ITEM
    LOCAL szItem AS ASCIIZ*255

    Style = %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _
            %TCS_TABS OR %TCS_SINGLELINE OR %TCS_FOCUSONBUTTONDOWN
    StyleEx = 0

    'Create tab control
    hMainTab = CreateWindowEx(StyleEx,"SysTabControl32","",Style, _
                              6,6,368,235,
                              hWnd,%IDTAB_MAIN,hInst,BYVAL %NULL)
    if hMainTab=0 then mbox "Cannot CreateWindowEx hMainTab"

    'Insert tabs
    DIM sText(1) AS STRING
    sText(0) = "Date1"
    sText(1) = "Date2"

    FOR i = 0 TO 1
        szItem              = sText(i)
        ttc_item.mask       = %TCIF_TEXT
        ttc_item.pszText    = VARPTR(szItem)
        ttc_item.cchTextMax = LEN(szItem)
        ttc_item.iImage     = -1
        ttc_item.lParam     = 0
        SendMessage hMainTab,%TCM_INSERTITEM,i,VARPTR(ttc_item)
    NEXT

    'Create the individual Tab Pages
    Style   = %WS_CHILD
    StyleEx = %WS_EX_CONTROLPARENT

    FOR i = 0 TO 1
        g_hTab(i) = CreateWindowEx(StyleEx,"TabPageChild","",Style, _
                                   20,44,348,192,
                                   hWnd,%IDTAB_PAGE_1+i,hInst,BYVAL %NULL)
    NEXT

    'Show Tab 1 as the default page
    ShowWindow g_hTab(0), %SW_SHOW

    FUNCTION = hMainTab
END FUNCTION



'------------------------------------------------------------------------------
FUNCTION TabPageProc(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG callback

    LOCAL TabPageID AS INTEGER
    TabPageID = GetDlgCtrlID(hWnd)

    SELECT CASE (wMsg)

        CASE %WM_CREATE
            SELECT CASE (TabPageID)
                CASE %IDTAB_PAGE_1  : CALL CreateTabPage1(hWnd)
                CASE %IDTAB_PAGE_2  : CALL CreateTabPage2(hWnd)
            END SELECT

        CASE %WM_COMMAND, %WM_NOTIFY, %WM_HSCROLL, %WM_VSCROLL
            SELECT CASE (TabPageID)
                CASE %IDTAB_PAGE_1  : CALL OnEventTabPage1(hWnd,wMsg,wParam,lParam)
                CASE %IDTAB_PAGE_2  : CALL OnEventTabPage2(hWnd,wMsg,wParam,lParam)
            END SELECT

    END SELECT

    FUNCTION = DefWindowProc(hWnd,wMsg,wParam,lParam)
END FUNCTION



'------------------------------------------------------------------------------
FUNCTION OnEventTabPage1(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG

    NMHDR ptnmhdr at lParam

    SELECT CASE (wMsg)

        CASE %WM_NOTIFY
            SELECT CASE ptnmhdr.idFrom
                CASE %ID_Datetime     
                    SELECT CASE ptnmhdr.code
                        CASE %DTN_DATETIMECHANGE
                     
                    END SELECT
            END SELECT

    END SELECT
END FUNCTION



'------------------------------------------------------------------------------
FUNCTION OnEventTabPage2(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG

    NMHDR ptnmhdr at lParam

    SELECT CASE (wMsg)

        CASE %WM_NOTIFY
            SELECT CASE ptnmhdr.idFrom
                CASE  %ID_Monthcalendar   
                 'Month/Calendar 
                    SELECT CASE ptnmhdr.code

                        CASE %MCN_SELECT
                       
                        CASE %MCN_SELCHANGE

                    END SELECT
            END SELECT

    END SELECT
END FUNCTION


'------------------------------------------------------------------------------
' Create the Tab page 1
SUB CreateTabPage1(BYVAL hTab AS LONG)

    LOCAL hCtl AS LONG
    LOCAL Style AS DWORD,StyleEx AS DWORD,lflags AS DWORD
    LOCAL sText AS STRING

    '---
    Style   = %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR _
              %WS_VISIBLE OR %DTS_LONGDATEFORMAT OR %DTS_SHOWNONE
    StyleEx = %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR

    hCtl = CreateWindowEx(StyleEx, "SysDateTimePick32", "DateTime",Style, _
                          40,48,200,26, _
                          hTab, %ID_Datetime, hInst, BYVAL %NULL)

END SUB


'------------------------------------------------------------------------------
' Create the Tab page 2
SUB CreateTabPage2(BYVAL hTab AS LONG)

    LOCAL hCtl AS LONG
    LOCAL Style AS DWORD,StyleEx AS DWORD,lflags AS DWORD
    LOCAL sText AS STRING

    Style   = %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR %WS_VISIBLE
    StyleEx = %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR

    hCtl = CreateWindowEx(StyleEx, "SysMonthCal32", "MonthCalender",Style, _
                          48,8,232,184, _
                          hTab, %ID_Monthcalendar, hInst, BYVAL %NULL)

END SUB




the WinUtilMod.inc file

  '14:53 23/09/2017
  '22:50 10/03/2018

'  Modified to display the main window Title MainWindTitle
'  with a color background



  uses corewin
  '
  #ifdef FileDialogs
    uses FileDialog
  #endif
  '
  /*
  https://msdn.microsoft.com/en-us/library/windows/desktop/ms724947(v=vs.85).aspx

  BOOL WINAPI SystemParametersInfo(
  _In_    UINT  uiAction,
  _In_    UINT  uiParam,
  _Inout_ PVOID pvParam,
  _In_    UINT  fWinIni
  );

  'uiAction
  % SPI_GETWORKAREA     0x0030
  'fWinIni
  % SPIF_UPDATEINIFILE  0x01
  % SPIF_SENDCHANGE     0x02

 
  */

  int hpos,vpos,WaWidth,WaHeight
  int spinfo[4]
  scope
    SystemParametersInfo 0x0030,0,@spinfo,0
    indexbase 1
    WaWidth=spinfo[3]
    WaHeight=spinfo[4]
  end scope

  'not used
  'hpos=CW_USEDEFAULT
  'vpos=CW_USEDEFAULT

 
  '
  'SHARED STATE SERVER SIDE
  '------------------------
  '
  sys bu[0x400] 'STATIC BUFFER TO HOLD STATE VARIABLES
  'function guistate() as sys export = @bu
  sys guistate() export {#noinit : return @bu}
  '
  '--------------------------------------
  'INCLUDE ON BOTH SERVER AND CLIENT SIDE
  '--------------------------------------
  sys b
  b = guistate()
  bind b {
  sys     hWndMain,hInst,hDC,hRC,inst
  int     pixelform
  int     mposx,mposy,sposx,sposy,eposx,eposy,iposx,iposy
  int     mmove,bleft,bmid,bright,bwheel
  int     pause
  int     bkey,keyd,lastkey,lastchar
  int running
  int     key[256]
  }
  '--------------------------------------

  #undef b 'MAKE INVISIBLE
  #undef bu 'MAKE INVISIBLE

  int    isRegistered
  int    running=1
  int    minCreate, RebuildWindow
  RECT   crect
  string cr=chr(13)+chr(10), tab=chr(9), qu=chr(34)

  #ifndef width
    int width=640
    int height=480
  #endif


'  Added Oct 30 2018
' Title for the main window
   string MainWindTitle
' Background color for main window
   int MainWindBGColor

'===============================  Added Oct 30 2018
' for displaying the RGB colors
Function RGB(sys red,green,blue) as sys
  sys color
  color = red
  color = color + green*256
  color = color + blue*65536
  Return color
End Function



'======================================== Added Oct 30 2018
' draws with color gradient
SUB DrawGradient (BYVAL hDC AS DWORD)
   LOCAL rectFill AS RECT, rectClient AS RECT, fStep AS SINGLE
   local hBrush AS DWORD, lOnBand AS LONG
   GetClientRect WindowFromDC(hDC), rectClient
   fStep = rectClient.bottom / 75

   FOR lOnBand = 0 TO 50 ' 199
      SetRect rectFill, 0, lOnBand * fStep, rectClient.right + 1, (lOnBand + 1) * fStep
      ' paint the background -- change the first 2 colors R and G
      ' to vary the color gradient

    Select case MainWindBGColor
      Case 1
      ' this gives a light yellow background
       hBrush = CreateSolidBrush(rgb(255, 255, 205 - lOnBand))
      Case 2
     ' this gives a cyan background
       hBrush = CreateSolidBrush(rgb(0, 248, 255 - lOnBand))
      Case 3
      ' this gives a light green background
        hBrush = CreateSolidBrush(rgb(155, 250, 147 - lOnBand))
    End Select

      Fillrect hDC, rectFill, hBrush
      DeleteObject hBrush
   NEXT

END SUB





  macro CreateMainWindow
  ======================
  hwnd = CreateWindowEx(
    0,                  'extended styles           
    "wins",             'class name                   
    MainWindTitle,      'window name 
    style,              '               
    hpos,               'horizontal position 
    vpos,               'vertical position   
    width,              'width               
    height,             'height               
    null,               'no parent or owner window   
    null,               'class menu used             
    hInst,               'instance handle             
    null);              'no window creation data
  if not hWnd then
    MessageBox 0,"Unable to create window","problem",MB_ICONERROR
    exit function
  end if
  end macro
  '
  #ifdef OpenGL
    uses glWinUtil
  #endif 'Opengl
  '
  '
  macro LogMousePos
  =================
  mposx=LoWord[lparam]
  mposy=HiWord[lparam]
  sPosX=mPosX : sPosY=mPosy
  iPosX=mPosX : iPosY=mPosy
  'GetCursorPos @mp
  'sp=mp
  act=1
  end macro

  macro MouseMessages
  ===================
  case WM_MOUSEMOVE
    mposx=LoWord(lparam)
    mposy=HiWord(lparam)
    mmove=1
    if act=0 then act=1
    static POINT sp,mp
    'if bleft
    '  'adjust window position
    '  scope
    '  POINT q 'MOUSE POSITION ON SCREEN
    '  RECT  r 'WINDOW RECT ON SCREEN
    '  int   w,h
    '  GetWindowRect hwnd,@r
    '  GetCursorPos @mp
    '  w=r.right-r.left
    '  h=r.bottom-r.top
    '  if mposy<32 'MOUSE POSITION IN CLIENT AREA
    '    if mposx>w*.75 'stretch right
    '      w=w+mp.x-sp.x
    '      h=h-mp.y+sp.y
    '      q.y=q.y+mp.y-sp.y
    '    elseif mposx<32 'menu?
    '    else 'move
    '      q.x=mp.x-sp.x
    '      q.y=mp.y-sp.y
    '    end if
    '    moveWindow hwnd,r.left+q.x,r.top+q.y,w,h,1
    '    sp=mp
    '  end if
    '  end scope
    'end if
  case WM_LBUTTONDOWN : bleft=1  : LogMousePos
  case WM_LBUTTONUP   : bleft=0  : eposx=mposx
  case WM_RBUTTONDOWN : bright=1 : LogMousePos
  case WM_RBUTTONUP   : bright=0 : eposx=mposx
  case WM_MBUTTONDOWN : bMid=1   : LogMousePos
  case WM_MBUTTONUP   : bMid=0   : eposx=mposx
  case WM_MOUSEWHEEL  : bWheel=wParam : sar bWheel,16
  end macro


  macro KeyboardMessages
  ======================
  case WM_CHAR    : lastchar=wparam
  case WM_KEYUP   : key[wparam]=0 : keyd=0 : if wparam>30 then bkey=0
  case WM_KEYDOWN
    wparam and= 255
    select case wparam
    keydown 'macro intercept
    'DEFAULT CASES
    case 27 : SendMessage hwnd, WM_CLOSE, 0, 0
    case 32 : if key[32]=0 then pause=1-pause 'toggle
    end select
    key[wparam]=1
    lastkey=wparam
    bkey=lastkey
    keyd=lastkey
    #ifdef opengl
    act=1
    #endif
  end macro


  'MICROSECOND TIMER
  ==================
  '
  macro TimeMark(c)
  =================
  QueryPerformanceCounter @c
  end macro
  '
  function TimeDiff(quad *te,*ts) as double
  =========================================
  static quad freq
  QueryPerformanceFrequency @freq
  return (te-ts)/freq 'SECONDS
  end function
  '

  function AppExePath(optional sys n) as char*
  ==============================
  static byte b[512]
  sys i=GetModuleFileName(GetModuleHandle(0), @b, 512)
  while b[i] != 0x5c '92 '\'
    i--
  wend
  if not n then i++ 'include the '\' by default
  b[i]=0
  = @b 'low level
  return
  end function


  function GetClientWHXY(sys hWnd, *w,*h,*x,*y)
  =============================================
  RECT  rc
  POINT pt
  GetClientRect(hwnd, @rc)
  GetCursorPos @pt
  w=rc.right*.25
  h=rc.bottom
  ScreenToClient hWnd,@pt
  x=pt.x
  y=pt.y
  end function


  function GetDropFiles(sys hDropParam) As string
  ===============================================
  string sDropFiles, sFile
  sys i,e,le
  e=DragQueryFile(hDropParam, -1, null, 0)-1
  '
  for i = 0 To e
    le=DragQueryFile(hDropParam, i, null, 1)
    sfile=space le             
    DragQueryFile(hDropParam, i, StrPtr sFile, le+1)
    If Ucase(mid(sFile, -4)) = ".LNK"
    else
      sDropFiles+= sFile + chr(13,10)
    end if
  next i   
  return sDropFiles
  end function


  /*

  =====
  NOTES
  =====

  STANDARD CHILD WINDOWS STYLES
  '
  Button    The class for a button.
  ComboBox  The class for a combo box.
  Edit      The class for an edit control.
  ListBox   The class for a list box.
  MDIClient The class for an MDI client window.
  ScrollBar The class for a scroll bar.
  Static    The class for a static control.




  BOOL WINAPI CreateProcess(
  1  __in_opt     LPCTSTR lpApplicationName,
  2  __inout_opt  LPTSTR lpCommandLine,
  3  __in_opt     LPSECURITY_ATTRIBUTES lpProcessAttributes,
  4  __in_opt     LPSECURITY_ATTRIBUTES lpThreadAttributes,
  5  __in         BOOL bInheritHandles,
  6  __in         DWORD dwCreationFlags,
  7  __in_opt     LPVOID lpEnvironment,
  8  __in_opt     LPCTSTR lpCurrentDirectory,
  9  __in         LPSTARTUPINFO lpStartupInfo,
  10 __out        LPPROCESS_INFORMATION lpProcessInformation
  );

  */

  '
  '
  Function MainWindow
  ===================
  (
   int widthp=640,
   heightp=480,
   style=WS_OVERLAPPEDWINDOW,
   place=2
  )
  width=widthp
  height=heightp
  select place 'default, left, centre, right
  case 0 : hpos=32 : vpos=32
  case 1 : hpos=0: vpos=0
  case 2 : hpos=(wawidth-width)\2 : vpos=(WaHeight-height-32)\2
           if vpos<0 then vpos=0
  case 3 : hpos=wawidth-width-6 : vpos=0
  end select
  '
  indexbase 0
  sys      a,b,c,hWnd
  WNDCLASSEX wc
  MSG      wm
  'globals hDC, hRC, hInst, minCreate
  '
  hInst=GetModuleHandle 0
  inst=hinst
  'cname="wins"
  '
  if isRegistered then goto nregister
  '
  with wc
    .cbSize        = sizeof WNDCLASSEX                 '
    .style=CS_HREDRAW or CS_VREDRAW
    .lpfnWndProc   = @wndproc
    .cbClsExtra    = 0
    .cbWndExtra    = 0   
    .hInstance     = hInst
    .hIcon         = LoadIcon 0, IDI_APPLICATION
    .hCursor       = LoadCursor 0,IDC_ARROW
    .hbrBackground = GetStockObject WHITE_BRUSH
    .lpszMenuName  = 0
    .lpszClassName = strptr "wins"
    .hIconSm       = null
  end with
  if not RegisterClassEx @wc
    MessageBox 0,"Registration failed","Problem",MB_ICONERROR
    exit function
  end if
  isRegistered=1
  '
  nregister:
  ==========
  '
  CreateMainWindow 'MACRO WITH OPENGL OVERRIDE

  DragAcceptFiles(hwnd, true)
  '
  #ifdef WindowOpacity
    'Set WS_EX_LAYERED on this window
    SetWindowLong(hwnd, GWL_EXSTYLE,
    GetWindowLong(hwnd, GWL_EXSTYLE) | WS_EX_LAYERED)
    SetLayeredWindowAttributes(hwnd, 0, WindowOpacity, LWA_ALPHA);
  #endif
  '
  ShowWindow hWnd,SW_NORMAL
  UpdateWindow hWnd
  hWndMain=hwnd


  '
  'MESSAGE LOOP
  '============
  '
  sys bRet
  '
  #ifdef opengl
    while running 'frame processing loop
    while PeekMessage @wm, 0, 0, 0, PM_REMOVE
  #else
    while bRet := GetMessage @wm, 0, 0, 0
  #endif
  '
  'if bRet == -1 then
  '  'show an error message?
  'else
    #ifdef EscapeKeyEnd
      if wm.message=WM_KEYDOWN
        if wm.wparam=27
          SendMessage hwnd,WM_CLOSE,0,0
        end if 
      end if
    #endif
    '
    #ifdef InMessageLoop
      InMessageLoop ''CUMSTOMISED MESSAGE PROCESSING
    #else
      #ifdef MessageLoopProcesses
        MessageLoopProcesses
      #endif
      TranslateMessage @wm
      DispatchMessage @wm
    #endif
  wend 'GetMessage / PeekMessage
  '
  #ifdef Opengl
    #ifdef ActOpengl
      if not closing then
       ActOpengl 'frame processing
      end if
    #endif
    wend 'running
    running=1 'READY FOR ANOTHER WINDOW
  #endif
  return 0
  end function ' end MainWindow






  sub UnregisterMain()
  ====================
  UnregisterClass "wins",hInst
  isRegistered=0
  end sub




Chris Chancellor

here's the display for the program

please improve on it and let me know how best to improve on this program


Chris Chancellor

Here's the zip file for the program



hope that more programmers can join Oxygenbasic and contribute towards a better
64bit programming language.  O2 is so flexible and capable