Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/test_lay/testlay.frm

Visual Basic Form | 1994-05-18 | 5.2 KB | 168 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Test Grid Save Layout"
   ClientHeight    =   3960
   ClientLeft      =   2145
   ClientTop       =   2445
   ClientWidth     =   7830
   Height          =   4650
   Icon            =   TESTLAY.FRX:0000
   Left            =   2085
   LinkTopic       =   "Form1"
   ScaleHeight     =   3960
   ScaleWidth      =   7830
   Top             =   1815
   Width           =   7950
   Begin TrueGrid Table1
      AllowArrows     =   -1  'True
      AllowTabs       =   -1  'True
      BackColor       =   &H00C0C0C0&
      DataSource      =   "Data1"
      Editable        =   -1  'True
      EditDropDown    =   -1  'True
      ExposeCellMode  =   0  'Expose upon selection
      FetchMode       =   0  'By cell
      HeadingHeight   =   1
      Height          =   3420
      HorzLines       =   2  '3D
      Layout          =   TESTLAY.FRX:0302
      LayoutIndex     =   1
      Left            =   120
      LinesPerRow     =   1
      MarqueeUnique   =   -1  'True
      SplitPropsGlobal=   -1  'True
      SplitTabMode    =   0  'Don't tab across splits
      TabCapture      =   0   'False
      TabIndex        =   0
      Top             =   90
      UseBookmarks    =   -1  'True
      Width           =   7605
      WrapCellPointer =   0   'False
   End
   Begin Data Data1
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   "R:\TEST\TESTLAY.MDB"
      Exclusive       =   0   'False
      Height          =   270
      Left            =   120
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "TestLay"
      Top             =   3600
      Width           =   7590
   End
   Begin Menu MenuExit
      Caption         =   "E&xit"
   End
   Begin Menu MenuSaveLayout
      Caption         =   "&Save Layout"
      Begin Menu MenuSaveLayoutFactory
         Caption         =   "as &Factory"
      End
      Begin Menu MenuSaveLayoutCurrent
         Caption         =   "as &Current"
      End
   End
   Begin Menu MenuRestoreLayout
      Caption         =   "&Restore Layout"
      Begin Menu MenuRestoreLayoutFactory
         Caption         =   "from &Factory"
      End
      Begin Menu MenuRestoreLayoutCurrent
         Caption         =   "from &Current"
      End
   End
   Begin Menu MenuAdd
      Caption         =   "&Add Record"
   End
   Begin Menu MenuDelete
      Caption         =   "&Delete Record"
   End
' TestLay.Frm
' 94/05/06 Copyright 1994, Larry Rebich, The Bridge, Inc.
    Option Explicit
    DefInt A-Z
    Dim InFormLoad As Integer   'skip some things during form load
    Dim Elap As Double  'time to perform save and get
Sub DoData1Caption ()
'    Dim sd As Long          'seconds per day
    Dim sc As Double        'seconds in elapsed
'    sd = 24& * 60& * 60&
    sc = 86400 * Elap
    Data1.Caption = " " & Format$(sc, "#0.0######") & " seconds to perform Save or Get Grid."
End Sub
Sub Form_Load ()
    Dim a As String         'applications path
    InFormLoad = True
    CenterForm Me, 0, 0     'center the form
    a = App.Path            'get our path
    a = AddBackSlash(a)     'add backslash if needed
    GridPathAndFileName = a & GridFileName  'layout file
    Data1.DatabaseName = a & GridDBName     'database name
    MenuSaveLayoutFactory_Click 'save design layout as factory layout
    MenuSaveLayoutFactory.Visible = False
    Data1.Caption = ""
    InFormLoad = False
End Sub
Sub MenuAdd_Click ()
    Table1_Append
End Sub
Sub MenuDelete_Click ()
    If MsgBox("Delete record?", 1 + 32) = 2 Then Exit Sub
    Data1.Recordset.Delete
End Sub
Sub MenuExit_Click ()
End Sub
Sub MenuRestoreLayoutCurrent_Click ()
    Dim Rtn As Integer
    Elap = Now
    Rtn = GridGetLayout(GridPathAndFileName, GridForTable, GridCurrent, Table1)
    Elap = Now - Elap       'duration
    If Not Rtn Then
    MsgBox "Saved Current layout is the same as the current layout!", 48, "Current Layout Not Restored"
    Else
    DoData1Caption
    End If
End Sub
Sub MenuRestoreLayoutFactory_Click ()
    Dim Rtn As Integer
    Elap = Now
    Rtn = GridGetLayout(GridPathAndFileName, GridForTable, GridFactory, Table1)
    Elap = Now - Elap
    If Not Rtn Then
    MsgBox "Saved Factory layout is the same as the current layout!", 48, "Factory Layout Not Restored"
    Else
    DoData1Caption
    End If
End Sub
Sub MenuSaveLayoutCurrent_Click ()
    Dim Rtn As Integer
    Elap = Now
    Rtn = GridSaveLayout(GridPathAndFileName, GridForTable, GridCurrent, Table1)
    Elap = Now - Elap
    If Not Rtn Then
    MsgBox "Saved Current layout is the same as the current layout!", 48, "Current Layout Not Saved"
    Else
    DoData1Caption
    End If
End Sub
Sub MenuSaveLayoutFactory_Click ()
    Dim Rtn As Integer
    Elap = Now
    Rtn = GridSaveLayout(GridPathAndFileName, GridForTable, GridFactory, Table1)
    If InFormLoad Then Exit Sub
    Elap = Now - Elap
    If Not Rtn Then
    MsgBox "Saved Factory layout is the same as the current layout!", 48, "Factory Layout Not Saved"
    Else
    DoData1Caption
    End If
End Sub
Sub Table1_Append ()
    If MsgBox("Add new record?", 1 + 32) = 2 Then Exit Sub
    Data1.Recordset.AddNew
End Sub