Login
`
Templates, Tools and Utilities
|
||
Add a comment to an Icetips ArticlePlease add your comments to this article.
Please note that you must provide both a name and a valid email address in order
for us to publish your comment. Comments are moderated and are not visible until they have been approved. Spam is never approved!
Back to article list Search Articles Add Comment Printer friendly Direct link Par2: Thread Limiter template with optional user notification 2006-12-01 -- Theo von Solms #TEMPLATE(ThreadLimiter,' Thread Limiter '),FAMILY('ABC')
#!----------------------------------------------------------------
#! Thread Limiter
#! By Jim DeFabia (EMAIL: jim-d@topspeed.com)
#!
#! Please Do Not redistribute without permission from Author
#!---------------------------------------------------------------
#EXTENSION(LimitStarts,'Limits a Procedure to One Start only '),PROCEDURE
#AT(%GlobalData)
GLO:RUNNING:%Procedure BYTE
#ENDAT
#LOCALDATA
LOC:RUNNING BYTE
LOC:ProcName CSTRING(30)
#ENDLOCALDATA
#SHEET
#TAB('LimitStarts - Limits a Procedure to One Start only ')
#DISPLAY ('Original Template written by: Jim DeFabia'), AT(10,,180,16), PROP(PROP:FontColor, 00FF0000h)
#DISPLAY (' EMAIL: jim-d@topspeed.com')
#DISPLAY (' ')
#DISPLAY ('Available for download from Steve Parkers Place at www.par2.com'), AT(10,,180,16)
#DISPLAY (' ')
#DISPLAY ('Enhanced by Theo von Solms - 1 Dec 2006'), PROP(PROP:FontColor, 00FF0000h)
#DISPLAY (' EMAIL: innopt@iafrica.com')
#DISPLAY ('Added the option to display a warning message (which includes the procedure name) to the user
at runtime.'), AT(10,,180,32)
#DISPLAY (' ')
#PROMPT (' Include a warning message?',CHECK),%WarnMessage,DEFAULT('1'),AT(10,)
#DISPLAY (' ')
#ENDTAB
#ENDSHEET
#AT(%WindowManagerMethodCodeSection,'Init','(),BYTE'),FIRST
GlobalErrors.SetProcedureName('%Procedure')
IF GlobalRequest <> SelectRecord
IF NOT GLO:RUNNING:%Procedure
GLO:RUNNING:%Procedure=THREAD()
LOC:RUNNING= GLO:RUNNING:%Procedure
ELSE
#IF(%WarnMessage)
LOC:ProcName = GlobalErrors.GetProcedureName()
Message(' A copy of ' & LOC:ProcName & ' is already running.| Only one instance is permitted at a
time.','WARNING',ICON:Hand)
#ENDIF
POST(EVENT:GainFocus,,GLO:RUNNING:%Procedure)
RETURN(Level:Fatal)
END
END
#ENDAT
#AT (%WindowEventHandling,'GainFocus'),FIRST
%window{PROP:Active}=TRUE
IF %window{PROP:Iconize}=TRUE
%window{PROP:Iconize}=''
END
#ENDAT
#AT(%WindowManagerMethodCodeSection,'Kill','(),BYTE'),LAST
IF LOC:RUNNING
GLO:RUNNING:%Procedure=0
END
#ENDAT
Today is December 3, 2024, 11:24 am This article has been viewed 35258 times.
|
|