PureBasic Forums - English

Code: Select all

ERROR_ALREADY_EXISTS = 183
Global WM_ACTIVATEOLDINST
WM_ACTIVATEOLDINST = RegisterWindowMessage_("WM_ACTIVATEOLDINST_PB")
MutexName$ = "mylittletestapp"

Procedure MyWindowCallback(WindowID, Message, wParam, lParam)  
  Result = #PB_ProcessPureBasicEvents  
  If message = WM_ACTIVATEOLDINST
    CloseHandle_(hMutex)
    OpenConsole()
    PrintN("closing app")
    Delay(2000)
    End
  EndIf
  ProcedureReturn Result  
EndProcedure  

hMutex = CreateMutex_(0, 0, @MutexName$)
If GetLastError_() = ERROR_ALREADY_EXISTS 
  SendMessage_(#HWND_BROADCAST, WM_ACTIVATEOLDINST, 0, 0)
  Delay(100)
EndIf


If OpenWindow(0,100,150,450,200,#PB_Window_SystemMenu,"MyLittleTestApp " + Str(Random(500)))
  SetWindowCallback(@MyWindowCallback()) 
  Repeat
    ev=WaitWindowEvent()
  Until ev=#PB_EventCloseWindow
EndIf

If hMutex <> 0 
 CloseHandle_(hMutex)
EndIf

End

Code: Select all

; These two lines prevent this app from being run more than once.
; You must put these lines at the start of your app's code (obviously).
MutexID=CreateMutex_(0,1,"YourAppName") : MutexError=GetLastError_()
If MutexID=0 Or MutexError<>0 : ReleaseMutex_(MutexID) : CloseHandle_(MutexID) : End : EndIf
;
; Your app's code now goes here, until quitting time, which executes the next line.
;
CloseHandle_(MutexID) : End

Code: Select all

ERROR_ALREADY_EXISTS = 183
Global WM_ACTIVATEOLDINST
WM_ACTIVATEOLDINST = RegisterWindowMessage_("WM_ACTIVATEOLDINST_PB")
MutexName$ = "mylittletestapp"

Procedure MyWindowCallback(WindowID, message, wParam, lParam)
 Result = #PB_ProcessPureBasicEvents
 If message = WM_ACTIVATEOLDINST
  ShowWindow_(WindowID,#SW_RESTORE)
  SetForegroundWindow_(WindowID)
  EndIf
 ProcedureReturn Result
EndProcedure

hMutex = CreateMutex_(0, 0, @MutexName$)
If GetLastError_() = ERROR_ALREADY_EXISTS
  SendMessage_(#HWND_BROADCAST, WM_ACTIVATEOLDINST, 0, 0)
  End
EndIf


hwnd=OpenWindow(0,100,150,450,200,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget,"MyLittleTestApp ")
If hwnd
  SetWindowCallback(@MyWindowCallback())
  Repeat
   ev=WaitWindowEvent()
   If showoldwindow
   EndIf
  Until ev=#PB_EventCloseWindow
EndIf

If hMutex <> 0
 CloseHandle_(hMutex)
EndIf

End

Code: Select all

;--------Prevent app from being run more than once.---------------
*a = CreateSemaphore_(NULL,0,1,GetProgramName())
  If *a < > 0 And GetLastError_()= #ERROR_ALREADY_EXISTS
   CloseHandle_(*a)
   End
 EndIf
;---------------------------------------------------------

Code: Select all

#MyApp = "Test TEST"

Repeat 
  stx+1
  hwnd = FindWindow_(0,#MyApp)
Until hwnd Or stx > 1000
If hwnd
  SendMessage_(hwnd, #WM_SYSCOMMAND, #SC_CLOSE, 0)
EndIf

flags = #PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_ScreenCentered | #PB_Window_SizeGadget
OpenWindow(0,0,0,400,300,"Test TEST",Flags)
StringGadget(0,10,10,120,30,"First Window")
Repeat           
  Select WaitWindowEvent()      
      Case #PB_Event_CloseWindow
            Quit = 1 
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            SetGadgetText(0,"Second Test")
        EndSelect
  EndSelect 
Until Quit = 1
End

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