Splash Screens for LISP

[peter]

Hey Group,

I mentioned splash screens before and put together a simplified splash screen functions for LISP using the .net splash screen api.

http://www.youtube.com/watch?v=EbTgb_woWx4&feature=youtu.be

You can watch it in low resolution on you tube if you would like.

I wrote this using Visual Studio 2013 and AutoCAD 2014.

Here is the code




Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports objACADApplication = Autodesk.AutoCAD.ApplicationServices.Application

Imports System

'<Assembly: AssemblyVersion("1.0.0.1")>

' Lisp functions for displaying a splash screen

Public Class SplashScreenClass
Private objSplashScreen As New SplashScreen1()
Private tpvNil As New TypedValue(LispDataType.Nil, -1)
Private tpvTrue As New TypedValue(LispDataType.T_atom, -1)

''' <summary>
''' Function to display a splash screen for loading a program available to LISP
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_atom for success and nil for failure </returns>
''' <remarks> LISP Syntax: (splashscreen "MyImage.jpg" "My Title" "My Version" "My Copyright") </remarks>
<LispFunction("SplashScreen")> _
Public Function SplashScreenLISP(ByVal rbfLISPArguments As ResultBuffer)
Try
Dim arrLISPArguments As TypedValue() = rbfLISPArguments.AsArray()
Dim strApplicationTitle As String = ""
Dim strVersion As String = ""
Dim strCopyright As String = ""
Dim strImageName As String = ""
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)

If arrLISPArguments.Length > 0 Then
strImageName = arrLISPArguments(0).Value.ToString
End If

If arrLISPArguments.Length > 1 Then
strApplicationTitle = arrLISPArguments(1).Value.ToString
End If

If arrLISPArguments.Length > 2 Then
strVersion = arrLISPArguments(2).Value.ToString
End If

If arrLISPArguments.Length > 3 Then
strCopyright = arrLISPArguments(3).Value.ToString
End If

If SplashScreenNET(strImageName, strApplicationTitle, strVersion, strCopyright) Then
Return tpvTrue
End If

Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' Dot Net Base Function to create and show a splashscreen
''' </summary>
''' <param name="strImageName"></param>
''' <param name="strApplicationTitle"></param>
''' <param name="strVersion"></param>
''' <param name="strCopyright"></param>
''' <returns>True for success and False for failure</returns>
''' <remarks></remarks>
Public Function SplashScreenNET(Optional ByVal strImageName As String = "", _
Optional ByVal strApplicationTitle As String = "ApplicationTitle", _
Optional ByVal strVersion As String = "Version", _
Optional ByVal strCopyright As String = "Copyright"
)
Try
Dim objThisDrawing As Document = objACADApplication.DocumentManager.MdiActiveDocument
Dim strImageFullName As String

If strImageName = "" Or strImageName.ToUpper = "DefaultImage.jpg".ToUpper Then
objSplashScreen.MainLayoutPanel.BackgroundImage = My.Resources.Resource1.DefaultImage
SplashScreenTextBlack(Nothing)
ElseIf strImageName.ToUpper = "SplashImage.jpg".ToUpper Then
objSplashScreen.MainLayoutPanel.BackgroundImage = My.Resources.Resource1.splashimage
SplashScreenTextWhite(Nothing)
Else
strImageFullName = HostApplicationServices.Current.FindFile(strImageName, _
objThisDrawing.Database, FindFileHint.Default)
objSplashScreen.MainLayoutPanel.BackgroundImage = System.Drawing.Image.FromFile(strImageFullName)
End If

objSplashScreen.ApplicationTitle.Text = strApplicationTitle
objSplashScreen.Version.Text = strVersion
objSplashScreen.Copyright.Text = strCopyright

objSplashScreen.Show()
objSplashScreen.Update()

Return True
Catch ex As System.Exception
End Try

Return False
End Function

''' <summary>
''' LISP Function to change the Application Title text of a splash screen
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_atom for success and nil for failure </returns>
''' <remarks> LISP Syntax: (SplashScreenApplicationTitle "My Application") </remarks>
<LispFunction("SplashScreenApplicationTitle")> _
Public Function SplashScreenApplicationTitle(ByVal rbfLISPArguments As ResultBuffer)
Try
Dim arrLISPArguments As TypedValue() = rbfLISPArguments.AsArray()
If arrLISPArguments.Length > 0 Then
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.ApplicationTitle.Text = arrLISPArguments(0).Value.ToString
objSplashScreen.BringToFront()
objSplashScreen.Update()
Return tpvTrue
End If
Catch ex As System.Exception
End Try
Return tpvNil
End Function


''' <summary>
''' LISP Function to close the splash screen.
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns>T_Atom for success and Nil for Failure </returns>
''' <remarks> LISP Syntax: (splashscreenclose) </remarks>
<LispFunction("SplashScreenClose")> _
Public Function SplashScreenClose(ByVal rbfLISPArguments As ResultBuffer)
Try
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.Close()
objSplashScreen.Update()
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function
... See next post for rest of code.

[peter]

The rest of the story (for you Paul Harvey fans)

The AUGISplashScreen.zip is the demo folder.




''' <summary>
''' LISP Function to change the Copyright text of a splash screen
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_atom for success and nil for failure </returns>
''' <remarks> LISP Syntax: (SplashScreenCopyright "My Copyright") </remarks>
<LispFunction("SplashScreenCopyright")> _
Public Function SplashScreenCopyright(ByVal rbfLISPArguments As ResultBuffer)
Try
Dim arrLISPArguments As TypedValue() = rbfLISPArguments.AsArray()
If arrLISPArguments.Length > 0 Then
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.Copyright.Text = arrLISPArguments(0).Value.ToString
objSplashScreen.BringToFront()
objSplashScreen.Update()
Return tpvTrue
End If
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP Function to hide a splash screen
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_atom for success and nil for failure </returns>
''' <remarks> LISP Syntax: (SplashScreenHide) </remarks>
<LispFunction("SplashScreenHide")> _
Public Function SplashScreenHide(ByVal rbfLISPArguments As ResultBuffer)
Try
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.Hide()
objSplashScreen.Update()
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP Function to change the image to either default image or image file.
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_Atom for success and Nil for Failure </returns>
''' <remarks> LISP Syntax: (splashscreenImage "MyImageFile.jpg") </remarks>
<LispFunction("SplashScreenImage")> _
Public Function SplashScreenImage(ByVal rbfLISPArguments As ResultBuffer)
Try
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
Dim arrLISPArguments As TypedValue() = rbfLISPArguments.AsArray()
Dim strImageName As String = ""

If arrLISPArguments.Length > 0 Then
strImageName = arrLISPArguments(0).Value.ToString
End If
Dim strImageFullName As String

If strImageName = "" Or strImageName.ToUpper = "DefaultImage.jpg".ToUpper Then
objSplashScreen.MainLayoutPanel.BackgroundImage = My.Resources.Resource1.DefaultImage
SplashScreenTextBlack(Nothing)
ElseIf strImageName.ToUpper = "SplashImage.jpg".ToUpper Then
objSplashScreen.MainLayoutPanel.BackgroundImage = My.Resources.Resource1.splashimage
SplashScreenTextWhite(Nothing)
Else
Dim objThisDrawing As Document = objACADApplication.DocumentManager.MdiActiveDocument
strImageFullName = HostApplicationServices.Current.FindFile(strImageName, _
objThisDrawing.Database, FindFileHint.Default)
objSplashScreen.MainLayoutPanel.BackgroundImage = System.Drawing.Image.FromFile(strImageFullName)
End If
objSplashScreen.BringToFront()
objSplashScreen.Update()
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP Function to create a new splash screen.
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_Atom for success and Nil for Failure </returns>
''' <remarks> LISP Syntax (splashscreennew) </remarks>
<LispFunction("SplashScreenNew")> _
Public Function SplashScreenNew(ByVal rbfLISPArguments As ResultBuffer)
Try
objSplashScreen = New SplashScreen1
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP function to Show the splash screen.
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_Atom for success and Nil for Failure </returns>
''' <remarks> LISP Syntax: (splashscreenshow) </remarks>
<LispFunction("SplashScreenShow")> _
Public Function SplashScreenShow(ByVal rbfLISPArguments As ResultBuffer)
Try
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.Show()
objSplashScreen.Update()
objSplashScreen.BringToFront()
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP Function to change the Version text of a splash screen
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns>T_atom for success and nil for failure</returns>
''' <remarks>LISP Syntax: (SplashScreenCopyright "My Copyright") </remarks>
<LispFunction("SplashScreenVersion")> _
Public Function SplashScreenVersion(ByVal rbfLISPArguments As ResultBuffer)
Try
Dim arrLISPArguments As TypedValue() = rbfLISPArguments.AsArray()
If arrLISPArguments.Length > 0 Then
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.Version.Text = arrLISPArguments(0).Value.ToString
objSplashScreen.BringToFront()
objSplashScreen.Update()
Return tpvTrue
End If
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP Function to change the color of the text in the splash screen to black.
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns>T_Atom for success and Nil for Failure </returns>
''' <remarks>LISP Syntax: (splashscreentextblack) </remarks>
<LispFunction("SplashScreenTextBlack")> _
Public Function SplashScreenTextBlack(ByVal rbfLISPArguments As ResultBuffer)
Try
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.ApplicationTitle.ForeColor = Drawing.Color.Black
objSplashScreen.Copyright.ForeColor = Drawing.Color.Black
objSplashScreen.Version.ForeColor = Drawing.Color.Black
objSplashScreen.BringToFront()
objSplashScreen.Update()
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function

''' <summary>
''' LISP Function to change the color of the text in the splash screen to white.
''' </summary>
''' <param name="rbfLISPArguments"></param>
''' <returns> T_Atom for success and Nil for Failure </returns>
''' <remarks> LISP Syntax: (splashscreentextwhite) </remarks>
<LispFunction("SplashScreenTextWhite")> _
Public Function SplashScreenTextWhite(ByVal rbfLISPArguments As ResultBuffer)
Try
If objSplashScreen Is Nothing Then SplashScreenNew(Nothing)
objSplashScreen.ApplicationTitle.ForeColor = Drawing.Color.White
objSplashScreen.Copyright.ForeColor = Drawing.Color.White
objSplashScreen.Version.ForeColor = Drawing.Color.White
objSplashScreen.BringToFront()
objSplashScreen.Update()
Return tpvTrue
Catch ex As System.Exception
End Try
Return tpvNil
End Function
End Class

[peter]

This is the lisp test code calling the functions exposed in the assembly.



(defun C:SplashTest ()

(setq intDelay 1000 )
(setq x 0)
(while (< x 10)
(splashscreennew)

(command "delay" intDelay)
(splashscreen "" "My Application Title" "My Version" "My Copyright") ; Start Blank

(command "delay" intDelay)
(splashscreentextwhite)

(command "delay" intDelay)
(splashscreenimage (findfile "photo1.jpg")) ; External Files 1-5

(command "delay" intDelay)
(splashscreenimage (findfile "photo2.jpg"))

(command "delay" intDelay)
(splashscreenimage (findfile "photo3.jpg"))

(command "delay" intDelay)
(splashscreenimage (findfile "photo4.jpg"))

(command "delay" intDelay)
(splashscreenimage (findfile "photo5.jpg"))

(command "delay" intDelay)
(splashscreenimage "splashimage.jpg"); Embedded Resource Image

(command "delay" intDelay)
(splashscreenhide)

(command "delay" intDelay)
(splashscreenshow)

(command "delay" intDelay)
(splashscreenApplicationtitle "My New Applciation Title")

(command "delay" intDelay)
(splashscreenVersion "My New Version")

(command "delay" intDelay)
(splashscreenCopyright "My New Copyright")

(command "delay" intDelay)
(splashscreenClose)
(setq x (1+ x))
)
(princ "\nDone!")
(prin1)
)