PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 ... 11 12 [13] 14 15

Author Topic: CWindow Release Candidate 31  (Read 7288 times)

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #180 on: October 08, 2017, 05:31:24 AM »

I have adapted the COleDateTime and ColeDateTimeSpan classes to FreeBasic.

Reference:
ColeDateTime: https://msdn.microsoft.com/en-us/library/38wh24td.aspx
ColeDateTimeSpan: https://msdn.microsoft.com/en-us/library/xb7yw6f3.aspx

Usage example:

Code: [Select]
'#CONSOLE ON
#define UNICODE
#include once "Afx/COleDateTime.inc"
USING Afx

' // Create an instance of the COleDateTime class
DIM cdt AS COleDateTime = ColeDateTime(2017, 10, 8, 12, 5, 30)   ' // 8 October 2017, 12 hour, 5 minute, and 30 second
print cdt.GetYear, cdt.GetMonth, cdt.GetDay, cdt.GetHour, cdt.GetMinute, cdt.GetSecond
print cdt.GetDayOfWeek, cdt.GetDayOfYear
print cdt.Format

' // Add a time span
DIM ts AS COleDateTimeSpan = COleDateTimeSpan(3, 1, 5, 12)   ' // 3 days, 1 hour, 5 min, and 12 sec
cdt += ts
print cdt.GetDayOfWeek, cdt.GetDayOfYear

' // Display the date
print cdt.Format
print cdt.Format("%A, %B %d, %Y")
   
PRINT
PRINT "Press any key..."
SLEEP
« Last Edit: October 10, 2017, 08:40:11 AM by José Roca »
Logged

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #181 on: October 09, 2017, 11:19:13 AM »

Because the time64 C functions aren't available in msvcrt.dll, wich is limited to 32 bits, limiting the handling of dates from midnight, January 1, 1970, to 23:59:59 January 18, 2038, UTC, I have developed the following replacements:

Code: [Select]
' ========================================================================================
' * Converts a __time64_t (LONGLONG) value to a FILETIME structure.
' ========================================================================================
PRIVATE FUNCTION AfxTime64ToFileTime (BYVAL t64 AS LONGLONG) AS FILETIME
   DIM ft AS FILETIME, uli AS ULARGE_INTEGER
   uli.QuadPart = t64 * 10000000
   ' 10000000 = ticks per second
   ft.dwLowDateTime = uli.LowPart
   ft.dwHighDateTime = uli.HighPart
   RETURN ft
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Converts a FILETIME to a __time64_t (LONGLONG) value.
' ========================================================================================
PRIVATE FUNCTION AfxFileTimeToTime64 (BYREF ft AS FILETIME) AS LONGLONG
   DIM uli AS ULARGE_INTEGER
   uli.LowPart = ft.dwLowDateTime
   uli.HighPart = ft.dwHighDateTime
   DIM t64 AS LONGLONG = uli.QuadPart / 10000000
   ' 10000000 = ticks per second
   RETURN t64
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Converts a system time to a __time64_t.
' ========================================================================================
PRIVATE FUNCTION AfxSystemTimeToTime64 (BYREF st AS SYSTEMTIME) AS LONGLONG
   DIM ft AS FILETIME
   SystemTimeToFileTime(@st, @ft)
   DIM t64 AS LONGLONG = AfxFileTimeToTime64(ft) - 11644473600
   ' 11644473600 = number of days from 1 Jan 1970
   RETURN t64
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Converts a __time64_t (LONGLONG) to a system time.
' ========================================================================================
PRIVATE FUNCTION AfxTime64ToSystemTime (BYVAL t64 AS LONGLONG) AS SYSTEMTIME
   DIM ft AS FILETIME
   t64 += 11644473600
   ft = AfxTime64ToFileTime(t64)
   DIM st AS SYSTEMTIME
   FileTimeToSystemTime(@ft, @st)
   RETURN st
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Converts a __time64_t (LONGLONG) to a GMT time.
' t64 : A __time64_t (LONGLONG) value.  The time is represented as seconds elapsed since
' midnight (00:00:00), January 1, 1970, coordinated universal time (UTC).
' Returns a tm structure. The fields of the returned structure hold the evaluated value of
' the time argument in UTC rather than in local time.
' Note: Replacement for _gmtime64, not available in msvcrt.dll.
' The fields of the structure type tm store the following values, each of which is an int:
' tm_sec : Seconds after minute (0 – 59).
' tm_min : Minutes after hour (0 – 59).
' tm_hour : Hours after midnight (0 – 23).
' tm_mday : Day of month (1 – 31).
' tm_mon : Month (0 – 11; January = 0).
' tm_year : Year (current year minus 1900).
' tm_wday : Day of week (0 – 6; Sunday = 0).
' tm_yday : Day of year (0 – 365; January 1 = 0).
' tm_isdst : Positive value if daylight saving time is in effect; 0 if daylight saving
' time is not in effect; negative value if status of daylight saving time is unknown.
' ========================================================================================
PRIVATE FUNCTION AfxGmtTime64 (BYVAL t64 AS LONGLONG) AS tm
   DIM st AS SYSTEMTIME
   st = AfxTime64ToSystemTime(t64)
   DIM _tm AS tm
   _tm.tm_wday = st.wDayOfWeek
   _tm.tm_min = st.wMinute
   _tm.tm_sec = st.wSecond
   _tm.tm_mon = st.wMonth - 1
   _tm.tm_mday = st.wDay
   _tm.tm_hour = st.wHour
   _tm.tm_year = st.wYear - 1900
   DIM stYear AS SYSTEMTIME
   DIM t64Year AS LONGLONG
   stYear.wYear = st.wYear
   stYear.wMonth = 1
   stYear.wDay = 1
   t64Year = AfxSystemTimeToTime64(stYear)
   _tm.tm_yday = (t64 - t64Year) / 60*60*24   ' 60*60*24 = day in seconds
   _tm.tm_isdst = 0
   RETURN _tm
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Returns a UTC time as a local time.
' Convert a time value and correct for the local time zone.
' Note: Replacement for _localtime64, not available in msvcrt.dll.
' The fields of the structure type tm store the following values, each of which is an int:
' tm_sec : Seconds after minute (0 – 59).
' tm_min : Minutes after hour (0 – 59).
' tm_hour : Hours after midnight (0 – 23).
' tm_mday : Day of month (1 – 31).
' tm_mon : Month (0 – 11; January = 0).
' tm_year : Year (current year minus 1900).
' tm_wday : Day of week (0 – 6; Sunday = 0).
' tm_yday : Day of year (0 – 365; January 1 = 0).
' tm_isdst : Positive value if daylight saving time is in effect; 0 if daylight saving
' time is not in effect; negative value if status of daylight saving time is unknown.
' ========================================================================================
PRIVATE FUNCTION AfxGetLocalTime64 (BYVAL t64 AS LONGLONG) AS tm
   DIM AS FILETIME ft, ftLocal
   ft = AfxTime64ToFileTime(t64)
   FileTimeToLocalFiletime(@ft, @ftLocal)
   t64 = AfxFileTimeToTime64(ftLocal)
   DIM _tm AS tm = AfxGmtTime64(t64)
   DIM tzi AS TIME_ZONE_INFORMATION
   SELECT CASE GetTimeZoneInformation(@tzi)
      CASE TIME_ZONE_ID_DAYLIGHT : _tm.tm_isdst = 1
      CASE TIME_ZONE_ID_STANDARD : _tm.tm_isdst = 0
      CASE TIME_ZONE_ID_UNKNOWN  : _tm.tm_isdst = -1
   END SELECT
   RETURN _tm
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Converts the local time to a calendar value.
' Note: Replacemenet for _mktime64, not available in msvcrt.dll.
' ========================================================================================
PRIVATE FUNCTION AfxMakeTime64 (BYREF _tm AS tm) AS LONGLONG
   
   ' // Fills a SYSTEMTIME structure
   DIM st AS SYSTEMTIME
   st.wDay = _tm.tm_mday
   st.wDayOfWeek = _tm.tm_wday
   st.wHour = _tm.tm_hour
   st.wMinute = _tm.tm_min
   st.wMonth = _tm.tm_mon + 1
   st.wSecond = _tm.tm_sec
   st.wYear = _tm.tm_year + 1900
   st.wMilliseconds = 0
  ' // Daylight savings
   DIM tzi AS TIME_ZONE_INFORMATION
   DIM r AS DWORD = GetTimeZoneInformation(@tzi)
   IF r <> TIME_ZONE_ID_INVALID THEN
      DIM stOut AS SYSTEMTIME
      IF _tm.tm_isdst = 1 THEN
         ' // Converts a local time to a time in Coordinated Universal Time (UTC).
         IF TzSpecificLocalTimeToSystemTime(@tzi, @st, @stOut) THEN st = stOut
      END IF
   END IF
   DIM t64 AS LONGLONG = AfxSystemTimeToTime64(st)
   IF _tm.tm_isdst = 0 THEN
      DIM ft AS FILETIME = AfxTime64ToFileTime(t64)
      DIM ft2 AS FILETIME
      ' // Converts a local file time to a file time based on the Coordinated Universal Time (UTC).
      LocalFileTimeToFileTime(@ft, @ft2)
      t64 = AfxFileTimeToTime64(ft2)
   END IF
   RETURN t64
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Returns the system time as a __time64_t (LONGLONG) value.
' Returns the time as seconds elapsed since midnight, January 1, 1970.
' Note: Replacement for _time64, not available in msvcrt.dll.
' ========================================================================================
PRIVATE FUNCTION AfxTime64 () AS LONGLONG
   DIM t64 AS LONGLONG
   DIM st AS SYSTEMTIME
   GetSystemTime(@st)
   RETURN AfxSystemTimeToTime64(st)
END FUNCTION
' ========================================================================================
« Last Edit: October 09, 2017, 11:52:25 AM by José Roca »
Logged

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #182 on: October 10, 2017, 12:08:00 PM »

This update includes new wrappers in AfxTime.inc as well as new classes: CTime64, CTimeSpan, COleDateTime, COleDateTimeSpan, CFileTime and CFileTimeSpan.

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #183 on: October 11, 2017, 01:08:49 PM »

I finally have found the bug that caused problems with the OpenGL support. I was using a wrong variable, m_hDC instead of hDC. Now OpenGL support works very well.

I did check the failing code dozens of times, and until now I have been unable to find that subtle bug. I could not understand why the same code (less the bug) was working with PowerBasic and failed with FreeBasic.
« Last Edit: October 11, 2017, 01:12:14 PM by José Roca »
Logged

Paul Squires

  • Administrator
  • Master FireFly Member
  • *****
  • Posts: 8118
  • Windows 10
    • PlanetSquires Software
Re: CWindow Release Candidate 31
« Reply #184 on: October 11, 2017, 08:17:07 PM »

Thanks José! Awesome work as always. I haven't done a line of code in over two weeks! Real life is just too busy. I will jump back into it as soon as possible.
Logged
Paul Squires
PlanetSquires Software
FireFly Visual Designer, WinFBE Editor

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #185 on: October 12, 2017, 04:26:11 PM »

Yet another class, CIniFile, to easily work with .ini files.
13 October 2017: Modified the constructor.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CIniFile.inc
' Contents: Class to work with Windows .ini files
' Compiler: FreeBasic 32 & 64-bit
' Copyright (c) 2017 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#pragma once
#include once "windows.bi"
#include once "crt/stdio.bi"
#include once "Afx/CSafeArray.inc"
#include once "Afx/CDicObj.inc"
USING Afx

NAMESPACE Afx

' ########################################################################################
' CIniFile class.
' ########################################################################################
TYPE CIniFile

   m_Path AS WSTRING * MAX_PATH   ' // Full path of the .ini file

   DECLARE CONSTRUCTOR (BYREF wszFileName AS WSTRING)
   DECLARE DESTRUCTOR
   DECLARE FUNCTION GetPath () AS CWSTR
   DECLARE FUNCTION WriteValue (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF wszValue AS WSTRING) AS BOOLEAN
   DECLARE FUNCTION WriteValue (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF dblValue AS DOUBLE) AS BOOLEAN
   DECLARE FUNCTION WriteValue (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF intValue AS LONG) AS BOOLEAN
   DECLARE FUNCTION DeleteKey (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING) AS BOOLEAN
   DECLARE FUNCTION DeleteSection (BYREF wszSectionName AS WSTRING) AS BOOLEAN
   DECLARE FUNCTION GetString (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF wszDefaultValue AS WSTRING = "") AS CWSTR
   DECLARE FUNCTION GetDouble (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYVAL nDefaultValue AS DOUBLE = 0) AS DOUBLE
   DECLARE FUNCTION GetInt (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYVAL nDefaultValue AS LONG = 0) AS LONG
   DECLARE FUNCTION GetSectionNames () AS CSafeARray
   DECLARE FUNCTION GetKeyNames (BYREF wszSectionName AS WSTRING) AS CSafeARray
   DECLARE FUNCTION GetSectionValues (BYREF wszSectionName AS WSTRING, BYREF pDic AS CDicObj) AS BOOLEAN

END TYPE

' ========================================================================================
' Default constructor
' Initializes a new instance of the CIniFile class.
' - wszFileName: The ini file to read and write from.
' ========================================================================================
PRIVATE CONSTRUCTOR CIniFile (BYREF wszFileName AS WSTRING)
   ' // Convert to the full path. Because of backward compatibility,
   ' // the win32 functions tend to assume the path should be the
   ' // root Windows directory if it is not specified. By calling
   ' // GetFullPath, we make sure we are always passing the full path
   ' // the win32 functions.
   DIM nLen AS LONG, buffer AS WSTRING * 4096
   nLen = .GetFullPathNameW(wszFileName, SIZEOF(buffer) \ 2, buffer, NULL)
   IF nLen THEN m_Path = LEFT(buffer, nLen)
   ' // Even if we use WritePrivateProfileStringW, it will only write unicode text if the
   ' // file has been created using UTF 16 little endian. The solution is to create the
   ' // ini-file with the encoding UTF-16LE before writing an unicode string to it.
   ' // Make sure the file does not already exist
   IF AfxFileExists(m_Path) = FALSE THEN
      ' // create file with encoding UTF-16LE
      DIM fileHandle AS FILE PTR
      DIM wszMode AS WSTRING * 260 = "w, ccs=UTF-16LE"
      fileHandle = _wfopen(@m_Path, @wszMode)
      IF fileHandle THEN fclose(fileHandle)
   END IF
END CONSTRUCTOR
' ========================================================================================
 
' ========================================================================================
' Destructor
' ========================================================================================
PRIVATE DESTRUCTOR CIniFile
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Returns the full path of ini file this object instance is operating on.
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetPath () AS CWSTR
   RETURN m_Path
END FUNCTION
' ========================================================================================

' ========================================================================================
' Copies a value into the specified section of an initialization file.
' - wszSectionName: Name of the section
' - wszKeyName: Name of key
' - wszValue / dblValue / intValue: The value to write
' ========================================================================================
PRIVATE FUNCTION CIniFile.WriteValue (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF wszValue AS WSTRING) AS BOOLEAN
   RETURN WritePrivateProfileStringW(wszSectionName, wszKeyName, wszValue, m_path)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION CIniFile.WriteValue (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF dblValue AS DOUBLE) AS BOOLEAN
   RETURN WritePrivateProfileStringW(wszSectionName, wszKeyName, WSTR(dblValue), m_path)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION CIniFile.WriteValue (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF intValue AS LONG) AS BOOLEAN
   RETURN WritePrivateProfileStringW(wszSectionName, wszKeyName, WSTR(intValue), m_path)
END FUNCTION
' ========================================================================================

' ========================================================================================
' * Retrieves a string from the specified section in an initialization file.
' - wszSectionName: Name of the section
' - wszKeyName: Name of key
' - wszDefaultValue: A default string. If the key key cannot be found in the initialization
'   file, the default string is returned.
'   Avoid specifying a default string with trailing blank characters. The function inserts
'   a null character in the returned buffer to strip any trailing blanks.
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetString (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYREF wszDefaultValue AS WSTRING = "") AS CWSTR
   DIM wsz AS WSTRING * 32767
   DIM dwLen AS DWORD = GetPrivateProfileStringW(wszSectionName, wszKeyName, wszDefaultValue, @wsz, 32767, m_path)
   RETURN LEFT(wsz, dwLen)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetDouble (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYVAL nDefaultValue AS DOUBLE = 0) AS DOUBLE
   DIM wsz AS WSTRING * 32767
   DIM dwLen AS DWORD = GetPrivateProfileStringW(wszSectionName, wszKeyName, NULL, @wsz, 32767, m_path)
   wsz = LEFT(wsz, dwLen)
   IF VAL(wsz) = 0 THEN RETURN nDefaultValue ELSE RETURN VAL(wsz)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetInt (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING, BYVAL nDefaultValue AS LONG = 0) AS LONG
   RETURN CLNG(GetPrivateProfileInt(wszSectionName, wszKeyName, nDefaultValue, m_path))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Deletes a key from the specified section of an initialization file.
' - wszSectionName: Name of the section
' - wszKeyName: Name of key
' ========================================================================================
PRIVATE FUNCTION CIniFile.DeleteKey (BYREF wszSectionName AS WSTRING, BYREF wszKeyName AS WSTRING) AS BOOLEAN
   RETURN WritePrivateProfileStringW(wszSectionName, wszKeyName, NULL, m_path)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Deletes a section from an initialization file.
' - wszSectionName: Name of the section
' ========================================================================================
PRIVATE FUNCTION CIniFile.DeleteSection (BYREF wszSectionName AS WSTRING) AS BOOLEAN
   RETURN WritePrivateProfileStringW(wszSectionName, NULL, NULL, m_path)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a safe array with the names of all sections in the ini file.
' Example:
' DIM cIni AS CInifile = "Test.ini"
' DIM csa AS CSafeArray = cIni.GetSectionNames
' FOR i AS LONG = csa.LBound TO csa.UBound
'    print csa.GetStr(i)
' NEXT
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetSectionNames () AS CSafeARray
   DIM csa AS CSafeArray = CSafeArray(VT_BSTR, 0, 1)
   DIM wsz AS WSTRING * 32767
   DIM dwLen AS DWORD = GetPrivateProfileSectionNamesW(@wsz, 32767, m_path)
   IF dwLen = 0 THEN RETURN csa
   DIM pwsz AS WSTRING PTR = @wsz
   DO
      IF pwsz = NULL THEN EXIT DO
      csa.AppendStr(pwsz)
      dwLen = LEN(*pwsz)
      IF dwLen = 0 THEN EXIT DO
      pwsz += dwLen + 1
   LOOP
   RETURN csa
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a safe array with the names of all the keys of the specified section.
' Example:
' DIM cIni AS CInifile = "Test.ini"
' DIM csa AS CSafeArray = cIni.GetKeyNames("StARtup")
' FOR i AS LONG = csa.LBound TO csa.UBound
'    print csa.GetStr(i)
' NEXT
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetKeyNames (BYREF wszSectionName AS WSTRING) AS CSafeARray
   DIM csa AS CSafeArray = CSafeArray(VT_BSTR, 0, 1)
   DIM wsz AS WSTRING * 32767
   DIM dwLen AS DWORD = GetPrivateProfileStringW(@wszSectionName, NULL, NULL, @wsz, 32767, m_path)
   IF dwLen = 0 THEN RETURN csa
   DIM pwsz AS WSTRING PTR = @wsz
   DO
      IF pwsz = NULL THEN EXIT DO
      csa.AppendStr(pwsz)
      dwLen = LEN(*pwsz)
      IF dwLen = 0 THEN EXIT DO
      pwsz += dwLen + 1
   LOOP
   RETURN csa
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns the keys and values of the specified section as a dictionary object.
' ========================================================================================
PRIVATE FUNCTION CIniFile.GetSectionValues (BYREF wszSectionName AS WSTRING, BYREF pDic AS CDicObj) AS BOOLEAN
   IF pDic.m_pDictionary = NULL THEN RETURN FALSE
   DIM wsz AS WSTRING * 32767
   DIM dwLen AS DWORD = GetPrivateProfileStringW(@wszSectionName, NULL, NULL, @wsz, 32767, m_path)
   IF dwLen = 0 THEN RETURN FALSE
   DIM cwsKeyName AS CWSTR, cwsValue AS CWSTR
   DIM pwsz AS WSTRING PTR = @wsz
   DO
      IF pwsz = NULL THEN EXIT DO
      cwsKeyName = pwsz
      cwsValue = this.GetString(wszSectionName, cwsKeyName)
      pDic.Add(cwsKeyName, cwsValue)
      dwLen = LEN(*pwsz)
      IF dwLen = 0 THEN EXIT DO
      pwsz += dwLen + 1
   LOOP
   RETURN TRUE
END FUNCTION
' ========================================================================================

END NAMESPACE
« Last Edit: October 12, 2017, 09:34:24 PM by José Roca »
Logged

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #186 on: October 12, 2017, 09:31:57 PM »

Even using WritePrivateProfileStringW, it will only write unicode text if the file has been created using UTF 16 little endian. The solution is to create the ini-file with the encoding UTF-16LE before writing an unicode string to it. Therefore, I have modified the constructor to check if the file does exist or not. If it does not exist, it creates an empty .ini file using UTF-16LE encoding. If the file already exists, WritePrivateProfileStringW will use the encoding used to create the file.

Code: [Select]
' ========================================================================================
' Default constructor
' Initializes a new instance of the CIniFile class.
' - wszFileName: The ini file to read and write from.
' ========================================================================================
PRIVATE CONSTRUCTOR CIniFile (BYREF wszFileName AS WSTRING)
   ' // Convert to the full path. Because of backward compatibility,
   ' // the win32 functions tend to assume the path should be the
   ' // root Windows directory if it is not specified. By calling
   ' // GetFullPath, we make sure we are always passing the full path
   ' // the win32 functions.
   DIM nLen AS LONG, buffer AS WSTRING * 4096
   nLen = .GetFullPathNameW(wszFileName, SIZEOF(buffer) \ 2, buffer, NULL)
   IF nLen THEN m_Path = LEFT(buffer, nLen)
   ' // Even if we use WritePrivateProfileStringW, it will only write unicode text if the
   ' // file has been created using UTF 16 little endian. The solution is to create the
   ' // ini-file with the encoding UTF-16LE before writing an unicode string to it.
   ' // Make sure the file does not already exist
   IF AfxFileExists(m_Path) = FALSE THEN
      ' // create file with encoding UTF-16LE
      DIM fileHandle AS FILE PTR
      DIM wszMode AS WSTRING * 260 = "w, ccs=UTF-16LE"
      fileHandle = _wfopen(@m_Path, @wszMode)
      IF fileHandle THEN fclose(fileHandle)
   END IF
END CONSTRUCTOR
' ========================================================================================
« Last Edit: October 12, 2017, 09:39:36 PM by José Roca »
Logged

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #187 on: October 13, 2017, 04:05:44 PM »

I have added the AfxCGraphCtx function to the graphic control. The attached file contains the updated CGraphCtx.inc file and an OpenGL example that uses it. I also have added a 32 bit version executable of the example just in case somebody is willing to try it with other OSEs. I have tried it with Windows 7.

The control is scrollable by default, but you can choose instead to make it strechable or resizable. In the example, I have made it resizable, and the rendering of the control is very smooth, even when resizing it, thanks to the use of a timer. It is also flicker free, lightweight, DPI aware, works with 32 and 64 bit and supports GDI, GDI+ and OpenGL, and it's free! As we say in Spain: Bueno, bonito y barato.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_OGL_Nehe_05
' Contents: CWindow OpenGL - NeHe lesson 5
' Compiler: FreeBasic 32 & 64 bit
' Translated in 2017 by José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CGraphCtx.inc"
USING Afx

CONST GL_WINDOWWIDTH   = 600               ' Window width
CONST GL_WINDOWHEIGHT  = 400               ' Window height
CONST GL_WindowCaption = "NeHe Lesson 5"   ' Window caption
CONST IDC_GRCTX = 1001

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION GraphCtx_SubclassProc ( _
   BYVAL hwnd   AS HWND, _                 ' // Control window handle
   BYVAL uMsg   AS UINT, _                 ' // Type of message
   BYVAL wParam AS WPARAM, _               ' // First message parameter
   BYVAL lParam AS LPARAM, _               ' // Second message parameter
   BYVAL uIdSubclass AS UINT_PTR, _        ' // The subclass ID
   BYVAL dwRefData AS DWORD_PTR _          ' // Pointer to reference data
   ) AS LRESULT

' =======================================================================================
' OpenGL class
' =======================================================================================
TYPE CTXOGL

   Private:
      m_pGraphCtx AS CGraphCtx PTR
      rtri AS SINGLE
      rquad AS SINGLE

   Public:
      DECLARE CONSTRUCTOR (BYVAL pGraphCtx AS CGraphCtx PTR)
      DECLARE DESTRUCTOR
      DECLARE SUB SetupScene
      DECLARE SUB ResizeScene
      DECLARE SUB RenderScene

END TYPE
' =======================================================================================

' ========================================================================================
' COGL constructor
' ========================================================================================
CONSTRUCTOR CTXOGL (BYVAL pGraphCtx AS CGraphCtx PTR)
   m_pGraphCtx = pGraphCtx
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' COGL Destructor
' ========================================================================================
DESTRUCTOR CTXOGL
END DESTRUCTOR
' ========================================================================================

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB CTXOGL.SetupScene

   ' // Specify clear values for the color buffers
   glClearColor 0.0, 0.0, 0.0, 0.0
   ' // Specify the clear value for the depth buffer
   glClearDepth 1.0
   ' // Specify the value used for depth-buffer comparisons
   glDepthFunc GL_LESS
   ' // Enable depth comparisons and update the depth buffer
   glEnable GL_DEPTH_TEST
   ' // Select smooth shading
   glShadeModel GL_SMOOTH

END SUB
' =======================================================================================

' =======================================================================================
SUB CTXOGL.ResizeScene

   ' // Get the dimensions of the control
   IF m_pGraphCtx = NULL THEN EXIT SUB
   DIM nWidth AS LONG = AfxGetWindowWidth(m_pGraphCtx->hWindow)
   DIM nHeight AS LONG = AfxGetWindowHeight(m_pGraphCtx->hWindow)
   ' // Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' // Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' // Select the projection matrix
   glMatrixMode GL_PROJECTION
   ' // Reset the projection matrix
   glLoadIdentity
   ' // Calculate the aspect ratio of the window
   gluPerspective 45.0, nWidth / nHeight, 0.1, 100.0
   ' // Select the model view matrix
   glMatrixMode GL_MODELVIEW
   ' // Reset the model view matrix
   glLoadIdentity

END SUB
' =======================================================================================

' =======================================================================================
SUB CTXOGL.RenderScene

   ' // Clear the screen buffer
   glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
   ' // Reset the view
   glLoadIdentity

   glTranslatef -1.5, 0.0, -6.0           ' Move left 1.5 units and into the screen
   glRotatef rtri, 0.0, 1.0, 0.0          ' Rotate the triangle on the Y axis

   glBegin GL_TRIANGLES
      ' Front
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Front)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f -1.0, -1.0,  1.0         ' Left of triangle (Front)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f  1.0, -1.0,  1.0         ' Right of triangle (Front)

      ' Right
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Right)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f  1.0, -1.0,  1.0         ' Left of triangle (Right)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f  1.0, -1.0, -1.0         ' Right of triangle (Right)

      ' Back
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Back)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f  1.0, -1.0, -1.0         ' Left of triangle (Back)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f -1.0, -1.0, -1.0         ' Right of triangle (Back)

      ' Left
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Left)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f -1.0, -1.0, -1.0         ' Left of triangle (Left)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f -1.0, -1.0,  1.0         ' Right of triangle (Left)
   glEnd

   glLoadIdentity
   glTranslatef 1.5, 0.0, -7.0            ' Move right 1.5 units and into the screen
   glRotatef rquad, 1.0, 1.0, 1.0         ' Rotate the quad on the X axis

   glBegin GL_QUADS
      glColor3f   0.0,  1.0,  0.0         ' Set the color to green
      glVertex3f  1.0,  1.0, -1.0         ' Top right of the quad (Top)
      glVertex3f -1.0,  1.0, -1.0         ' Top left of the quad (Top)
      glVertex3f -1.0,  1.0,  1.0         ' Bottom left of the quad (Top)
      glVertex3f  1.0,  1.0,  1.0         ' Bottom right of the quad (Top)

      glColor3f   1.0,  0.5,  0.0         ' Set the color to orange
      glVertex3f  1.0, -1.0,  1.0         ' Top right of the quad (Bottom)
      glVertex3f -1.0, -1.0,  1.0         ' Top left of the quad (Bottom)
      glVertex3f -1.0, -1.0, -1.0         ' Bottom left of the quad (Bottom)
      glVertex3f  1.0, -1.0, -1.0         ' Bottom right of the quad (Bottom)

      glColor3f   1.0,  0.0,  0.0         ' Set the color to red
      glVertex3f  1.0,  1.0,  1.0         ' Top right of the quad (Front)
      glVertex3f -1.0,  1.0,  1.0         ' Top left of the quad (Front)
      glVertex3f -1.0, -1.0,  1.0         ' Bottom left of the quad (Front)
      glVertex3f  1.0, -1.0,  1.0         ' Bottom right of the quad (Front)

      glColor3f   1.0,  1.0,  0.0         ' Set the color to yellow
      glVertex3f  1.0, -1.0, -1.0         ' Top right of the quad (Back)
      glVertex3f -1.0, -1.0, -1.0         ' Top left of the quad (Back)
      glVertex3f -1.0,  1.0, -1.0         ' Bottom left of the quad (Back)
      glVertex3f  1.0,  1.0, -1.0         ' Bottom right of the quad (Back)

      glColor3f   0.0,  0.0,  1.0         ' Set the color to blue
      glVertex3f -1.0,  1.0,  1.0         ' Top right of the quad (Left)
      glVertex3f -1.0,  1.0, -1.0         ' Top left of the quad (Left)
      glVertex3f -1.0, -1.0, -1.0         ' Bottom left of the quad (Left)
      glVertex3f -1.0, -1.0,  1.0         ' Bottom right of the quad (Left)

      glColor3f   1.0,  0.0,  1.0         ' Set the color to violet
      glVertex3f  1.0,  1.0, -1.0         ' Top right of the quad (Right)
      glVertex3f  1.0,  1.0,  1.0         ' Top left of the quad (Right)
      glVertex3f  1.0, -1.0,  1.0         ' Bottom left of the quad (Right)
      glVertex3f  1.0, -1.0, -1.0         ' Bottom right of the quad (Right)
   glEnd

   rtri = rtri + 0.2                      ' Increase the rotation variable for the triangle
   rquad = rquad - 0.15                   ' Decrease the rotation variable for the quad

   ' // Required: force execution of GL commands in finite time
   glFlush

   ' // Required: Force repainting of the control
   IF m_pGraphCtx THEN InvalidateRect(m_pGraphCtx->hWindow, NULL, CTRUE)

END SUB
' =======================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   ' // Create the window
   DIM hwndMain AS HWND = pWindow.Create(NULL, GL_WindowCaption, @WndProc)
   ' // Don't erase the background
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Use a black brush
   pWindow.Brush = CreateSolidBrush(BGR(255, 255, 255))
   ' // Sizes the window by setting the wanted width and height of its client area
   pWindow.SetClientSize(GL_WINDOWWIDTH, GL_WINDOWHEIGHT)
   ' // Centers the window
   pWindow.Center

   ' // Add a subclassed graphic control with OPENGL enabled
   DIM pGraphCtx AS CGraphCtx = CGraphCtx(@pWindow, IDC_GRCTX, "OPENGL", _
       0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
'   pGraphCtx.Stretchable = TRUE
   pGraphCtx.Resizable = TRUE
   ' // Set the timer (using a timer to trigger redrawing allows a smoother rendering)
   SetTimer(pGraphCtx.hWindow, 1, 0, NULL)

   ' // Create an instance of the CtxOgl class
   DIM pCtxOgl AS CtxOgl = @pGraphCtx
   ' // Subclass the graphic control
   SetWindowSubclass pGraphCtx.hWindow, CAST(SUBCLASSPROC, @GraphCtx_SubclassProc), IDC_GRCTX, CAST(DWORD_PTR, @pCtxOgl)
   ' // Setup the OpenGL scene
   pCtxOgl.SetupScene
   ' // Resize the OpenGL scene
   pCtxOgl.ResizeScene
   ' // Render the OpenGL scene
   pCtxOgl.RenderScene

   ' // Dispatch Windows events
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_SYSCOMMAND
         ' // Disable the Windows screensaver
         IF (wParam AND &hFFF0) = SC_SCREENSAVE THEN EXIT FUNCTION
         ' // Close the window
         IF (wParam AND &hFFF0) = SC_CLOSE THEN
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // If the window isn't minimized, resize the graphic control
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_GRCTX), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION GraphCtx_SubclassProc ( _
   BYVAL hwnd   AS HWND, _                 ' // Control window handle
   BYVAL uMsg   AS UINT, _                 ' // Type of message
   BYVAL wParam AS WPARAM, _               ' // First message parameter
   BYVAL lParam AS LPARAM, _               ' // Second message parameter
   BYVAL uIdSubclass AS UINT_PTR, _        ' // The subclass ID
   BYVAL dwRefData AS DWORD_PTR _          ' // Pointer to reference data
   ) AS LRESULT

   SELECT CASE uMsg

      CASE WM_GETDLGCODE
         ' // All keyboard input
         FUNCTION = DLGC_WANTALLKEYS
         EXIT FUNCTION

      CASE WM_LBUTTONDOWN
         MessageBoxW(GetParent(hwnd), "Click", "FreeBasic", MB_OK)
         EXIT FUNCTION

      CASE WM_KEYDOWN
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE VK_ESCAPE
               SendMessageW(GetParent(hwnd), WM_CLOSE, 0, 0)
               EXIT FUNCTION
         END SELECT

      CASE WM_TIMER
         ' // Render the scene
         DIM pCtxOgl AS CTXOGL PTR = cast(CTXOGL PTR, dwRefData)
         IF pCtxOgl THEN pCtxOgl->RenderScene
         EXIT FUNCTION

      CASE WM_SIZE
         ' // First perform the default action
         DefSubclassProc(hwnd, uMsg, wParam, lParam)
         ' // Check if the graphic contol is resizable
         DIM bResizable AS BOOLEAN =  AfxCGraphCtxPtr(hwnd)->Resizable
         ' // If it is resizable, we need to recreate the scene
         ' // because the rendering context has changed
         IF bResizable THEN
            DIM pCtxOgl AS CtxOgl PTR = cast(CtxOgl PTR, dwRefData)
            IF pCtxOgl THEN
               pCtxOgl->SetUpScene
               pCtxOgl->ResizeScene
               pCtxOgl->RenderScene
            END IF
         END IF

      EXIT FUNCTION

      CASE WM_DESTROY
         ' // Kill the timer
         KillTimer(hwnd, 1)
         ' // REQUIRED: Remove control subclassing
         RemoveWindowSubclass hwnd, @GraphCtx_SubclassProc, uIdSubclass

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefSubclassProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================
« Last Edit: October 13, 2017, 04:08:01 PM by José Roca »
Logged

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #188 on: October 13, 2017, 10:36:52 PM »

This example demonstrates how to process keystrokes and the mouse.

Paul Squires

  • Administrator
  • Master FireFly Member
  • *****
  • Posts: 8118
  • Windows 10
    • PlanetSquires Software
Re: CWindow Release Candidate 31
« Reply #189 on: October 14, 2017, 09:10:22 AM »

Thanks José!
BTW, I am back to programming again so if you need anything added/changed to the editor then just let me know. I am working on the visual designer now.
Logged
Paul Squires
PlanetSquires Software
FireFly Visual Designer, WinFBE Editor

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #190 on: October 16, 2017, 08:37:21 AM »

Updated the download in the first post with the changes and new classes recently discussed.

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #191 on: October 19, 2017, 11:18:53 AM »

Updated the download in the first post with a modified CDispInvoke class.

Changes in the CVAR class to ease the use of variants could cause an ambiguos call to overloaded function Invoke. I have removed the old overloads that caused the error.

With the changes, you no longer have to specify the number of parameters when calling Invoke and also you won't need the use of CVAR except in some cases.

This example

Code: [Select]
#define UNICODE
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CCLRHost.inc"
USING Afx

' // Create an instance of the CCLRHost class
DIM pCLRHost AS CCLRHost

' // Create an instance of the .NET ArrayList class
DIM pDisp AS CDispInvoke = pCLRHost.CreateInstance ("mscorlib", "System.Collections.ArrayList")
IF pDisp.DispPtr = NULL THEN END

pDisp.Invoke("Add", 1, CVAR("First string"))
pDisp.Invoke("Add", 1, CVAR("Second string"))
pDisp.Invoke("Add", 1, CVAR("Third string"))

DIM nCount AS LONG =  pDisp.Invoke("Count").ValInt
FOR i AS LONG = 0 TO nCount - 1
   print pDisp.Get("Item", CVAR(i)).ToStr
NEXT

PRINT
PRINT "Press any key..."
SLEEP

becomes

Code: [Select]
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CCLRHost.inc"
USING Afx

' // Create an instance of the CCLRHost class
DIM pCLRHost AS CCLRHost

' // Create an instance of the .NET ArrayList class
DIM pDisp AS CDispInvoke = pCLRHost.CreateInstance ("mscorlib", "System.Collections.ArrayList")
IF pDisp.DispPtr = NULL THEN END

pDisp.Invoke("Add", "First string")
pDisp.Invoke("Add", "Second string")
pDisp.Invoke("Add", "Third string")

DIM nCount AS LONG =  VAL(pDisp.Invoke("Count"))
FOR i AS LONG = 0 TO nCount - 1
   print pDisp.Get("Item", i)
NEXT

PRINT
PRINT "Press any key..."
SLEEP

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #192 on: October 25, 2017, 11:06:53 PM »

We can use the FreeBasic array intrinsics with CWSTRings.

Code: [Select]
DIM rg(1 TO 10) AS CWSTR
FOR i AS LONG = 1 TO 10
   rg(i) = "string " & i
NEXT

FOR i AS LONG = 1 TO 10
   print rg(i)
NEXT

Code: [Select]
DIM rg2 (1 TO 2, 1 TO 2) AS CWSTR
rg2(1, 1) = "string 1 1"
rg2(1, 2) = "string 1 2"
rg2(2, 1) = "string 2 1"
rg2(2, 2) = "string 2 2"
print rg2(2, 1)

Code: [Select]
REDIM rg(0) AS CWSTR
rg(0) = "string 0"
REDIM PRESERVE rg(0 TO 2) AS CWSTR
rg(1) = "string 1"
rg(2) = "string 2"
print rg(0)
print rg(1)
print rg(2)
ERASE rg

And also with CVARs (variants)

Code: [Select]
DIM rg(1 TO 10) AS CVAR
FOR i AS LONG = 1 TO 10
   rg(i) = "string " & i
NEXT

FOR i AS LONG = 1 TO 10
   print rg(i)
NEXT

Now they behave like FB strings with the exception of the MID statement (don't confuse it with the MID function) and the [] operator to change the contents of the string. This is because casting generates a temporary string and the changes will be made to that temporary string. However, MID(**wstring, 2, 3) = "xx" will work.

Since BSTRings and Safe Arrays are slower, CWSTRings should be used for general purposes, and CBSTRrings and CSafeArrays for COM programming and for DLLs or COM servers to be used with other languages such PowerBasic.
« Last Edit: October 26, 2017, 01:45:55 PM by José Roca »
Logged

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #193 on: October 26, 2017, 01:55:11 AM »

And I have got sorting to work with one-dimensional CWSTR arrays...

Code: [Select]
'#CONSOLE ON
#define UNICODE
#include once "Afx/CWSTR.inc"
USING Afx

' ========================================================================================
' qsort CWstr comparison function
' ========================================================================================
PRIVATE FUNCTION AfxCWstrArrayCompare CDECL (BYVAL a AS CWSTR PTR, BYVAL b AS CWSTR PTR) AS LONG
   FUNCTION = wcscmp(cast(WSTRING PTR, a->m_pBuffer), cast(WSTRING PTR, b->m_pBuffer))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Reverse qsort CWstr comparison function
' ========================================================================================
PRIVATE FUNCTION AfxCWStrArrayReverseCompare CDECL (BYVAL a AS CWSTR PTR, BYVAL b AS CWSTR PTR) AS LONG
   DIM r AS LONG = wcscmp(cast(WSTRING PTR, a->m_pBuffer), cast(WSTRING PTR, b->m_pBuffer))
   IF r = 1 THEN r = -1 ELSE IF r = -1 THEN r = 1
   RETURN r
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sorts a one-dimensional CWSTR array calling the C qsort function.
' Parameters:
' - rgwstr : Start of target array.
' - numElm : Number of elements in the array.
' - bAscend: TRUE for sorting in ascending order; FALSE for sorting in descending order.
' ========================================================================================
PRIVATE SUB AfxCWstrSort (BYREF rgwstr AS ANY PTR, BYVAL numElm AS LONG, BYVAL bAscend AS BOOLEAN = TRUE)
   IF rgwstr = NULL OR numElm < 2 THEN EXIT SUB
   IF bAscend THEN
      qsort rgwstr, numElm, SIZEOF(CWSTR), CPTR(ANY PTR, @AfxCWstrArrayCompare)
   ELSE
      qsort rgwstr, numElm, SIZEOF(CWSTR) , CPTR(ANY PTR, @AfxCWStrArrayReverseCompare)
   END IF
END SUB
' ========================================================================================

DIM rg(1 TO 10) AS CWSTR
FOR i AS LONG = 1 TO 10
   rg(i) = "string " & i
NEXT

FOR i AS LONG = 1 TO 10
'   print varptr(rg(i))
   print rg(i)
NEXT

print "---- after sorting ----"

AfxCWstrSort @rg(1), 10, TRUE

FOR i AS LONG = 1 TO 10
   print rg(i)
NEXT

PRINT
PRINT "Press any key..."
SLEEP

José Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2811
    • José Roca Software
Re: CWindow Release Candidate 31
« Reply #194 on: October 26, 2017, 02:27:23 PM »

If we use REDIM PRESERVE to shorten or expand a CWSTR array, the discarded element will call its destructor, and the added element(s) will call its default constructor.

Code: [Select]
'#CONSOLE ON
#define UNICODE
#define _CWSTR_DEBUG_ 1
#include once "Afx/CWSTR.inc"
USING Afx

REDIM rg(1 TO 10) AS CWSTR
FOR i AS LONG = 1 TO 10
   rg(i) = "string " & i
NEXT

REDIM PRESERVE rg(1 TO 9) AS CWSTR

FOR i AS LONG = 1 TO UBOUND(rg)
   print rg(i)
NEXT

PRINT
PRINT "Press any key..."
SLEEP
Pages: 1 ... 11 12 [13] 14 15