GFInfoTrailer/Testfrm.frm
VERSION 5.00
Begin VB.Form Testfrm
Caption = "Form1"
ClientHeight = 5310
ClientLeft = 60
ClientTop = 345
ClientWidth = 6585
LinkTopic = "Form1"
ScaleHeight = 5310
ScaleWidth = 6585
StartUpPosition = 3 'Windows‑Standard
Begin VB.CommandButton Command2
Caption = "End"
Height = 375
Left = 3000
TabIndex = 1
Top = 4920
Width = 1755
End
Begin VB.PictureBox Picture2
BackColor = &H00808080&
BorderStyle = 0 'Kein
Height = 3855
Left = 0
ScaleHeight = 257
ScaleMode = 3 'Pixel
ScaleWidth = 437
TabIndex = 2
Top = 420
Width = 6555
End
Begin VB.CommandButton Command1
Caption = "Show!"
Height = 375
Left = 4800
TabIndex = 0
Top = 4920
Width = 1755
End
Begin VB.PictureBox Picture1
BackColor = &H00808080&
BorderStyle = 0 'Kein
Height = 3795
Left = ‑60
ScaleHeight = 253
ScaleMode = 3 'Pixel
ScaleWidth = 437
TabIndex = 3
Top = 420
Width = 6555
End
Begin VB.Shape Shape2
FillStyle = 0 'Ausgef�llt
Height = 435
Left = 0
Top = 0
Width = 6555
End
Begin VB.Shape Shape1
FillStyle = 0 'Ausgef�llt
Height = 435
Left = 0
Top = 4200
Width = 6555
End
End
Attribute VB_Name = "Testfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2004 by Louis. Form to test GFInfoTrailer.
'
'Downloadd from www.louis‑coder.com.
'You can use the GFInfoTrailer to create cinema‑like credit shows, etc.
'Add GFInfoTrailerfrm, GFInfoTrailermod, AnimationControlmod and
'GFInfoTrailer_Layercls to your project. The interface calls are to be
'done like in Command1_Click (sample).
'Everything works, except playing AVI files and you can use one layer
'only. The second and third layer should have been used to create
'effects like floating through space (in the background stars fly by), but
'that didn't work at once. You can update the code and offer it on the
'Internet, but you MUST retain the original copyright notice and this
'info text. Sample usage: Toricxs (www.toricxs.com).
Private Sub Form_Load()
'on error resume next
'nothing to do
End Sub
'NOTE: call the following procedures in the given order
'to make the GFInfoTrailer work correctly:
'
'‑GFInfoTrailer_Initialize()
'‑L1.x
'‑DrawLoop(0)
'‑GFInfoTrailer_Destroy.
'
'Call these procedures again in the given order when
'restarting the info trailer.
'
'NOTE: the stuff visible in DrawCollectingPicture is the same
'as that in DrawTargetPicture.
'
'ObjectImagePicture([layer index]): size fits to object to create,
'image is created once and then transferred to:
'CreationPicture([layer index]): image is moved and transferred to:
'DrawCollectionPicture: 'buffer' to avoid flickering in:
'DrawTargetPicture: displays final image.
Private Sub Command1_Click()
'on error resume next
Dim ProgramPath As String
Dim Temp As Long
'verify
For Temp = 1 To 100
'
'NOTE: do the authorization process several times as it uses the Time$
'value, which could be changed between authorization string creation
'and verifying.
'
If GFInfoTrailer_GetAuthorization(GFInfoTrailer_CreateAuthorizationString()) = True Then Exit For
Next Temp
'preset
ProgramPath = App.Path
If Not (Right$(ProgramPath, 1) = "\") Then ProgramPath = ProgramPath + "\" 'verify
Call GFInfoTrailer_Initialize(Me.Picture1, Me.Picture2)
Call l1.Layer_AddFont("Arial", 8, False, False, False, False, RGB(220, 220, 220), l1.GetTrailerWidth, "default")
Call l1.Layer_AddFont("Arial", 16, True, False, True, False, RGB(255, 255, 255), l1.GetTrailerWidth, "headline")
Call l1.Layer_MoveToYPos(CSng(l1.GetTrailerHeight) * 0.45!)
Call l1.Layer_AddObject(CONST_SPEEDCONTROL, "50", "")
Call l1.Layer_AddObject(CONST_TEXT, "", "headline", 0)
Call l1.Layer_AddObject(CONST_TEXT, "GFInfoTrailer", "headline", CONST_CENTERED, "headline")
Call l1.Layer_MoveYPos(l1.GETLASTADDEDSIZEOBJECTHEIGHT)
Call l1.Layer_AddObject(CONST_TEXT, "(c)2001 by Louis.", "", CONST_LEFT)
Call l1.Layer_AddObject(CONST_TEXT, "to be used in any project", "", CONST_RIGHT)
Call l1.Layer_MoveYPos(CSng(l1.GetTrailerHeight) * 0.45!)
Call l1.Layer_AddObject(CONST_PAUSE, "5", "")
Call l1.Layer_MoveYPos(l1.GetTrailerHeight / 2)
Call l1.Layer_AddObject(CONST_WAVE, ProgramPath + "toccatad.wav", "")
Call l1.Layer_AddObject(CONST_PICTURE, ProgramPath + "winset.bmp", "", CONST_LEFT, "picture")
Call l1.Layer_AddObject(CONST_TEXT, l1.GetTextBlock("NOTE: please don't copy software. Piracy is not good for the economy!", "", l1.GetTrailerWidth ‑ l1.GetObjectWidth(LASTADDEDOBJECT)), "", CONST_RIGHT)
Call l1.Layer_MoveYPos(l1.GetObjectYSize("picture"))
Call l1.Layer_AddObject(CONST_PAUSE, "5", "")
Call l1.Layer_AddObject(CONST_TEXT, "Now comes a view through our new telescope, we'll go a bit slower so that you can watch it..", "")
Call l1.Layer_MoveYPos(l1.GETLASTADDEDSIZEOBJECTHEIGHT)
Call l1.Layer_AddObject(CONST_SPEEDCONTROL, "25", "")
Call l1.Layer_AddObject(CONST_PICTURE, ProgramPath + "space_fog.jpg", "", CONST_CENTERED, "picture 2")
Call l1.Layer_MoveYPos(20)
Call l1.Layer_AddObject(CONST_SPEEDCONTROL, "100", "")
Call l1.Layer_AddObject(CONST_QUAKE, "", "")
Call l1.Layer_MoveYPos(10)
Call l1.Layer_AddObject(CONST_QUAKE, "", "")
Call l1.Layer_MoveYPos(5)
Call l1.Layer_AddObject(CONST_QUAKE, "", "")
Call l1.Layer_AddObject(CONST_SPEEDCONTROL, "25", "")
Call l1.Layer_MoveYPos(l1.GetObjectYSize("picture 2"))
Call l1.Layer_AddObject(CONST_SPEEDCONTROL, "50", "")
Call l1.Layer_AddObject(CONST_WAVE, ProgramPath + "outro.wav", "")
'Call l1.Layer_AddObject(CONST_AVI, ProgramPath + "FINDFILE.AVI", "‑1")
Call l1.SetObjectYSize(LASTADDEDOBJECT, 80)
'Call L2.Layer_AddObject(CONST_SPEEDCONTROL, "70", "")
'Call L2.Layer_AddObject(CONST_PICTURE, ProgramPath + "stars.bmp", "", 0)
'Call L2.Layer_MoveYPos(L2.GETLASTADDEDSIZEOBJECTHEIGHT)
'Call L2.Layer_AddObject(CONST_PICTURE, ProgramPath + "stars.bmp", "", 0)
'Call L3.Layer_AddObject(CONST_SPEEDCONTROL, "70", "")
'Call L3.Layer_AddObject(CONST_PICTURE, ProgramPath + "stars.bmp", "", 0)
'Call L3.Layer_MoveYPos(L3.GETLASTADDEDSIZEOBJECTHEIGHT)
'Call L3.Layer_AddObject(CONST_PICTURE, ProgramPath + "stars.bmp", "", 0)
'begin
Call DrawLoop(0)
Call GFInfoTrailer_Destroy
End Sub
Private Sub Command2_Click()
'on error resume next
Call DrawLoop_Exit
End Sub
Private Function GFInfoTrailer_CreateAuthorizationString() As String
'on error resume next 'copy to the target project, together with EncryptString()
Dim EncryptionKeyWord As String
EncryptionKeyWord = Chr$(77) + Chr$(97) + Chr$(116) + Chr$(116) + Chr$(105) + Chr$(97) + Chr$(115) + Chr$(32) + Chr$(77) + Chr$(117) + Chr$(101) + Chr$(108) + Chr$(108) + Chr$(101) + Chr$(114)
'begin
GFInfoTrailer_CreateAuthorizationString = EncryptString(EncryptString(EncryptString(Date$ + " " + Time$, EncryptionKeyWord), Str$(Screen.FontCount)), Str$(CLng(Sqr(GFInfoTrailer_GetForegroundWindow()) * 3.14!)))
End Function
Private Function EncryptString(ByVal EncryptionString As String, ByVal EncryptionKeyWord As String) As String
'on error resume next
Dim KeyWordPos As Long
Dim Temp As Long
'verify
If Len(EncryptionKeyWord) = 0 Then
EncryptString = EncryptionString
End If
'preset
EncryptString = String$(Len(EncryptionString), Chr$(0))
'begin
For Temp = 1 To Len(EncryptionString)
KeyWordPos = KeyWordPos + 1
If KeyWordPos > Len(EncryptionKeyWord) Then KeyWordPos = 1
Mid$(EncryptString, Temp, 1) = Chr$(Asc(Mid$(EncryptionString, Temp, 1)) Xor Asc(Mid$(EncryptionKeyWord, KeyWordPos, 1)))
Next Temp
End Function
Private Sub Form_Unload(Cancel As Integer)
'on error resume next
Call DrawLoop_Exit
Call GFInfoTrailer_Destroy
End
End Sub
[END OF FILE]