home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap14 / vbu1401.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-10-07  |  11.2 KB  |  387 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   4140
  5.    ClientLeft      =   1245
  6.    ClientTop       =   1950
  7.    ClientWidth     =   5400
  8.    Height          =   4830
  9.    Left            =   1185
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   4140
  12.    ScaleWidth      =   5400
  13.    Top             =   1320
  14.    Width           =   5520
  15.    Begin VB.TextBox Text2 
  16.       Height          =   315
  17.       Left            =   1500
  18.       TabIndex        =   5
  19.       Text            =   "Text2"
  20.       Top             =   2220
  21.       Width           =   1515
  22.    End
  23.    Begin VB.TextBox Text1 
  24.       Height          =   315
  25.       Left            =   1500
  26.       TabIndex        =   4
  27.       Text            =   "Text1"
  28.       Top             =   1800
  29.       Width           =   1515
  30.    End
  31.    Begin VB.CommandButton cmdColor 
  32.       Caption         =   "&Control ForeColor"
  33.       Height          =   495
  34.       Index           =   3
  35.       Left            =   3540
  36.       TabIndex        =   3
  37.       Top             =   2220
  38.       Width           =   1755
  39.    End
  40.    Begin VB.CommandButton cmdColor 
  41.       Caption         =   "&Control BackColor"
  42.       Height          =   495
  43.       Index           =   2
  44.       Left            =   3540
  45.       TabIndex        =   2
  46.       Top             =   1620
  47.       Width           =   1755
  48.    End
  49.    Begin VB.CommandButton cmdColor 
  50.       Caption         =   "&Form ForeColor"
  51.       Height          =   495
  52.       Index           =   1
  53.       Left            =   3540
  54.       TabIndex        =   1
  55.       Top             =   1020
  56.       Width           =   1755
  57.    End
  58.    Begin VB.CommandButton cmdColor 
  59.       Caption         =   "&Form BackColor"
  60.       Height          =   495
  61.       Index           =   0
  62.       Left            =   3540
  63.       TabIndex        =   0
  64.       Top             =   420
  65.       Width           =   1755
  66.    End
  67.    Begin VB.Label Label2 
  68.       Caption         =   "Label2"
  69.       Height          =   315
  70.       Left            =   540
  71.       TabIndex        =   7
  72.       Top             =   2220
  73.       Width           =   855
  74.    End
  75.    Begin VB.Label Label1 
  76.       Caption         =   "Label1"
  77.       Height          =   315
  78.       Left            =   540
  79.       TabIndex        =   6
  80.       Top             =   1800
  81.       Width           =   855
  82.    End
  83.    Begin MSComDlg.CommonDialog CommonDialog1 
  84.       Left            =   4440
  85.       Top             =   2820
  86.       _Version        =   65536
  87.       _ExtentX        =   847
  88.       _ExtentY        =   847
  89.       _StockProps     =   0
  90.    End
  91.    Begin VB.Menu mnuFile 
  92.       Caption         =   "&File"
  93.       Begin VB.Menu mnuFileExit 
  94.          Caption         =   "E&xit"
  95.       End
  96.    End
  97.    Begin VB.Menu mnuPref 
  98.       Caption         =   "&Preferences"
  99.       Begin VB.Menu mnuPrefDefaultColor 
  100.          Caption         =   "&Default Colors"
  101.       End
  102.       Begin VB.Menu mnuPrefSysColor 
  103.          Caption         =   "&System Colors"
  104.       End
  105.       Begin VB.Menu mnuPrefUserColor 
  106.          Caption         =   "&User Colors"
  107.          Checked         =   -1  'True
  108.       End
  109.    End
  110. Attribute VB_Name = "Form1"
  111. Attribute VB_Creatable = False
  112. Attribute VB_Exposed = False
  113. Option Explicit
  114. ' internal vars for INI values
  115. Dim cDatabase As String
  116. Dim cLocalPrinter As String
  117. Dim cLocalModem As String
  118. ' form size/location
  119. Dim nFormWidth As Integer
  120. Dim nFormHeight As Integer
  121. Dim nFormLeft As Integer
  122. Dim nFormTop As Integer
  123. ' colors
  124. Dim lUserColor(4) As Long
  125. Const vbuFormBG = 1
  126. Const vbuFormFG = 2
  127. Const vbuControlBG = 3
  128. Const vbuControlFG = 4
  129. Dim gblColorSet As String
  130. ' confirmation
  131. Dim gblConfirm As String
  132. Private Sub cmdColor_Click(Index As Integer)
  133.     '
  134.     ' handle user color settings
  135.     '
  136.     Dim nTemp As Integer
  137.     '
  138.     Select Case Index
  139.         Case 0
  140.             ' form back color
  141.             CommonDialog1.DialogTitle = "Select Form Background Color"
  142.             CommonDialog1.ShowColor
  143.             lUserColor(Index + 1) = CommonDialog1.Color
  144.         Case 1
  145.             ' form fore color
  146.             CommonDialog1.DialogTitle = "Select Form Foreground Color"
  147.             CommonDialog1.ShowColor
  148.             lUserColor(Index + 1) = CommonDialog1.Color
  149.         Case 2
  150.             ' control back color
  151.             CommonDialog1.DialogTitle = "Select Control Background Color"
  152.             CommonDialog1.ShowColor
  153.             lUserColor(Index + 1) = CommonDialog1.Color
  154.         Case 3
  155.             ' control fore color
  156.             CommonDialog1.DialogTitle = "Select Control Foreground Color"
  157.             CommonDialog1.ShowColor
  158.             lUserColor(Index + 1) = CommonDialog1.Color
  159.     End Select
  160.     '
  161.     ' check for confirmation first
  162.     If gblConfirm = "YES" Then
  163.         nTemp = MsgBox("Update Current Color Scheme?", vbInformation + vbYesNo, "Color Configuration")
  164.     Else
  165.         nTemp = vbYes
  166.     End If
  167.     '
  168.     ' if ok, then update colors
  169.     If nTemp = vbYes Then
  170.         SetUserColors   ' set colors
  171.     End If
  172.     '
  173. End Sub
  174. Private Sub Form_Activate()
  175.     LoadINIVars ' read INI stuff
  176.     '
  177.     Select Case gblColorSet
  178.         Case "DEFAULT"
  179.             mnuPrefDefaultColor_Click
  180.         Case "SYSTEM"
  181.             mnuPrefSysColor_Click
  182.         Case "USER"
  183.             mnuPrefUserColor_Click
  184.      End Select
  185.     '
  186.     Me.Cls
  187.     Me.Print "gblIniFile="; gblIniFile
  188.     Me.Print "cDatabase="; cDatabase
  189.     Me.Print "cLocalPrinter="; cLocalPrinter
  190.     Me.Print "cLocalModem="; cLocalModem
  191.     '
  192.     ' re-size based on INI settings
  193.     '
  194.     Me.Left = nFormLeft
  195.     Me.Width = nFormWidth
  196.     Me.Height = nFormHeight
  197.     Me.Top = nFormTop
  198.     '
  199. End Sub
  200. Public Sub LoadINIVars()
  201.     '
  202.     ' read ini values into internal variables
  203.     '
  204.     ' attempt to access settings
  205.     If OpenINI() = False Then
  206.         Unload Me   ' oops!
  207.     End If
  208.     '
  209.     cDatabase = GetIniStr("System", "Database", "vbu1401.mdb")
  210.     cLocalPrinter = GetIniStr("System", "LocalPrinter", "No")
  211.     cLocalModem = GetIniStr("System", "LocalModem", "No")
  212.     '
  213.     ' get form size and location info
  214.     '
  215.     nFormWidth = GetIniStr("Forms", Me.Name + ".Width", "6800")
  216.     nFormHeight = GetIniStr("Forms", Me.Name + ".Height", "4550")
  217.     nFormLeft = GetIniStr("Forms", Me.Name + ".Left", "1200")
  218.     nFormTop = GetIniStr("Forms", Me.Name + ".Top", "1300")
  219.     '
  220.     ' get confirmation flag
  221.     gblConfirm = UCase(GetIniStr("system", "Confirm", "YES"))
  222.     '
  223.     ' get color set
  224.     gblColorSet = UCase(GetIniStr("system", "ColorSet", "Default"))
  225.     '
  226. End Sub
  227. Public Sub NewData()
  228.     '
  229.     ' create a new database
  230.     '
  231.     Dim dbFile As Database
  232.     Dim cDBFile As String
  233.     Dim cTable1 As String
  234.     Dim cTable2 As String
  235.     Dim nTemp As Integer
  236.     '
  237.     ' set vars
  238.     cDBFile = "c:\source\chap14\ch1401.mdb"
  239.     cTable1 = "CREATE Table1 (CustID TEXT(10),CustName TEXT(30),CustType TEXT(10));"
  240.     cTable2 = "CREATE Table2 (CustType TEXT(10),TypeName TEXT(20));"
  241.     '
  242.     ' kill any current database
  243.     nTemp = MsgBox("Ready to Delete Any Existing Database?", vbInformation + vbYesNo, "Create Database")
  244.     If nTemp = vbNo Then
  245.         MsgBox "Create Database Canceled"
  246.     Else
  247.         On Error Resume Next
  248.         Kill cDBFile
  249.         On Error GoTo 0
  250.         '
  251.         ' create empty DB
  252.         Set dbFile = DBEngine.CreateDatabase(cDBFile)
  253.         '
  254.         ' create tables
  255.         db.Execute cTable1
  256.         db.Execute cTable2
  257.         '
  258.         ' add additional tables, indexes, relations, etc.
  259.         '
  260.         MsgBox "Database has been Created"
  261.     End If
  262. End Sub
  263. Private Sub Form_Unload(Cancel As Integer)
  264.     '
  265.     ' store form size & location
  266.     '
  267.     Dim lTemp As Long
  268.     Dim cForm As String
  269.     '
  270.     cForm = Me.Name
  271.     '
  272.     lTemp = WriteINIStr("Forms", cForm + ".Top", Str(Me.Top))
  273.     lTemp = WriteINIStr("Forms", cForm + ".Left", Str(Me.Left))
  274.     lTemp = WriteINIStr("Forms", cForm + ".Width", Str(Me.Width))
  275.     lTemp = WriteINIStr("Forms", cForm + ".Height", Str(Me.Height))
  276.     '
  277.     If gblColorSet = "USER" Then
  278.         lTemp = WriteINIStr("forms", cForm + ".formBG", Str(lUserColor(vbuFormBG)))
  279.         lTemp = WriteINIStr("forms", cForm + ".formFG", Str(lUserColor(vbuFormFG)))
  280.         lTemp = WriteINIStr("forms", cForm + ".controlBG", Str(lUserColor(vbuControlBG)))
  281.         lTemp = WriteINIStr("forms", cForm + ".controlFG", Str(lUserColor(vbuControlFG)))
  282.     End If
  283.     '
  284.     lTemp = WriteINIStr("System", "ColorSet", gblColorSet)
  285. End Sub
  286. Public Sub LoadSysColors()
  287.     '
  288.     ' load the colors from the current
  289.     ' windows color scheme
  290.     '
  291.     Dim ctlTemp As Control
  292.     '
  293.     ' set colors for all controls on form
  294.     On Error Resume Next
  295.     For Each ctlTemp In Me.Controls
  296.         ctlTemp.BackColor = vbWindowBackground
  297.         ctlTemp.ForeColor = vbWindowText
  298.     Next
  299.     On Error GoTo 0
  300.     '
  301.     ' set colors for form itself
  302.     Me.BackColor = vbApplicationWorkspace
  303.     Me.ForeColor = vbWindowText
  304.     '
  305. End Sub
  306. Public Sub LoadUserColors()
  307.     '
  308.     ' load colors from ini file
  309.     '
  310.     Dim cTemp As String
  311.     '
  312.     cTemp = GetIniStr("Forms", Me.Name + ".formBG", Str(Me.BackColor))
  313.     lUserColor(vbuFormBG) = Val(cTemp)
  314.     '
  315.     cTemp = GetIniStr("Forms", Me.Name + ".formFG", Str(Me.ForeColor))
  316.     lUserColor(vbuFormFG) = Val(cTemp)
  317.     '
  318.     cTemp = GetIniStr("Forms", Me.Name + ".controlBG", Str(Text1.BackColor))
  319.     lUserColor(vbuControlBG) = Val(cTemp)
  320.     '
  321.     cTemp = GetIniStr("Forms", Me.Name + ".controlFG", Str(Text1.ForeColor))
  322.     lUserColor(vbuControlFG) = Val(cTemp)
  323.     '
  324.     SetUserColors ' set objects to selected colors
  325. End Sub
  326. Public Sub SetUserColors()
  327.     '
  328.     ' set the form and controls
  329.     ' to the selected colors
  330.     '
  331.     Dim ctlTemp As Control
  332.     '
  333.     ' first the form
  334.     Me.BackColor = lUserColor(vbuFormBG)
  335.     Me.ForeColor = lUserColor(vbuFormFG)
  336.     '
  337.     ' now all controls
  338.     On Error Resume Next
  339.     For Each ctlTemp In Me.Controls
  340.         ctlTemp.BackColor = lUserColor(vbuControlBG)
  341.         ctlTemp.ForeColor = lUserColor(vbuControlFG)
  342.     Next
  343.     On Error GoTo 0
  344.     '
  345. End Sub
  346. Private Sub mnuFileExit_Click()
  347.     Unload Me
  348. End Sub
  349. Private Sub mnuPrefDefaultColor_Click()
  350.     '
  351.     mnuPrefUserColor.Checked = False
  352.     mnuPrefSysColor.Checked = False
  353.     mnuprefdefaultcolor.Checked = True
  354.     gblColorSet = "DEFAULT"
  355.     LoadDefaultColors
  356.     '
  357. End Sub
  358. Private Sub mnuPrefSysColor_Click()
  359.     '
  360.     mnuprefdefaultcolor.Checked = False
  361.     mnuPrefUserColor.Checked = False
  362.     mnuPrefSysColor.Checked = True
  363.     gblColorSet = "SYSTEM"
  364.     LoadSysColors
  365.     '
  366. End Sub
  367. Private Sub mnuPrefUserColor_Click()
  368.     '
  369.     mnuprefdefaultcolor.Checked = False
  370.     mnuPrefSysColor.Checked = False
  371.     mnuPrefUserColor.Checked = True
  372.     gblColorSet = "USER"
  373.     LoadUserColors
  374.     '
  375. End Sub
  376. Public Sub LoadDefaultColors()
  377.     '
  378.     ' load the original color set
  379.     '
  380.     lUserColor(vbuFormBG) = &H8000000F
  381.     lUserColor(vbuFormFG) = &H80000012
  382.     lUserColor(vbuControlBG) = &H80000005
  383.     lUserColor(vbuControlFG) = &H80000008
  384.     '
  385.     SetUserColors
  386. End Sub
  387.