Initial commit

.gitattributes

@@ -0,0 +1,86 @@
+# VB6 source files (show diff + keep CRLF in zip download)
+
+*.bas        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.cls        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.ctl        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.dob        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.dsr        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.frm        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.pag        working-tree-encoding=CP1252 text eol=crlf linguist-language=vb6
+*.vbg        working-tree-encoding=CP1252 text eol=crlf
+*.vbl        working-tree-encoding=CP1252 text eol=crlf
+*.vbp        working-tree-encoding=CP1252 text eol=crlf
+*.vbr        working-tree-encoding=CP1252 text eol=crlf
+*.vbw        working-tree-encoding=CP1252 text eol=crlf
+
+# Other source files (show diff + LF only in zip download)
+
+*.asm        text
+*.asp        text
+*.bat        text
+*.c          text
+*.cpp        text
+*.dsp        text
+*.dsw        text
+*.h          text
+*.idl        text
+*.java       text
+*.js         text
+*.manifest   text
+*.odl        text
+*.php        text
+*.php3       text
+*.rc         text
+*.sln        text
+*.sql        text
+*.vb         text
+*.vbs        text
+
+# Binary
+
+*.res        binary
+*.frx        binary
+*.ctx        binary
+*.dsx        binary
+*.exe        binary
+*.dll        binary
+*.ocx        binary
+*.cmp        binary
+*.pdb        binary
+*.tlb        binary
+*.xls        binary
+*.doc        binary
+*.ppt        binary
+*.xlsx       binary
+*.docx       binary
+*.pptx       binary
+*.chm        binary
+*.hlp        binary
+*.jpg        binary
+*.png        binary
+*.bmp        binary
+*.gif        binary
+*.ico        binary
+*.zip        binary
+*.cab        binary
+*.7z         binary
+*.gz         binary
+
+# Text files but keep as binary (no diff)
+
+# *.cfg        text
+# *.conf       text
+# *.csi        text
+# *.css        text
+# *.csv        text
+# *.def        text
+# *.htm        text
+# *.html       text
+# *.inf        text
+# *.ini        text
+# *.log        text
+# *.reg        text
+# *.rtf        text
+# *.txt        text
+# *.url        text
+# *.xml        text

.gitignore

@@ -0,0 +1,6 @@
+*.scc
+*.dca
+*.oca
+*.obj
+vb*.tmp
+@PSC*

AriadIFceComp.bas

@@ -0,0 +1,294 @@
+Attribute VB_Name = "basAriadIFceComp"
+
+'-------------------------------'
+' Ariad Development Library 2.0 '
+'-------------------------------'
+'    Ariad Interface Components '
+'                   Version 1.0 '
+'-------------------------------'
+'          Core Routines Module '
+'-------------------------------'
+'Copyright © 1998-9 by Ariad Software. All Rights Reserved
+
+'Date Created:
+'Last Updated:
+
+Option Explicit
+DefInt A-Z
+
+'PlaySoundA Constants
+Public Const SND_ASYNC = &H1             '  play asynchronously
+Public Const SND_NODEFAULT = &H2         '  silence not default, if sound not found
+Public Const SND_MEMORY = &H4            '  lpszSoundName points to a memory file
+
+Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
+Public Declare Function GetActiveWindow Lib "user32" () As Long
+Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
+Public Declare Function GetDesktopWindow Lib "user32" () As Long
+Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
+Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
+Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
+Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
+Public Declare Function PlaySoundData Lib "WINMM.DLL" Alias "PlaySoundA" (lpData As Any, ByVal hModule As Long, ByVal dwFlags As Long) As Long
+Public Declare Function ReleaseCapture& Lib "user32" ()
+Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
+Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
+Public Declare Function SetCapture& Lib "user32" (ByVal hWnd As Long)
+Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
+Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
+Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
+Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
+Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
+
+Public Const SW_SHOWNOACTIVATE = 4
+
+Private Const HWND_TOP& = 0
+Private Const SWP_NOMOVE& = &H2
+Private Const SWP_NOACTIVATE& = &H10
+Private Const SWP_NOSIZE& = &H1
+Private Const SWP_SHOWWINDOW& = &H40
+
+Public PE As ascPaintEffects
+
+Public CtlCount As Long
+
+Public Const ASMAIL$ = "support@ariad.globalnet.co.uk"
+Public Const ASURL$ = "http://www.users.globalnet.co.uk/~ariad/"
+Public Const ASURL2$ = "http://www.ariad.tsx.org/"
+
+Public Const INTERR$ = "An unexpected application error has occured!"
+Public Const ERRTEXT$ = "If this problem continues, please contact Ariad technical support, at " + ASMAIL$ + ", quoting the above information."
+
+'-------------------------------
+'Name        : ShowPopupMenu
+'Created     : 27/08/1999 14:39
+'-------------------------------
+'Author      : Richard Moss
+'Organisation: Ariad Software
+'-------------------------------
+'Returns     : Nothing
+'
+'-------------------------------
+'Updates     :
+'
+'-------------------------------
+'---------AS-PROCBUILD 1.00.0024
+Public Sub ShowPopupMenu(hWndClient As Long, PopupMenu As Menu, PopupParent As Form)
+ Dim WinRect As RECT
+ Dim WinPoint As POINTAPI
+ Dim X As Single, Y As Single
+ Dim ScaleMode As ScaleModeConstants
+ ClientToScreen PopupParent.hWnd, WinPoint
+ GetWindowRect hWndClient, WinRect
+ If TypeOf PopupParent Is MDIForm Then
+  ScaleMode = vbTwips
+ Else
+  ScaleMode = PopupParent.ScaleMode
+ End If
+ X = PopupParent.ScaleX(WinRect.Left - WinPoint.X, vbPixels, ScaleMode)
+ Y = PopupParent.ScaleY(WinRect.Bottom - WinPoint.Y, vbPixels, ScaleMode)
+ PopupParent.PopupMenu PopupMenu, , X, Y
+End Sub '(Public) Sub ShowPopupMenu ()
+
+'----------------------------------------------------------------------
+'Name        : Highlight
+'Created     : 21/08/1999 23:07
+'Modified    :
+'Modified By :
+'----------------------------------------------------------------------
+'Author      : Richard James Moss
+'Organisation: Ariad Software
+'----------------------------------------------------------------------
+Public Sub Highlight(C As Control)
+ With C
+  .SelStart = 0
+  .SelLength = Len(.Text)
+ End With
+End Sub '(Public) Sub Highlight ()
+
+'----------------------------------------------------------------------
+'Name        : InitPaintEffects
+'Created     : 12/07/1999 14:51
+'Modified    :
+'Modified By :
+'----------------------------------------------------------------------
+'Author      : Richard James Moss
+'Organisation: Ariad Software
+'----------------------------------------------------------------------
+Public Sub InitPaintEffects()
+ If PE Is Nothing Then
+  Set PE = New ascPaintEffects
+ End If
+End Sub '(Public) Sub InitPaintEffects ()
+
+
+'----------------------------------------------------------------------
+'Name        : Main
+'Created     : 12/07/1999 14:40
+'Modified    :
+'Modified By :
+'----------------------------------------------------------------------
+'Author      : Richard James Moss
+'Organisation: Ariad Software
+'----------------------------------------------------------------------
+Public Sub Main()
+ Set PE = New ascPaintEffects
+End Sub '(Public) Sub Main ()
+
+Function StartDocError$(R As Long)
+ Dim M$
+ If R >= 0 Then
+  Select Case R
+   Case 0: M$ = "System was out of memory or executable file was corrupt."
+   Case 2: M$ = "The file was not found."
+   Case 3: M$ = "The path was not found."
+   Case 5: M$ = "Attempt was made to link to a task dynamically, or there was a sharing or network-protection error."
+   Case 6: M$ = "Library required separate data segments for each task."
+   Case 8: M$ = "There was insufficient memory to start the application."
+   Case 10: M$ = "The Windows version was incorrect."
+   Case 11: M$ = "The executable file was invalid. Either it was not a Windows-based application or there was an error in the .EXE image."
+   Case 12: M$ = "Application was designed for a different operating system."
+   Case 13: M$ = "Application was designed for MS-DOS version 4.0."
+   Case 14: M$ = "Type of executable file was unknown."
+   Case 15: M$ = "Attempt was made to load a real-mode application that was developed for an earlier version of Windows."
+   Case 16: M$ = "Attempt was made to load a second instance of an executable file containing multiple data segments not marked read-only."
+   Case 19: M$ = "Attempt was made to load a compressed executable file. The file must be decompressed before it can be loaded."
+   Case 20: M$ = "Dynamic-link library (DLL) file was invalid. One of the DLLs required to run this application was corrupt."
+   Case 21: M$ = "Application requires Microsoft Windows 32-bit extensions."
+   Case 31: M$ = "No application has been associated for use with specified document."
+   Case Else: M$ = "Unknown Error."
+  End Select
+ Else
+  M$ = "Unknown error."
+ End If
+ StartDocError$ = M$ + Chr$(10) + Chr$(10) + "(Error Code: " + CStr(R) + ")"
+End Function
+
+Function IsUsingLargeFonts() As Boolean
+ Dim hWndDesk As Long, hDCDesk As Long, logPix As Long, R As Long
+ hWndDesk = GetDesktopWindow()
+ hDCDesk = GetDC(hWndDesk)
+ logPix = GetDeviceCaps(hDCDesk, 88)
+ R = ReleaseDC(hWndDesk, hDCDesk)
+ If logPix > 96 Then IsUsingLargeFonts = -1
+End Function
+
+Function DegreeToRad(Deg As Integer) As Single
+ DegreeToRad = Deg / 57.295779513
+End Function
+
+Public Function RemoveExtension$(F$)
+ Dim R$(), E$
+ Dim I
+ If InStr(F$, ".") Then
+  R$ = Split(F$, ".")
+  For I = 0 To UBound(R$) - 1
+   E$ = E$ + R$(I) + "."
+  Next
+  RemoveExtension$ = Left$(E$, Len(E$) - 1)
+ Else
+  RemoveExtension$ = F$
+ End If
+End Function
+
+Function IsInControl(ByVal hWnd As Long) As Boolean
+ Dim P As POINTAPI
+ GetCursorPos P
+ If hWnd = WindowFromPoint(P.X, P.Y) Then IsInControl = -1
+End Function
+
+Public Function GetFile$(FP$)
+ Dim R$()
+ If Len(FP$) Then
+  R$() = Split(FP$, "\")
+  GetFile$ = R$(UBound(R$))
+ End If
+End Function
+
+Sub PlaySnd(SndName$, m_PlaySounds As Boolean)
+ Dim bySound() As Byte
+ On Error Resume Next
+  If m_PlaySounds Then
+   bySound = LoadResData(SndName$, 100)
+   If Err = 0 And UBound(bySound) > 0 Then
+    PlaySoundData bySound(0), 0, SND_MEMORY + SND_ASYNC + SND_NODEFAULT
+   End If
+  End If
+ On Error GoTo 0
+End Sub
+
+Public Function ShowTip(ByVal Tip$, ByVal hWnd As Long, Optional ByVal Font As StdFont) As Boolean
+ Const DX = -2   ' Offset from the mouse position.
+ Const DY = 18
+ Dim X As Long, Y As Long
+ Dim PT As POINTAPI
+ On Error Resume Next
+  GetCursorPos PT
+  X = PT.X
+  Y = PT.Y
+  HideTip
+  With frmTooltip
+   If Not Font Is Nothing Then
+    Set .lblTip.Font = Font
+    Set .Font = Font
+   End If
+   .lblTip.Width = .TextWidth(Tip$)
+   .lblTip.Caption = Tip$
+   .lblTip.Refresh
+   .CtlHWnd = hWnd
+   .Move (X + DX) * Screen.TwipsPerPixelX, (Y + DY) * Screen.TwipsPerPixelY, .lblTip.Width + (8 * Screen.TwipsPerPixelX), .lblTip.Height + (5 * Screen.TwipsPerPixelY)
+   .tmrTip.Enabled = 0
+   .tmrTip.Enabled = -1
+   If .Left + .Width > Screen.Width Then .Left = Screen.Width - .Width
+   If .Top + .Height > Screen.Height Then .Top = Screen.Height - .Height
+   SetWindowPos .hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
+  End With
+  ShowTip = -1
+ On Error GoTo 0
+End Function
+
+Function DefineAccessKey$(Caption$)
+ Dim P, N
+ Dim C$
+ N = 1
+ Do
+  P = InStr(N, Caption$, "&")
+  If P Then
+   C$ = Mid$(Caption$, P + 1, 1)
+   If C$ <> "&" Then DefineAccessKey$ = DefineAccessKey$ + C$
+   N = P + 1
+  End If
+ Loop Until P = 0
+End Function
+
+
+Public Sub HideTip()
+ On Error Resume Next
+  Unload frmTooltip
+ On Error GoTo 0
+End Sub
+
+
+Public Sub Pointer(V)
+ Screen.MousePointer = V
+End Sub
+
+
+
+Public Function UltimateParent(Ctl As Object) As Object
+ Dim O As Object, T As Object
+ On Error Resume Next
+  Set T = Ctl.Parent
+  Set UltimateParent = T
+  Do
+   Set O = T.Parent
+   If Not O Is Nothing Then
+    Set T = O
+    Set UltimateParent = O
+   End If
+  Loop Until O Is Nothing
+ On Error GoTo 0
+End Function
+