Hi Cor. Here's a Windows-only solution:Cor wrote: Wed May 07, 2003 9:15 pm...The first instance must be closed and the second must be opened.
Is there a way to do this?
How to reject double run?
Hi Cor. Here's a Windows-only solution:Cor wrote: Wed May 07, 2003 9:15 pm...The first instance must be closed and the second must be opened.
Is there a way to do this?
Code: Select all
;-TOP
; Comment : New Window with own ClassName
; Author : ?
; Author : mk-soft
; Version : v1.01.3
; Create : 23.12.2012
; Update : 21.07.2022
Import ""
PB_Window_ProcessEvent(a,b,c,d)
PB_Window_Icon
PB_Window_Cursor
PB_Window_Objects
PB_Object_GetOrAllocateID(*Object,id)
EndImport
Procedure OpenClassWindow(Window ,x ,y , Width, Height, Title.s, ClassName.s, Flags= #WS_VISIBLE | #WS_OVERLAPPEDWINDOW, Parent=0)
Protected r1
Protected WindowClass.wndclass
Protected *PB_Object.integer
Protected hWnd.i
Protected rc.rect
With WindowClass
\style = #CS_HREDRAW | #CS_VREDRAW
\lpfnWndProc = @PB_Window_ProcessEvent()
\hInstance = GetModuleHandle_(0)
\hIcon = PB_Window_Icon
\hCursor = PB_Window_Cursor
\lpszClassName = @ClassName
\hbrBackground = #COLOR_WINDOW
\cbWndExtra = 0
\cbClsExtra = 0
EndWith
If RegisterClass_(WindowClass)
SetRect_(rc, 0, 0, Width, Height)
AdjustWindowRectEx_(rc , Flags, 0, #WS_EX_WINDOWEDGE)
If x = #PB_Ignore Or y = #PB_Ignore
x = #CW_USEDEFAULT
y = #CW_USEDEFAULT
EndIf
hWnd = CreateWindowEx_(#WS_EX_WINDOWEDGE, ClassName, Title, Flags, x, y, rc\right-rc\left, rc\bottom-rc\top, Parent, 0, GetModuleHandle_(0), 0)
If hWnd
*PB_Object = PB_Object_GetOrAllocateID(PB_Window_Objects, Window)
If *PB_Object
*PB_Object\i = hWnd
If Window = #PB_Any
SetProp_(hWnd, "Pb_WindowID", *PB_Object + 1)
Else
SetProp_(hWnd, "Pb_WindowID", Window + 1)
EndIf
UseGadgetList(hWnd)
If Window = #PB_Any
r1 = *PB_Object
Else
r1 = hWnd
EndIf
Else
CloseWindow_(hwnd)
UnregisterClass_(GetModuleHandle_(0), ClassName)
EndIf
Else
UnregisterClass_(GetModuleHandle_(0), ClassName)
EndIf
EndIf
ProcedureReturn r1
EndProcedure
; ********
;-Test
CompilerIf #PB_Compiler_IsMainFile
; ----
#MyWindowClassName = "MyDataWindow#001"
Procedure IsRunning()
Protected hWnd, state
hWnd = FindWindow_(#MyWindowClassName, 0)
If hWnd
ShowWindow_(hWnd, #SW_RESTORE)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure Main()
Protected dx, dy
hMainWnd = OpenClassWindow(0,#PB_Ignore, #PB_Ignore, 400, 200, "My Data Window", #MyWindowClassName)
dx = WindowWidth(0)
dy = WindowHeight(0)
ListViewGadget(0, 10, 10, dx - 20, dy - 20)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver
EndProcedure
If Not IsRunning()
Main()
EndIf
CompilerEndIf
Code: Select all
; Sample code I built from bits and pieces collected from this forum
; to illustrate how to force single instance of your app.
; YOU MUST compile and run this sample to see it work properly!!!
; Pay attention to these two globals:
Global windowname$ = "One Instance" ; Full display name for the window.
Global TargetName$ = "One Instanc" ; first 11 characters to satisfy Gt_Prog() procedure below.
; The following globals and FOUR prodecures MUST BE at the top of your program.
Global targetWindow$, hWin.i, m_hWnd.i, active.W
Procedure ReallySetForegroundWindow(m_hWnd.i)
; http://www.drdobbs.com/184405755
hOtherWnd.i = GetForegroundWindow_()
;
; get thread handles on our window and foreground window
hMyThread.i = GetWindowThreadProcessId_(m_hWnd, 0)
hOtherThread.i = GetWindowThreadProcessId_(hOtherWnd,0)
;
; attach our thread to foreground thread, take foreground, and detach threads
AttachThreadInput_(hMyThread,hOtherThread, #True)
SetForegroundWindow_(m_hWnd)
AttachThreadInput_(hMyThread,hOtherThread, #False)
; AttachThreadInput_(hOtherThread,hMyThread, #True); backward set
; SetForegroundWindow_(m_hWnd)
; AttachThreadInput_(hOtherThread,hMyThread, #False)
;
; Now that our window "thread" has fisrt place in the queue...
; make sure our "window" is visible
If IsIconic_(m_hWnd)
ShowWindow_(m_hWnd,#SW_RESTORE)
Else
ShowWindow_(m_hWnd,#SW_SHOW)
EndIf
SetActiveWindow(GetDlgCtrlID_(m_hWnd))
WaitWindowEvent()
SetForegroundWindow_(m_hWnd)
EndProcedure
Procedure.i ListWindows(Window, Parameter) ; used inside Gt_Prog()
WindowTitle.s = Space(255)
GetWindowText_(Window, WindowTitle, 255)
WindowTitle = LCase(WindowTitle)
If LCase(WindowTitle) = targetWindow$
active.W = 1
hWin.i = Window
ElseIf Left(WindowTitle,11) = targetWindow$
active.W = 1
hWin.i = Window
ElseIf Left(WindowTitle,6) = Left(targetWindow$,6) ; "From: "
If Right(WindowTitle,9) = Right(targetWindow$,9) ; " - E-mail"
If Left(WindowTitle,6) <> Right(targetWindow$,6)
active.W = 1
hWin.i = Window
EndIf
EndIf
EndIf
ProcedureReturn #True
EndProcedure
Procedure Gt_Prog(dmy$) ; input : 11 char PROCESS name , active.w = true if running : hWin.i holds Window handle
targetWindow$ = LCase(dmy$)
active.W = 0
hWin.i = 0
EnumWindows_(@ListWindows(), 0) ; Windows CallBack operation.
ProcedureReturn active.W
EndProcedure
If Gt_Prog("One Instanc") ; Using 1st 11 characters to Prevent 2nd instance if already running
SetForegroundWindow_(hWin.i) ; AND bring current instance into foreground.
ShowWindow_(hWin.i, #SW_RESTORE)
Delay(250)
End ; Quit from this duplicate instance.
EndIf
If OpenWindow(0, 0, 0, 270, 140,windowname$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TextGadget(0, 40, 20, 250, 20, "Bury this window under other window(s)")
TextGadget(1, 40, 40, 250, 20, "Then TRY to open a 2nd instance", #PB_Text_Center)
TextGadget(2, 40, 70, 250, 20, "It won't happen. You can ONLY")
TextGadget(3, 40, 90, 250, 20, "bring the fhe 1st instace to the top.")
ButtonGadget (4, 80, 110, 100, 20, "CLOSE")
Repeat ; This loop only here to enable and simplify program exit.
Event = WaitWindowEvent() ; Real magic is in the proceedures above.
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 4
Event = #PB_Event_CloseWindow
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
EndIf