PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 2 [3] 4 5 ... 10
 21 
 on: August 24, 2020, 08:25:13 PM 
Started by James Klutho - Last post by Josť Roca
You must be doing something really weird. I have taken one of the templates that displays a popup dialog when  you click the "Popup" button and added a button labeled "Open File" to the popup dialog and it works fine.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_PopupWindow.fbtpl
' Contents: CWindow with a modal popup window
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 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"
USING Afx

CONST IDC_POPUP = 1001
CONST IDC_OFD = 1002

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 PopupWindow (BYVAL hParent AS HWND) AS LONG
DECLARE FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' 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
   AfxSetProcessDPIAware

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with a popup window", @WndProc)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   ' // Add a button without position or size (it will be resized in the WM_SIZE message).
   pWindow.AddControl("Button", , IDC_POPUP, "&Popup", 350, 250, 75, 23)

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

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

' ========================================================================================
' 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_COMMAND
         ' // If ESC key pressed, close the application sending an WM_CLOSE message
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDC_POPUP
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  PopupWindow(hwnd)
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the buttons
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            pWindow->MoveWindow GetDlgItem(hwnd, IDC_POPUP), pWindow->ClientWidth - 120, pWindow->ClientHeight - 50, 75, 23, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Quit the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWindow (BYVAL hParent AS HWND) AS LONG

   DIM pWindow AS CWindow
   pWindow.Create(hParent, "Popup window", @PopupWndProc, , , , , _
      WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW OR WS_THICKFRAME, WS_EX_WINDOWEDGE)
   pWindow.Brush = GetStockObject(WHITE_BRUSH)
   pWindow.SetClientSize(300, 200)
   pWindow.Center(pWindow.hWindow, hParent)
   ' // Add a button
   pWindow.AddControl("Button", , IDC_OFD, "Open File", 150, 150, 75, 23)
   ' / Process Windows messages
   FUNCTION = pWindow.DoEvents

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

' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   STATIC hNewFont AS HFONT

   SELECT CASE uMsg

      CASE WM_CREATE
         ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
         DIM pWindow AS CWindow PTR = AfxcWindowPtr(lParam)
         ' // Create a new font scaled according the DPI ratio
         IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
         ' Disable parent window to make popup window modal
         EnableWindow GetParent(hwnd), FALSE
         EXIT FUNCTION

      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
            ' // Display the Open File Dialog
            CASE IDC_OFD
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  DIM wszFile AS WSTRING * 260 = "*.*"
                  DIM wszInitialDir AS STRING * 260 = CURDIR
                  DIM wszFilter AS WSTRING * 260 = "BAS files (*.BAS)|*.BAS|" & "All Files (*.*)|*.*|"
                  DIM dwFlags AS DWORD = OFN_EXPLORER OR OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY
                  DIM cws AS CWSTR = AfxOpenFileDialog(hwnd, "", wszFile, wszInitialDir, wszFilter, "BAS", @dwFlags, NULL)
                  MessageBoxW(hwnd, cws, "File", MB_OK)
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_PAINT
    DIM ps AS PAINTSTRUCT, hOldFont AS HFONT
         DIM hDC AS HDC = BeginPaint(hWnd, @ps)
         IF hNewFont THEN hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
         DIM rc AS RECT
         GetClientRect(hWnd, @rc)
         DrawTextW(hDC, "Hello, World!", -1, @rc, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
         IF hNewFont THEN SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
         EndPaint(hWnd, @ps)
         EXIT FUNCTION

      CASE WM_CLOSE
         ' // Enables parent window keeping parent's zorder
         EnableWindow GetParent(hwnd), CTRUE
         ' // Don't exit; let DefWindowProcW perform the default action

    CASE WM_DESTROY
         ' // Destroy the new font
         IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))
         ' // End the application by sending an WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

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

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

 22 
 on: August 24, 2020, 07:12:51 PM 
Started by James Klutho - Last post by James Klutho
That is correct.  It is all Jose's library.  The dialogs windows are all modal based on your About form of the code editor source code as a template.  When I call the AfxOpenFileDialog from a child dialog window, it just keeps popping up and I have to force a close by right clicking the icon in the bottom task bar.  When I change the parent of the AfxOpenFileDialog to the main form or the DeskTopWindow, I can eventually dismiss the AfxOpenFileDialog after having re-popped up  4 or 5 times.  I have to believe there is a conflict in the Event loops but I can't find it.  See if the same thing happens for you.

 23 
 on: August 24, 2020, 06:52:29 PM 
Started by James Klutho - Last post by Paul Squires
Hi Jim,

Just so that I understand 100%.... You have a main form and you are popping up additional dialogs (modal or modeless?), and on those popup dialogs you are pressing a button that shows the AfxOpenFileDialog dialog and it is that AfxOpenFileDialog that will not close?

I assume you are using Jose's Afx CWindow library directly and NOT the WinFBE visual designer, right?

 24 
 on: August 24, 2020, 12:45:45 AM 
Started by James Klutho - Last post by James Klutho
I have been using WinFBE for a couple of months without problems until now.  I have a main parent window and call quite a few child windows and all is fine.  On one of the child windows I call AfxOpenFileDialog via a BUTTON control and it won't dismiss itself properly.  It keeps popping up.   AfxOpenFileDialog works fine in the parent window.  I think GetOpenFilenameW is getting confused with the multiple event loops. I messed with this quite a bit. I even tried to change the parent of AfxOpenFileDialog to the the DeskTopWindow but still no joy.  The problem, I think, lies in  pWindow->DoEvents(SW_SHOW).  Any thoughts?

 25 
 on: August 22, 2020, 12:37:07 PM 
Started by James Klutho - Last post by Josť Roca
Thanks very much for your kind words.

Currently, my only motivation to do some programming from time to time is to no lose entirely my skills. It is also useful to keep my mind in good shape.

The good thing about FreeBasic is that it you can extend the language using classes. The first one that it was most needed was an unicode dynamic string. I managed to write a full working one, although because some quirks of the compiler I had to use some tricks, like the much hated double indirection (**) to allow to be used with the FB intrinsic functions. Fortunately, the current FB's main developer become interested and made changes to the compiler to allow full integration. Maybe a modified version of it will be distributed in a future version of FB.

 26 
 on: August 22, 2020, 01:04:12 AM 
Started by veltesian - Last post by veltesian
i recently happened upon an online article speaking on the topic wave file format
& near the bottom of the page they were kind enough to include VB code on how
someone could programmatically write to a wave file.  the image file included
shows compiler errors that seem to be that the compiler cannot identify certain
parts of the code & i wondered if anyone could possibly help me fix these errors...

thanks a million ahead of time.....

 27 
 on: August 21, 2020, 01:24:34 PM 
Started by James Klutho - Last post by Paul Squires
Thanks Jim :-)   Jose's WinFBX is an amazing collection of classes and subs/functions. It surprises me as well that not every Windows FB programmer does not use the library to it's fullest potential. Without it, I'd be lost. It has saved me hundreds of hours of programming effort. Jose is a legend.
 

 28 
 on: August 21, 2020, 12:36:46 AM 
Started by James Klutho - Last post by James Klutho
Just a shout out to Jose.  I have been rewriting a major petroleum industry application from the early 2000's using Freebasic  and WinFBE.  This effort is to repent programming sins of a noobie in Powerbasic.  I could have never accomplished what I did do without the wonderful and helpful Powerbasic forum from back then.  I got it to work but boy is it ugly.  I am well beyond retirement age and will never sell this thing but I just wanted to try and do a better job.  This will probably be a couple thousand of hours of programming time if I don't die first. This is the reason I wrote the Grid and Printing app that is present on this forum.  Paul's editor is nice.  Thanks Paul.  Freebasic is a respectable basic and works surprisingly well for an open source project.  Good job to mainly victor1 and dkl but I am sure to a host of others.  It kind of saddens me though that WinFBE is not embraced more by the Freebasic community.  WinFBE is so polished and well documented it is an anomaly in the Freebasic world.  There are some good programmers in the community but everyone is a hobbist.  I see basic dissipating further in the coming years.

Jose, I can't imagine what drives your generosity and perfection but here is thanks from the receiving end of your effort.  WinFBE is wonderful.  Without it and Paul's editor, I would have left Freebasic by now.  I visited Freebasic to dip my toe into linux and GDK/GTK but got frustrated and have been on the periphery of Windows Freebasic for a time now.  I will probably stick around and lurk a little.

Jim

 29 
 on: August 20, 2020, 05:06:57 PM 
Started by veltesian - Last post by Wilko Verweij
Does this help?

https://social.msdn.microsoft.com/Forums/en-US/7b04ca15-7139-433a-ad3c-934a02175a5b/msscriptocx-with-64-bit-platforms

They claim ( at the end) they got it working. Did not test it myself. And at this website they present an alternative for the msscript.ocx:

https://helloacm.com/inconsistent-behavior-of-scriptcontrol-64-bit-to-the-msscript-ocx/

 Did not dive into the details.

 30 
 on: August 19, 2020, 09:24:39 PM 
Started by veltesian - Last post by Johan Klassen
hello Josť Roca
I changed pSC = AfxNewCom(Exepath & "\" & "msscript.ocx", CLSID_ScriptControl, IID_IScriptControl)
to pSC = AfxNewCom("msscript.ocx", CLSID_ScriptControl, IID_IScriptControl)
and it works, but as you said only on 32-bit

Pages: 1 2 [3] 4 5 ... 10