home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap14 / vbu1401.frm < prev    next >
Text File  |  1995-10-07  |  11KB  |  419 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. End
  111. Attribute VB_Name = "Form1"
  112. Attribute VB_Creatable = False
  113. Attribute VB_Exposed = False
  114. Option Explicit
  115.  
  116. '
  117. ' internal vars for INI values
  118. '
  119. Dim cDatabase As String
  120. Dim cLocalPrinter As String
  121. Dim cLocalModem As String
  122. '
  123. ' form size/location
  124. Dim nFormWidth As Integer
  125. Dim nFormHeight As Integer
  126. Dim nFormLeft As Integer
  127. Dim nFormTop As Integer
  128. '
  129. ' colors
  130. '
  131. Dim lUserColor(4) As Long
  132. Const vbuFormBG = 1
  133. Const vbuFormFG = 2
  134. Const vbuControlBG = 3
  135. Const vbuControlFG = 4
  136. Dim gblColorSet As String
  137. '
  138. ' confirmation
  139. Dim gblConfirm As String
  140. Private Sub cmdColor_Click(Index As Integer)
  141.     '
  142.     ' handle user color settings
  143.     '
  144.     Dim nTemp As Integer
  145.     '
  146.     Select Case Index
  147.         Case 0
  148.             ' form back color
  149.             CommonDialog1.DialogTitle = "Select Form Background Color"
  150.             CommonDialog1.ShowColor
  151.             lUserColor(Index + 1) = CommonDialog1.Color
  152.         Case 1
  153.             ' form fore color
  154.             CommonDialog1.DialogTitle = "Select Form Foreground Color"
  155.             CommonDialog1.ShowColor
  156.             lUserColor(Index + 1) = CommonDialog1.Color
  157.         Case 2
  158.             ' control back color
  159.             CommonDialog1.DialogTitle = "Select Control Background Color"
  160.             CommonDialog1.ShowColor
  161.             lUserColor(Index + 1) = CommonDialog1.Color
  162.         Case 3
  163.             ' control fore color
  164.             CommonDialog1.DialogTitle = "Select Control Foreground Color"
  165.             CommonDialog1.ShowColor
  166.             lUserColor(Index + 1) = CommonDialog1.Color
  167.     End Select
  168.     '
  169.     ' check for confirmation first
  170.     If gblConfirm = "YES" Then
  171.         nTemp = MsgBox("Update Current Color Scheme?", vbInformation + vbYesNo, "Color Configuration")
  172.     Else
  173.         nTemp = vbYes
  174.     End If
  175.     '
  176.     ' if ok, then update colors
  177.     If nTemp = vbYes Then
  178.         SetUserColors   ' set colors
  179.     End If
  180.     '
  181. End Sub
  182.  
  183.  
  184. Private Sub Form_Activate()
  185.     LoadINIVars ' read INI stuff
  186.     '
  187.     Select Case gblColorSet
  188.         Case "DEFAULT"
  189.             mnuPrefDefaultColor_Click
  190.         Case "SYSTEM"
  191.             mnuPrefSysColor_Click
  192.         Case "USER"
  193.             mnuPrefUserColor_Click
  194.      End Select
  195.     '
  196.     Me.Cls
  197.     Me.Print "gblIniFile="; gblIniFile
  198.     Me.Print "cDatabase="; cDatabase
  199.     Me.Print "cLocalPrinter="; cLocalPrinter
  200.     Me.Print "cLocalModem="; cLocalModem
  201.     '
  202.     ' re-size based on INI settings
  203.     '
  204.     Me.Left = nFormLeft
  205.     Me.Width = nFormWidth
  206.     Me.Height = nFormHeight
  207.     Me.Top = nFormTop
  208.     '
  209. End Sub
  210.  
  211.  
  212. Public Sub LoadINIVars()
  213.     '
  214.     ' read ini values into internal variables
  215.     '
  216.     ' attempt to access settings
  217.     If OpenINI() = False Then
  218.         Unload Me   ' oops!
  219.     End If
  220.     '
  221.     cDatabase = GetIniStr("System", "Database", "vbu1401.mdb")
  222.     cLocalPrinter = GetIniStr("System", "LocalPrinter", "No")
  223.     cLocalModem = GetIniStr("System", "LocalModem", "No")
  224.     '
  225.     ' get form size and location info
  226.     '
  227.     nFormWidth = GetIniStr("Forms", Me.Name + ".Width", "6800")
  228.     nFormHeight = GetIniStr("Forms", Me.Name + ".Height", "4550")
  229.     nFormLeft = GetIniStr("Forms", Me.Name + ".Left", "1200")
  230.     nFormTop = GetIniStr("Forms", Me.Name + ".Top", "1300")
  231.     '
  232.     ' get confirmation flag
  233.     gblConfirm = UCase(GetIniStr("system", "Confirm", "YES"))
  234.     '
  235.     ' get color set
  236.     gblColorSet = UCase(GetIniStr("system", "ColorSet", "Default"))
  237.     '
  238. End Sub
  239.  
  240. Public Sub NewData()
  241.     '
  242.     ' create a new database
  243.     '
  244.     Dim dbFile As Database
  245.     Dim cDBFile As String
  246.     Dim cTable1 As String
  247.     Dim cTable2 As String
  248.     Dim nTemp As Integer
  249.     '
  250.     ' set vars
  251.     cDBFile = "c:\source\chap14\ch1401.mdb"
  252.     cTable1 = "CREATE Table1 (CustID TEXT(10),CustName TEXT(30),CustType TEXT(10));"
  253.     cTable2 = "CREATE Table2 (CustType TEXT(10),TypeName TEXT(20));"
  254.     '
  255.     ' kill any current database
  256.     nTemp = MsgBox("Ready to Delete Any Existing Database?", vbInformation + vbYesNo, "Create Database")
  257.     If nTemp = vbNo Then
  258.         MsgBox "Create Database Canceled"
  259.     Else
  260.         On Error Resume Next
  261.         Kill cDBFile
  262.         On Error GoTo 0
  263.         '
  264.         ' create empty DB
  265.         Set dbFile = DBEngine.CreateDatabase(cDBFile)
  266.         '
  267.         ' create tables
  268.         db.Execute cTable1
  269.         db.Execute cTable2
  270.         '
  271.         ' add additional tables, indexes, relations, etc.
  272.         '
  273.         MsgBox "Database has been Created"
  274.     End If
  275. End Sub
  276.  
  277. Private Sub Form_Unload(Cancel As Integer)
  278.     '
  279.     ' store form size & location
  280.     '
  281.     Dim lTemp As Long
  282.     Dim cForm As String
  283.     '
  284.     cForm = Me.Name
  285.     '
  286.     lTemp = WriteINIStr("Forms", cForm + ".Top", Str(Me.Top))
  287.     lTemp = WriteINIStr("Forms", cForm + ".Left", Str(Me.Left))
  288.     lTemp = WriteINIStr("Forms", cForm + ".Width", Str(Me.Width))
  289.     lTemp = WriteINIStr("Forms", cForm + ".Height", Str(Me.Height))
  290.     '
  291.     If gblColorSet = "USER" Then
  292.         lTemp = WriteINIStr("forms", cForm + ".formBG", Str(lUserColor(vbuFormBG)))
  293.         lTemp = WriteINIStr("forms", cForm + ".formFG", Str(lUserColor(vbuFormFG)))
  294.         lTemp = WriteINIStr("forms", cForm + ".controlBG", Str(lUserColor(vbuControlBG)))
  295.         lTemp = WriteINIStr("forms", cForm + ".controlFG", Str(lUserColor(vbuControlFG)))
  296.     End If
  297.     '
  298.     lTemp = WriteINIStr("System", "ColorSet", gblColorSet)
  299. End Sub
  300.  
  301.  
  302.  
  303. Public Sub LoadSysColors()
  304.     '
  305.     ' load the colors from the current
  306.     ' windows color scheme
  307.     '
  308.     Dim ctlTemp As Control
  309.     '
  310.     ' set colors for all controls on form
  311.     On Error Resume Next
  312.     For Each ctlTemp In Me.Controls
  313.         ctlTemp.BackColor = vbWindowBackground
  314.         ctlTemp.ForeColor = vbWindowText
  315.     Next
  316.     On Error GoTo 0
  317.     '
  318.     ' set colors for form itself
  319.     Me.BackColor = vbApplicationWorkspace
  320.     Me.ForeColor = vbWindowText
  321.     '
  322. End Sub
  323.  
  324.  
  325. Public Sub LoadUserColors()
  326.     '
  327.     ' load colors from ini file
  328.     '
  329.     Dim cTemp As String
  330.     '
  331.     cTemp = GetIniStr("Forms", Me.Name + ".formBG", Str(Me.BackColor))
  332.     lUserColor(vbuFormBG) = Val(cTemp)
  333.     '
  334.     cTemp = GetIniStr("Forms", Me.Name + ".formFG", Str(Me.ForeColor))
  335.     lUserColor(vbuFormFG) = Val(cTemp)
  336.     '
  337.     cTemp = GetIniStr("Forms", Me.Name + ".controlBG", Str(Text1.BackColor))
  338.     lUserColor(vbuControlBG) = Val(cTemp)
  339.     '
  340.     cTemp = GetIniStr("Forms", Me.Name + ".controlFG", Str(Text1.ForeColor))
  341.     lUserColor(vbuControlFG) = Val(cTemp)
  342.     '
  343.     SetUserColors ' set objects to selected colors
  344. End Sub
  345.  
  346.  
  347. Public Sub SetUserColors()
  348.     '
  349.     ' set the form and controls
  350.     ' to the selected colors
  351.     '
  352.     Dim ctlTemp As Control
  353.     '
  354.     ' first the form
  355.     Me.BackColor = lUserColor(vbuFormBG)
  356.     Me.ForeColor = lUserColor(vbuFormFG)
  357.     '
  358.     ' now all controls
  359.     On Error Resume Next
  360.     For Each ctlTemp In Me.Controls
  361.         ctlTemp.BackColor = lUserColor(vbuControlBG)
  362.         ctlTemp.ForeColor = lUserColor(vbuControlFG)
  363.     Next
  364.     On Error GoTo 0
  365.     '
  366. End Sub
  367.  
  368. Private Sub mnuFileExit_Click()
  369.     Unload Me
  370. End Sub
  371.  
  372. Private Sub mnuPrefDefaultColor_Click()
  373.     '
  374.     mnuPrefUserColor.Checked = False
  375.     mnuPrefSysColor.Checked = False
  376.     mnuprefdefaultcolor.Checked = True
  377.     gblColorSet = "DEFAULT"
  378.     LoadDefaultColors
  379.     '
  380. End Sub
  381.  
  382.  
  383.  
  384.  
  385. Private Sub mnuPrefSysColor_Click()
  386.     '
  387.     mnuprefdefaultcolor.Checked = False
  388.     mnuPrefUserColor.Checked = False
  389.     mnuPrefSysColor.Checked = True
  390.     gblColorSet = "SYSTEM"
  391.     LoadSysColors
  392.     '
  393. End Sub
  394.  
  395.  
  396. Private Sub mnuPrefUserColor_Click()
  397.     '
  398.     mnuprefdefaultcolor.Checked = False
  399.     mnuPrefSysColor.Checked = False
  400.     mnuPrefUserColor.Checked = True
  401.     gblColorSet = "USER"
  402.     LoadUserColors
  403.     '
  404. End Sub
  405.  
  406.  
  407.  
  408. Public Sub LoadDefaultColors()
  409.     '
  410.     ' load the original color set
  411.     '
  412.     lUserColor(vbuFormBG) = &H8000000F
  413.     lUserColor(vbuFormFG) = &H80000012
  414.     lUserColor(vbuControlBG) = &H80000005
  415.     lUserColor(vbuControlFG) = &H80000008
  416.     '
  417.     SetUserColors
  418. End Sub
  419.