Code: Select all
;- Top
; -----------------------------------------------------------------------------
; Name: Run2exeAsTab
; Description: Assemble 2 same running programs as if they were 1, with tab and by copying data from one process to the other, in both directions
; Author: ChrisR
; Date: 2024-11-18
; Version: v1.2
; PB-Version: v6.x
; OS: Windows Only
; Forum: https://www.purebasic.fr/english/viewtopic.php?t=85749
; -----------------------------------------------------------------------------
EnableExplicit
Prototype SetCurrentProcessExplicitAppUserModelID(*AppID)
#SendFullList = #True ; #True | #False
Enumeration Windows
#MainWindow
EndEnumeration
Enumeration MenuToolBar
#ToolBar
#Menu_Cut
#Menu_Copy
#Menu_Paste
EndEnumeration
Enumeration Gadgets
#Btn_Tab_1
#Btn_Tab_2
#ProcessText
#RcvProcessText
#Frame
#ListIcon
EndEnumeration
Enumeration Messages
#Send2Window_Message
#PosSize_Message
#String_Message
#ClearList_Message
#SendListItem_Message
#SendList_Message
EndEnumeration
UsePNGImageDecoder()
Structure ZipCodeInfo
ZipCode.l
City.s
County.s
Type.s
EndStructure
Global NewList ZipCode.ZipCodeInfo()
Global Send2Window
Declare SetAppUserModelID()
Declare PasteZipCode()
Declare CopyZipCode(Action = #Menu_Copy)
Declare WinCallback(hWnd, uMsg, wParam, lParam)
Declare SendList()
Declare SendListItem()
Declare SendClearList()
Declare SendString(String2Send.s)
Declare SendWindowPlacement(Window)
Declare SendWindowID(Window)
Declare InitList(TabID)
Declare Resize_MainWindow()
Declare ToolBar_MainWindow()
Declare Open_MainWindow(X = 0, Y = 0, Width = 520, Height = 360)
Procedure SetAppUserModelID()
Protected Shell32Lib, Result
Protected AppUserModelID$ = "MyCompany.Run2exeAsTab"
; Specifies a unique application-defined Application User Model ID (AppUserModelID) that identifies the current process to the taskbar
; This identifier allows an application to group its associated processes and windows under a single taskbar button
; It must be called during initial startup before the application opens a user interface
Define Shell32Lib = OpenLibrary(#PB_Any, "shell32.dll")
If Shell32Lib
Define SetCurrentProcessExplicitAppUserModelID_.SetCurrentProcessExplicitAppUserModelID=GetFunction(Shell32Lib, "SetCurrentProcessExplicitAppUserModelID")
If SetCurrentProcessExplicitAppUserModelID_(@AppUserModelID$) = #S_OK
Result = #True
EndIf
CloseLibrary(Shell32Lib)
EndIf
ProcedureReturn Result
EndProcedure
;-------------------------
Procedure PasteZipCode()
If ListSize(ZipCode())
Protected i, Count = CountGadgetItems(#ListIcon) - 1
SetActiveGadget(#ListIcon)
For i = 0 To Count
SetGadgetItemState(#ListIcon, i, 0)
Next
i = 0
With ZipCode()
ForEach ZipCode()
Count + 1
AddGadgetItem(#ListIcon, Count, Str(\ZipCode) +#LF$+ \City +#LF$+ \County +#LF$+ \Type)
If Not i : i = 1 : SetGadgetState(#ListIcon, Count) : EndIf
SetGadgetItemState(#ListIcon, Count, #PB_ListIcon_Selected)
Next
EndWith
EndIf
EndProcedure
Procedure CopyZipCode(Action = #Menu_Copy)
Protected i, Count = CountGadgetItems(#ListIcon) - 1
ClearList(ZipCode())
CompilerIf Not #SendFullList
SendClearList()
CompilerEndIf
For i = 0 To Count
If GetGadgetItemState(#ListIcon, i) = #PB_ListIcon_Selected
With ZipCode()
AddElement(ZipCode())
\ZipCode = Val(GetGadgetItemText(#ListIcon, i , 0))
\City = GetGadgetItemText(#ListIcon, i , 1)
\County = GetGadgetItemText(#ListIcon, i , 2)
\Type = GetGadgetItemText(#ListIcon, i , 3)
EndWith
CompilerIf Not #SendFullList
SendListItem()
CompilerEndIf
If Action = #Menu_Cut
RemoveGadgetItem(#ListIcon, i)
Count - 1 : i - 1
Else
SetGadgetItemState(#ListIcon, i, 0)
EndIf
EndIf
Next
CompilerIf #SendFullList
SendList()
CompilerEndIf
EndProcedure
;-------------------------
Procedure WinCallback(hWnd, uMsg, wParam, lParam)
Protected result = #PB_ProcessPureBasicEvents
Protected *CopyData.COPYDATASTRUCT
Select uMsg
Case #WM_COPYDATA
*CopyData.COPYDATASTRUCT = lParam
Select *CopyData\dwData
Case #Send2Window_Message
If Send2Window
Send2Window = PeekI(*CopyData\lpData)
Else ; ; Initial from RunProgram => SendWindowID(#MainWindow)
Send2Window = PeekI(*CopyData\lpData)
SendString("Hello from Process: " + Str(GetCurrentProcessId_()))
SendWindowPlacement(#MainWindow)
SendList()
EndIf
Case #PosSize_Message
; ShowWindow #SW_SHOWMINIMIZED first, else, by changing Tab (Process), the new window is not activated and so are the shortcuts (e.g. Ctrl+V)
ShowWindow_(hWnd, #SW_SHOWMINIMIZED)
SetWindowPlacement_(hWnd, *CopyData\lpData) ; SetWindowPos_(hWnd, #HWND_NOTOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE)
; Hide the window that sent the message, After SetWindowPlacement, so as not to hide and reopen the taskbar button
ShowWindow_(Send2Window, #SW_HIDE)
Case #String_Message
SetGadgetText(#RcvProcessText, PeekS(*CopyData\lpData))
Case #ClearList_Message
ClearList(ZipCode())
Case #SendListItem_Message
If CatchJSON(0, *CopyData\lpData, *CopyData\cbData) ; JSON is encoded in UTF-8
AddElement(ZipCode())
ExtractJSONStructure(JSONValue(0), @ZipCode(), ZipCodeInfo)
EndIf
Case #SendList_Message
If CatchJSON(0, *CopyData\lpData, *CopyData\cbData) ; JSON is encoded in UTF-8
ClearList(ZipCode())
ExtractJSONList(JSONValue(0), ZipCode())
EndIf
EndSelect
result = #True
EndSelect
ProcedureReturn result
EndProcedure
Procedure SendList()
Protected *ZipCodeUTF8
Protected *SendListdata.COPYDATASTRUCT = AllocateMemory(SizeOf(COPYDATASTRUCT))
If ListSize(ZipCode())
If CreateJSON(0)
InsertJSONList(JSONValue(0), ZipCode())
; JSON is generally encoded in UTF-8, so when sending it to another application, it is advised to convert the string to UTF-8 before doing so
*ZipCodeUTF8 = UTF8(ComposeJSON(0)) ;
FreeJSON(0)
With *SendListdata
\dwData = #SendList_Message
\cbData = MemorySize(*ZipCodeUTF8)
\lpData = *ZipCodeUTF8
EndWith
SendMessage_(Send2Window, #WM_COPYDATA, #Null, *SendListdata)
FreeMemory(*ZipCodeUTF8)
EndIf
EndIf
EndProcedure
Procedure SendListItem()
Protected *ZipCodeUTF8
Protected *SendListdata.COPYDATASTRUCT = AllocateMemory(SizeOf(COPYDATASTRUCT))
If CreateJSON(0)
InsertJSONStructure(JSONValue(0), ZipCode(), ZipCodeInfo)
; JSON is generally encoded in UTF-8, so when sending it to another application, it is advised to convert the string to UTF-8 before doing so
*ZipCodeUTF8 = UTF8(ComposeJSON(0)) ;
FreeJSON(0)
With *SendListdata
\dwData = #SendListItem_Message
\cbData = MemorySize(*ZipCodeUTF8)
\lpData = *ZipCodeUTF8
EndWith
SendMessage_(Send2Window, #WM_COPYDATA, #Null, *SendListdata)
FreeMemory(*ZipCodeUTF8)
EndIf
EndProcedure
Procedure SendClearList()
Protected *ClearListdata.COPYDATASTRUCT = AllocateMemory(SizeOf(COPYDATASTRUCT))
With *ClearListdata
\dwData = #ClearList_Message
\cbData = #Null
\lpData = #Null
EndWith
SendMessage_(Send2Window, #WM_COPYDATA, #Null, *ClearListdata)
EndProcedure
Procedure SendString(String2Send.s)
Protected *stringdata.COPYDATASTRUCT = AllocateMemory(SizeOf(COPYDATASTRUCT))
With *stringdata
\dwData = #String_Message
\cbData = StringByteLength(String2Send) + SizeOf(Character)
\lpData = @String2Send
EndWith
SendMessage_(Send2Window, #WM_COPYDATA, #Null, *stringdata)
EndProcedure
Procedure SendWindowPlacement(Window)
Protected WinPlact.WINDOWPLACEMENT
Protected *PosSizedata.COPYDATASTRUCT = AllocateMemory(SizeOf(COPYDATASTRUCT))
GetWindowPlacement_(WindowID(Window), @WinPlact)
With *PosSizedata
\dwData = #PosSize_Message
\cbData = SizeOf(WINDOWPLACEMENT)
\lpData = WinPlact
EndWith
SendMessage_(Send2Window, #WM_COPYDATA, #Null, *PosSizedata)
EndProcedure
Procedure SendWindowID(Window)
Protected IDWindow
Protected *Send2Windowdata.COPYDATASTRUCT = AllocateMemory(SizeOf(COPYDATASTRUCT))
If IsWindow(Window)
IDWindow = WindowID(#MainWindow)
EndIf
With *Send2Windowdata
\dwData = #Send2Window_Message
\cbData = SizeOf(Integer)
\lpData = @IDWindow
EndWith
SendMessage_(Send2Window, #WM_COPYDATA, #Null, *Send2Windowdata)
EndProcedure
;-------------------------
Procedure InitList(TabID)
; ZIP Code LF City LF County LF Type, Copied from https://www.zip-codes.com/state/fl.asp
Select TabID
Case 0
SetGadgetState(#Btn_Tab_1, #True) : SetGadgetState(#Btn_Tab_2, #False)
AddGadgetItem(#ListIcon, -1, "32003" +#LF$+ "Fleming Island" +#LF$+ "Clay" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32004" +#LF$+ "Ponte Vedra Beach" +#LF$+ "Saint Johns" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "32006" +#LF$+ "Fleming Island" +#LF$+ "Clay" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "32007" +#LF$+ "Bostwick" +#LF$+ "Putnam" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "32008" +#LF$+ "Branford" +#LF$+ "Suwannee" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32009" +#LF$+ "Bryceville" +#LF$+ "Nassau" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32011" +#LF$+ "Callahan" +#LF$+ "Nassau" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32013" +#LF$+ "Day" +#LF$+ "Lafayette" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "32024" +#LF$+ "Lake City" +#LF$+ "Columbia" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32025" +#LF$+ "Lake City" +#LF$+ "Columbia" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32030" +#LF$+ "Doctors Inlet" +#LF$+ "Clay" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "32033" +#LF$+ "Elkton" +#LF$+ "Saint Johns" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32034" +#LF$+ "Fernandina Beach" +#LF$+ "Nassau" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "32035" +#LF$+ "Fernandina Beach" +#LF$+ "Nassau" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "32038" +#LF$+ "Fort White" +#LF$+ "Columbia" +#LF$+ "Standard")
Case 1
SetGadgetState(#Btn_Tab_2, #True) : SetGadgetState(#Btn_Tab_1, #False)
AddGadgetItem(#ListIcon, -1, "90267" +#LF$+ "Manhattan Beach" +#LF$+ "Los Angeles" +#LF$+ "P.O. Box")
AddGadgetItem(#ListIcon, -1, "90270" +#LF$+ "Maywood" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90272" +#LF$+ "Pacific Palisades" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90274" +#LF$+ "Palos Verdes Peninsula" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90275" +#LF$+ "Rancho Palos Verdes" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90277" +#LF$+ "Redondo Beach" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90280" +#LF$+ "South Gate" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90290" +#LF$+ "Topanga" +#LF$+ "Los Angeles" +#LF$+ "Standard")
AddGadgetItem(#ListIcon, -1, "90291" +#LF$+ "Venice" +#LF$+ "Los Angeles" +#LF$+ "Standard")
EndSelect
EndProcedure
Procedure Resize_MainWindow()
Static ToolBarHeight
Protected MainWindow_WidthIni = 520, MainWindow_HeightIni = 360
Protected ScaleX.f, ScaleY.f
If ToolBarHeight = 0
ToolBarHeight = ToolBarHeight(#ToolBar)
EndIf
MainWindow_HeightIni - ToolBarHeight
ScaleX = WindowWidth(#MainWindow) / MainWindow_WidthIni : ScaleY = (WindowHeight(#MainWindow) - ToolBarHeight) / MainWindow_HeightIni
ResizeGadget(#Btn_Tab_1, ScaleX * 10, ToolBarHeight + ScaleY * (44 - ToolBarHeight), ScaleX * 120, ScaleY * 24)
ResizeGadget(#Btn_Tab_2, ScaleX * 130, ToolBarHeight + ScaleY * (44 - ToolBarHeight), ScaleX * 120, ScaleY * 24)
ResizeGadget(#ProcessText, ScaleX * 260, ToolBarHeight + ScaleY * (45 - ToolBarHeight), ScaleX * 90, ScaleY * 22)
ResizeGadget(#RcvProcessText, ScaleX * 350, ToolBarHeight + ScaleY * (45 - ToolBarHeight), ScaleX * 160, ScaleY * 22)
ResizeGadget(#Frame, ScaleX * 10, ToolBarHeight + ScaleY * (68 - ToolBarHeight), ScaleX * 500, ScaleY * 276)
ResizeGadget(#ListIcon, ScaleX * 20, ToolBarHeight + ScaleY * (84 - ToolBarHeight), ScaleX * 480, ScaleY * 250)
EndProcedure
Procedure ToolBar_MainWindow()
Protected Image
If CreateToolBar(#ToolBar, WindowID(#MainWindow), #PB_ToolBar_Small | #PB_ToolBar_Text)
Image = CatchImage(#PB_Any, ?ToolBarIcon_Cut)
ToolBarImageButton(#Menu_Cut, ImageID(Image), #PB_ToolBar_Normal, " Cut ")
FreeImage(Image)
ToolBarToolTip(#ToolBar, #Menu_Cut, "Cut (Ctrl+X)")
AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Control | #PB_Shortcut_X, #Menu_Cut)
Image = CatchImage(#PB_Any, ?ToolBarIcon_Copy)
ToolBarImageButton(#Menu_Copy, ImageID(Image), #PB_ToolBar_Normal, " Copy")
FreeImage(Image)
ToolBarToolTip(#ToolBar, #Menu_Copy, "Copy (Ctrl+C)")
AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Control | #PB_Shortcut_C, #Menu_Copy)
Image = CatchImage(#PB_Any, ?ToolBarIcon_Paste)
ToolBarImageButton(#Menu_Paste, ImageID(Image), #PB_ToolBar_Normal, "Paste")
FreeImage(Image)
ToolBarToolTip(#ToolBar, #Menu_Paste, "Paste (Ctrl+V)")
AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Control | #PB_Shortcut_V, #Menu_Paste)
ToolBarSeparator()
EndIf
DataSection
ToolBarIcon_Cut: : IncludeBinary #PB_Compiler_Home + "examples/sources/Data/ToolBar/Cut.png"
ToolBarIcon_Copy: : IncludeBinary #PB_Compiler_Home + "examples/sources/Data/ToolBar/Copy.png"
ToolBarIcon_Paste: : IncludeBinary #PB_Compiler_Home + "examples/sources/Data/ToolBar/Paste.png"
EndDataSection
EndProcedure
Procedure Open_MainWindow(X = 0, Y = 0, Width = 520, Height = 360)
#WindowFlag = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget |#PB_Window_SizeGadget | #PB_Window_ScreenCentered | #PB_Window_Invisible
If OpenWindow(#MainWindow, X, Y, Width, Height, "Run2exeAsTab", #WindowFlag)
ToolBar_MainWindow()
ButtonGadget(#Btn_Tab_1, 10, 44, 120, 24, "Tab_Process_1", #PB_Button_Toggle)
ButtonGadget(#Btn_Tab_2, 130, 44, 120, 24, "Tab_Process_2", #PB_Button_Toggle)
TextGadget(#ProcessText, 260, 45, 90, 22, "Process: " + Str(GetCurrentProcessId_()), #PB_Text_Center | #SS_CENTERIMAGE)
TextGadget(#RcvProcessText, 350, 45, 160, 22, "", #PB_Text_Center | #PB_Text_Border | #SS_CENTERIMAGE)
FrameGadget(#Frame, 10, 68, 500, 276, "Frame", #PB_Frame_Double)
ListIconGadget(#ListIcon, 20, 84, 480, 250, "Zip Code", 80, #PB_ListIcon_MultiSelect | #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListIcon, 1, "City", 160)
AddGadgetColumn(#ListIcon, 2, "County", 120)
AddGadgetColumn(#ListIcon, 3, "Type", 120-GetSystemMetrics_(#SM_CXVSCROLL)-1)
BindEvent(#PB_Event_SizeWindow, @Resize_MainWindow(), #MainWindow)
PostEvent(#PB_Event_SizeWindow, #MainWindow, 0)
SetWindowCallback(@WinCallback(), #MainWindow)
ProcedureReturn #True
EndIf
EndProcedure
;-------------------------
;- Main Program
Define TabID
SetAppUserModelID()
If Open_MainWindow()
If CountProgramParameters()
TabID = Val(ProgramParameter(0))
Send2Window = Val(ProgramParameter(1))
SendWindowID(#MainWindow)
SetGadgetState(#Btn_Tab_1, #False) : SetGadgetState(#Btn_Tab_2, #True)
SetGadgetColor(#RcvProcessText, #PB_Gadget_BackColor, $F0F8FF)
SetGadgetColor(#ListIcon, #PB_Gadget_BackColor, $F0F8FF)
InitList(TabID)
Else
TabID = 0
SetGadgetState(#Btn_Tab_1, #True) : SetGadgetState(#Btn_Tab_2, #False)
SetGadgetColor(#RcvProcessText, #PB_Gadget_BackColor, $FFF8F0)
SetGadgetColor(#ListIcon, #PB_Gadget_BackColor, $FFF8F0)
InitList(TabID)
HideWindow(#MainWindow, #False)
EndIf
;- Event Loop
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
If Send2Window
SendWindowID(#PB_Default)
SendString("Closed Process: " + Str(GetCurrentProcessId_()))
SendWindowPlacement(#MainWindow)
EndIf
;PostMessage_(Send2Window, #WM_SYSCOMMAND, #SC_CLOSE, 0)
Break
Case #PB_Event_Menu
Select EventMenu()
Case #Menu_Cut
CopyZipCode(#Menu_Cut)
Case #Menu_Copy
CopyZipCode()
Case #Menu_Paste
PasteZipCode()
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #Btn_Tab_1
If TabID = 1
SetGadgetState(#Btn_Tab_1, #False)
If Send2Window
SendString("Hello from Process: " + Str(GetCurrentProcessId_()))
SendWindowPlacement(#MainWindow)
Else
RunProgram(ProgramFilename(), Str(TabID ! 1) +" "+ Str(WindowID(#MainWindow)), GetPathPart(ProgramFilename()))
EndIf
Else
SetGadgetState(#Btn_Tab_1, #True)
EndIf
Case #Btn_Tab_2
If TabID = 0
SetGadgetState(#Btn_Tab_2, #False)
If Send2Window
SetGadgetState(#Btn_Tab_2, #False)
SendString("Hello from Process: " + Str(GetCurrentProcessId_()))
SendWindowPlacement(#MainWindow)
Else
RunProgram(ProgramFilename(), Str(TabID ! 1) +" "+ Str(WindowID(#MainWindow)), GetPathPart(ProgramFilename()))
EndIf
Else
SetGadgetState(#Btn_Tab_2, #True)
EndIf
EndSelect
EndSelect
ForEver
EndIf