Results 1 to 3 of 3

Thread: Splash Screens for LISP

  1. #1
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Splash Screens for LISP

    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...ature=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

    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.
    Last edited by peter; 2014-01-17 at 12:54 AM.
    AutomateCAD

  2. #2
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Splash Screens for LISP

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

    The AUGISplashScreen.zip is the demo folder.

    Code:
        ''' <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
    Attached Files Attached Files
    Last edited by peter; 2014-01-17 at 01:03 AM.
    AutomateCAD

  3. #3
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Splash Screens for LISP

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

    Code:
    (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)
    )
    AutomateCAD

Similar Threads

  1. 2011: 2 Screens revert to one
    By MikeJarosz in forum Revit Architecture - General
    Replies: 5
    Last Post: 2012-03-27, 09:02 PM
  2. Two screens
    By MikeJarosz in forum VBA/COM Interop
    Replies: 3
    Last Post: 2009-02-04, 02:24 PM
  3. screens
    By lila in forum Revit Architecture - General
    Replies: 5
    Last Post: 2006-09-25, 05:22 PM
  4. Spanning Two Screens
    By ralston in forum AutoCAD General
    Replies: 3
    Last Post: 2004-08-12, 09:38 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •