ActiveX Programming Unleashed CD

home *** CD-ROM | disk | FTP | other *** search

/ ActiveX Programming Unleashed CD / AXU.iso / activex / demos / oletrial / samples / vb / mhlbl / fthreed.frm (.txt) next >

Wrap

Visual Basic Form | 1995-11-28 | 26.0 KB | 726 lines

VERSION 4.00 Begin VB.Form fThreeD BorderStyle = 1 'Fixed Single Caption = "form1" ClientHeight = 5076 ClientLeft = 2196 ClientTop = 672 ClientWidth = 4932 BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 7.8 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 5676 Left = 2148 LinkTopic = "Form1" ScaleHeight = 5076 ScaleWidth = 4932 Top = 120 Width = 5028 Begin Mh3dLib.MhThreed Mh3d1 Height = 372 Index = 0 Left = 120 TabIndex = 1 Top = 120 Width = 4692 _Version = 65536 _ExtentX = 8281 _ExtentY = 661 _StockProps = 77 BackColor = -2147483643 TintColor = 16711935 FillColor = 1044480 Max = 0 Style = 0 TextFillColor = -2147483633 Caption = "Mh3d1" End Begin Mh3dLib.MhThreed Mh3d1 Height = 1212 Index = 1 Left = 120 TabIndex = 2 Top = 3720 Width = 4692 _Version = 65536 _ExtentX = 8281 _ExtentY = 2143 _StockProps = 77 BackColor = -2147483643 TintColor = 16711935 FillColor = 1044480 Max = 0 Style = 0 TextFillColor = -2147483633 Caption = "Mh3d1" End Begin Mh3dfrmLibCtl.Mh3dFrame frmChoices Height = 2052 Left = 120 TabIndex = 4 Top = 1560 Width = 4692 _Version = 65536 _ExtentX = 8281 _ExtentY = 3625 _StockProps = 77 BackColor = -2147483643 TintColor = 16711935 Alignment = 0 AutoSize = 0 'False BevelSize = 0 BevelStyle = 0 BorderColor = -2147483642 BorderStyle = 1 FillColor = -2147483633 FontStyle = 0 FontTransparent = 0 'False LightColor = -2147483643 ShadowColor = -2147483632 TextColor = -2147483640 WallPaper = 0 Picture = "Fthreed.frx":0000 NoPrefix = 0 'False FormatString = "" Caption = "Mh3dFrame1" Begin VB.CommandButton cmdIncreasePercent Caption = "Command1" Height = 495 Left = 2400 TabIndex = 9 Top = 1440 Width = 2175 End Begin VB.CommandButton cmdDecreasePercent Caption = "Command1" Height = 495 Left = 144 TabIndex = 8 Top = 1440 Width = 2175 End Begin Mh3doptLib.Mh3dOption optChoices Height = 375 Index = 2 Left = 120 TabIndex = 7 Top = 960 Width = 4455 _Version = 65536 _ExtentX = 7858 _ExtentY = 661 _StockProps = 79 Caption = "Mh3dOption1" BackColor = -2147483643 TintColor = 16711935 Alignment = 0 AutoSize = -1 'True BoxSize = 13 BorderColor = -2147483642 BorderStyle = 0 FillColor = -2147483633 FontStyle = 0 FontTransparent = -1 'True LightColor = -2147483628 Multiline = 0 'False PictureChecked = "Fthreed.frx":001C PicturePressed = "Fthreed.frx":0038 PictureUnChecked= "Fthreed.frx":0054 PictureGrayed = "Fthreed.frx":0070 ShadowColor = -2147483632 TextColor = -2147483630 WallPaper = 1 Picture = "Fthreed.frx":008C BoxAlignment = 0 Value = 0 Group = 0 DataText = "" DataStyle = 0 DataStyleCaseSens= 0 'False CheckBox2d = 0 'False End Begin Mh3doptLib.Mh3dOption optChoices Height = 375 Index = 1 Left = 120 TabIndex = 6 Top = 600 Width = 4455 _Version = 65536 _ExtentX = 7858 _ExtentY = 661 _StockProps = 79 Caption = "Mh3dOption1" BackColor = -2147483643 TintColor = 16711935 Alignment = 0 AutoSize = -1 'True BoxSize = 13 BorderColor = -2147483642 BorderStyle = 0 FillColor = -2147483633 FontStyle = 0 FontTransparent = -1 'True LightColor = -2147483628 Multiline = 0 'False PictureChecked = "Fthreed.frx":00A8 PicturePressed = "Fthreed.frx":00C4 PictureUnChecked= "Fthreed.frx":00E0 PictureGrayed = "Fthreed.frx":00FC ShadowColor = -2147483632 TextColor = -2147483630 WallPaper = 1 Picture = "Fthreed.frx":0118 BoxAlignment = 0 Value = 0 Group = 0 DataText = "" DataStyle = 0 DataStyleCaseSens= 0 'False CheckBox2d = 0 'False End Begin Mh3doptLib.Mh3dOption optChoices Height = 375 Index = 0 Left = 120 TabIndex = 5 Top = 240 Width = 4455 _Version = 65536 _ExtentX = 7858 _ExtentY = 661 _StockProps = 79 Caption = "Mh3dOption1" BackColor = -2147483643 TintColor = 16711935 Alignment = 0 AutoSize = -1 'True BoxSize = 13 BorderColor = -2147483642 BorderStyle = 0 FillColor = -2147483633 FontStyle = 0 FontTransparent = -1 'True LightColor = -2147483628 Multiline = 0 'False PictureChecked = "Fthreed.frx":0134 PicturePressed = "Fthreed.frx":0150 PictureUnChecked= "Fthreed.frx":016C PictureGrayed = "Fthreed.frx":0188 ShadowColor = -2147483632 TextColor = -2147483630 WallPaper = 1 Picture = "Fthreed.frx":01A4 BoxAlignment = 0 Value = 1 Group = 0 DataText = "" DataStyle = 0 DataStyleCaseSens= 0 'False CheckBox2d = 0 'False End End Begin MhcommdlLib.MhCommonDialog Mhcommdl1 Height = 336 Left = 4440 TabIndex = 3 Top = 5640 Width = 336 _Version = 65536 _ExtentX = 593 _ExtentY = 593 _StockProps = 4 TintColor = 16711935 Filename = "" DialogTop = 0 DialogLeft = 0 DialogWidth = 0 DialogHeight = 0 InitDir = "" Filter = "" DefaultExt = "" DialogTitle = "" FilterIndex = 0 Flags = 0 CancelError = 0 'False MaxFileSize = 256 Color = 0 Max = 0 Min = 0 Copies = 0 FromPage = 0 PrinterDefault = -1 'True ToPage = 0 HelpCommand = 0 HelpContext = 0 HelpFile = "" HelpKey = "" End Begin VB.Label lblXplain Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Label1" ForeColor = &H80000008& Height = 855 Left = 120 TabIndex = 0 Top = 600 Width = 4695 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu itmExit Caption = "E&xit" End End Begin VB.Menu mnuOptions Caption = "&Options" Begin VB.Menu itmAlignment Caption = "&Alignment" Begin VB.Menu itmAlign Caption = "&Left" Index = 0 End Begin VB.Menu itmAlign Caption = "&Right" Index = 1 End Begin VB.Menu itmAlign Caption = "&Center" Checked = -1 'True Index = 2 End End Begin VB.Menu itmReverse Caption = "Fill Right to Left" End Begin VB.Menu itmVertical Caption = "Vertical Fill" End Begin VB.Menu itmBorderStyle Caption = "Border Style" Begin VB.Menu itmBorder Caption = "None" Index = 0 End Begin VB.Menu itmBorder Caption = "Single Line" Checked = -1 'True Index = 1 End Begin VB.Menu itmBorder Caption = "Single Line with Rounded Corners" Index = 2 End End Begin VB.Menu itmBevelStyle Caption = "Bevel Style" Begin VB.Menu itmStyleOfBevel Caption = "Lowered" Index = 0 End Begin VB.Menu itmStyleOfBevel Caption = "Raised" Checked = -1 'True Index = 1 End Begin VB.Menu itmStyleOfBevel Caption = "Chiseled" Index = 2 End Begin VB.Menu itmStyleOfBevel Caption = "Shadowed Right" Index = 3 End Begin VB.Menu itmStyleOfBevel Caption = "Shadowed Left" Index = 4 End End End Begin VB.Menu mnuColors Caption = "Colors" Begin VB.Menu itmColors Caption = "Border Color" Index = 0 End Begin VB.Menu itmColors Caption = "Fill Color" Index = 1 End Begin VB.Menu itmColors Caption = "Light Color (Top and Left Bevels)" Index = 2 End Begin VB.Menu itmColors Caption = "Outer Fill Color" Index = 3 End Begin VB.Menu itmColors Caption = "Shadow Color (Bottom, Right Bevels)" Index = 4 End Begin VB.Menu itmColors Caption = "Text Color" Index = 5 End Begin VB.Menu itmColors Caption = "Text Fill Color" Index = 6 End End Attribute VB_Name = "fThreeD" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit ' For continuous button pressing Dim imDown As Integer Dim imChoices As Integer Dim imStart As Integer 'Declare constants Const im_TRUE = -1, im_FALSE = 0 Const im_LEFT = 0, im_RIGHT = 1, im_CENTER = 2 Const im_BORDERCOLOR = 0, im_FILLCOLOR = 1, im_LIGHTCOLOR = 2, im_OUTERFILLCOLOR = 3, im_SHADOWCOLOR = 4, im_TEXTCOLOR = 5, im_TEXTFILLCOLOR = 6 Const im_NONE = 0, im_SINGLE = 1, im_ROUNDED = 2 Const im_LOWERED = 0, im_RAISED = 1, im_CHISELED = 2, im_SHADOWLEFT = 3, im_SHADOWRIGHT = 4 Const CC_PREVENTFULLOPEN = &H4& Private Sub cmdDecreasePercent_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Allows for continuous decrease of the value of MhThreeD. 'Routine checks to make sure button is down, then it sets 'flag variable so we know when user quits pressing button 'Then it decreases value until limit reached or user quits 'Do loop and DoEvents keep things going 'Flag to quit thrown again in _MouseUp event Dim iIndex As Integer 'If user is pressing the mouse button, set flag and do case If Button Then imDown = im_TRUE Select Case imChoices 'If option 0 clicked (default), change percentage of fill in both controls Case 0 Do While imDown And Mh3d1(0).Value > Mh3d1(0).Min For iIndex = 0 To 1 Mh3d1(iIndex).Value = Mh3d1(iIndex).Value - 1 Mh3d1(iIndex).Caption = Str$(Mh3d1(iIndex).Value) & "%" DoEvents Next Loop 'If option 1 clicked, change outer bevel of bottom control Case 1 While imDown And Mh3d1(1).BevelSize > 0 And Mh3d1(1).BevelSize >= 0 Mh3d1(1).BevelSize = Mh3d1(1).BevelSize - 1 DoEvents Wend 'If option 2 clicked, change inner bevel of bottom control Case 2 While imDown And Mh3d1(1).BevelSizeInside > 0 And Mh3d1(1).BevelSizeInside >= 0 Mh3d1(1).BevelSizeInside = Mh3d1(1).BevelSizeInside - 1 DoEvents Wend End Select End If End Sub Private Sub cmdDecreasePercent_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Flag to indicate user isn't pressing on button anymore imDown = im_FALSE End Sub Private Sub cmdIncreasePercent_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Allows for continuous decrease of the value of MhThreeD. 'Routine checks to make sure button is down, then it sets 'flag variable so we know when user quits pressing button 'Then it decreases value until limit reached or user quits 'Do loop and DoEvents keep things moving 'Flag to quit thrown again in _MouseUp event Dim iIndex As Integer 'If the user is pressing the button, throw flag If Button Then imDown = im_TRUE 'Poll to see which option is chosen Select Case imChoices 'If option 0 clicked (default), change percentage value in MhThreeDs Case 0 Do While imDown And Mh3d1(0).Value < Mh3d1(0).Max For iIndex = 0 To 1 Mh3d1(iIndex).Value = Mh3d1(iIndex).Value + 1 Mh3d1(iIndex).Caption = Str$(Mh3d1(iIndex).Value) & "%" DoEvents Next Loop 'If option 1 clicked, change outer bevel of bottom MhThreeD Case 1 Do Mh3d1(1).BevelSize = Mh3d1(1).BevelSize + 1 DoEvents Loop While imDown And Mh3d1(1).BevelSize < 30 'If option 2 clicked, change inner bevel of bottom MhThreeD Case 2 Do While imDown And Mh3d1(1).BevelSizeInside < 30 Mh3d1(1).BevelSizeInside = Mh3d1(1).BevelSizeInside + 1 DoEvents Loop End Select End If End Sub Private Sub cmdIncreasePercent_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Set flag to indicate user has quit pressing button imDown = im_FALSE End Sub Private Sub form_Activate() 'Fills Mh3d1 when form first becomes active Dim iIndex As Integer If imStart = im_TRUE Then 'Do this until MhThreeD is full Do Until Mh3d1(0).Value = 100 For iIndex = 0 To 1 DoEvents 'Add one to value and update caption Mh3d1(iIndex).Value = Mh3d1(iIndex).Value + 1 Mh3d1(iIndex).Caption = Str$(Mh3d1(iIndex).Value) & "%" Next Loop imStart = im_FALSE End If cmdDecreasePercent.SetFocus End Sub Private Sub Form_Load() 'For the purposes of this example, all the control 'properties except the name and properties that 'designtime-only are set programmatically 'rather than through the Visual Basic property sheet. 'Therefore, property sheet settings are defaults for 'MicroHelp's controls Dim iIndex As Integer 'Set flag for startup fill imStart = im_TRUE 'Set form defaults fThreeD.Caption = "MicroHelp MH3D Example" 'Set common Mh3d1 defaults For iIndex = 0 To 1 Mh3d1(iIndex).BevelSize = 1 Mh3d1(iIndex).BevelSizeInside = 1 Mh3d1(iIndex).Max = 100 Mh3d1(iIndex).Min = 0 Mh3d1(iIndex).Alignment = im_CENTER Next 'Set Mh3d1(0) defaults Mh3d1(0).InnerBottom = 5 Mh3d1(0).InnerTop = 5 Mh3d1(0).InnerLeft = 5 Mh3d1(0).InnerRight = 5 Mh3d1(0).FillColor = RGB(255, 0, 0) 'Set Mh3d1(1) defaults Mh3d1(1).InnerBottom = 30 Mh3d1(1).InnerTop = 30 Mh3d1(1).InnerLeft = 30 Mh3d1(1).InnerRight = 30 Mh3d1(1).FillColor = RGB(0, 255, 0) 'Set properties for frame frmChoices.FontTransparent = True frmChoices.Caption = "Select values to change" frmChoices.BevelSize = 1 frmChoices.BevelStyle = im_RAISED 'Set properties for option buttons optChoices(0).Caption = "Change percent fill value of both MhThreeDs" 'optChoices(0).Value = True optChoices(1).Caption = "Change size of outer bevel of bottom MhThreeD" optChoices(2).Caption = "Change size of inner bevel of bottom MhThreeD" 'Set properties for controls concerning gauge behavior cmdDecreasePercent.Caption = "Decrease %" cmdIncreasePercent.Caption = "Increase %" 'Set properties for explanation labels lblXplain.WordWrap = True lblXplain.Caption = "The MhThreeD control can be used as a conventional label, as a beveled label and even as a percent-complete gauge. It can fill from left to right, right to left, bottom to top or top to bottom." ' center form to screen Move Abs(Screen.Width - Width) \ 2, Abs(Screen.Height - Height) \ 2 End Sub Private Sub itmAlign_Click(index As Integer) 'Set MhThreeD caption alignment here Dim iIndex As Integer 'Loop to turn off checks on menu For iIndex = 0 To 2 itmAlign(iIndex).Checked = False Next 'Set alignment, set checks Mh3d1(0).Alignment = index Mh3d1(1).Alignment = index itmAlign(index).Checked = True End Sub Private Sub itmBorder_Click(index As Integer) 'This will control the borderstyle for the bottom Mh3d1 Dim iIndex As Integer 'Turn all checks off For iIndex = 0 To 2 itmBorder(iIndex).Checked = False Next 'Change border style and check appropriate menu item Select Case index Case im_NONE Mh3d1(1).BorderStyle = index itmBorder(index).Checked = True Case im_SINGLE Mh3d1(1).BorderStyle = index itmBorder(index).Checked = True Case im_ROUNDED Mh3d1(1).BorderStyle = index itmBorder(index).Checked = True End Select End Sub Private Sub itmColors_Click(index As Integer) 'Routine calls up common color dialog so we can 'illustrate the color properties of the control. 'Note that we don't set .ForeColor or .BackColor 'even though they appear in the properties list. 'Changing them can cause bizarre color display and 'some controls may behave strangely. Leave those 'properties at their defaults 'Test to make sure they're setting something 'that will actually have a visible effect If index = im_BORDERCOLOR And Mh3d1(1).BorderStyle = im_NONE Then MsgBox "You must set a border under the options menu before this property can have any effect.", 16, "MicroHelp" Exit Sub End If 'Sets flag to prevent custom color palette from 'appearing, calls dialog and sets appropriate 'color property when dialog closes. Mhcommdl1.Flags = CC_PREVENTFULLOPEN Mhcommdl1.CancelError = True On Error GoTo ColorError Mhcommdl1.Action = 3 Select Case index Case im_BORDERCOLOR Mh3d1(1).BorderColor = Mhcommdl1.Color Case im_FILLCOLOR Mh3d1(1).FillColor = Mhcommdl1.Color Case im_LIGHTCOLOR Mh3d1(1).LightColor = Mhcommdl1.Color Case im_OUTERFILLCOLOR Mh3d1(1).OuterFillColor = Mhcommdl1.Color Case im_SHADOWCOLOR Mh3d1(1).ShadowColor = Mhcommdl1.Color Case im_TEXTCOLOR Mh3d1(1).TextColor = Mhcommdl1.Color Case im_TEXTFILLCOLOR Mh3d1(1).TextFillColor = Mhcommdl1.Color End Select Exit Sub ColorError: Select Case index Case im_BORDERCOLOR Mh3d1(1).BorderColor = Mh3d1(1).BorderColor Case im_FILLCOLOR Mh3d1(1).FillColor = Mh3d1(1).FillColor Case im_LIGHTCOLOR Mh3d1(1).LightColor = Mh3d1(1).LightColor Case im_OUTERFILLCOLOR Mh3d1(1).OuterFillColor = Mh3d1(1).OuterFillColor Case im_SHADOWCOLOR Mh3d1(1).ShadowColor = Mh3d1(1).ShadowColor Case im_TEXTCOLOR Mh3d1(1).TextColor = Mh3d1(1).TextColor Case im_TEXTFILLCOLOR Mh3d1(1).TextFillColor = Mh3d1(1).TextFillColor End Select Exit Sub End Sub Private Sub itmExit_Click() Unload fThreeD End Sub Private Sub itmReverse_Click() 'MhThreeD has a .Reverse property so that it can 'fill from right to left or left to right. If '.VerticalFill is set to true, this property 'determines whether it fills from top to bottom 'or bottom to top Dim iIndex As Integer Dim iValue As Integer iValue = Mh3d1(1).Value If Mh3d1(0).ReverseFill = False Then For iIndex = 0 To 1 Mh3d1(iIndex).ReverseFill = True itmReverse.Caption = "Fill Left To Right" Mh3d1(iIndex).Value = iValue Next Else For iIndex = 0 To 1 Mh3d1(iIndex).ReverseFill = False itmReverse.Caption = "Fill Right To Left" Mh3d1(iIndex).Value = iValue Next End If End Sub Private Sub itmStyleOfBevel_Click(index As Integer) 'Routine picks bevel style for control Dim iIndex As Integer 'if Bevelsize = 0, there's nothing else to set 'so we tell the user and then exit If Mh3d1(1).BevelSize = 0 Then MsgBox "You must set .BevelSize to something other than zero for this property to have any effect.", 16, "MicroHelp" Exit Sub End If 'Turn all the checks off For iIndex = 0 To 4 itmStyleOfBevel(iIndex).Checked = False Next 'Change style and check appropriate menu item Select Case index Case im_LOWERED Mh3d1(1).BevelStyle = index itmStyleOfBevel(index).Checked = True Case im_RAISED Mh3d1(1).BevelStyle = index itmStyleOfBevel(index).Checked = True Case im_CHISELED Mh3d1(1).BevelStyle = index itmStyleOfBevel(index).Checked = True Case im_SHADOWLEFT Mh3d1(1).BevelStyle = index itmStyleOfBevel(index).Checked = True Case im_SHADOWRIGHT Mh3d1(1).BevelStyle = index itmStyleOfBevel(index).Checked = True End Select End Sub Private Sub itmVertical_Click() 'MhThreeD has a .VerticalFill property that determines 'whether the control fills horizontially or vertically. 'If .ReverseFill is set to true, then the control may 'fill from top to bottom rather than bottom to top. Dim iIndex As Integer Dim iValue As Integer iValue = Mh3d1(0).Value If Mh3d1(0).VerticalFill = False Then For iIndex = 0 To 1 Mh3d1(iIndex).VerticalFill = True itmVertical.Caption = "Horizontal Fill" Mh3d1(iIndex).Value = iValue Next Else For iIndex = 0 To 1 Mh3d1(iIndex).VerticalFill = False itmVertical.Caption = "Vertical Fill" Mh3d1(iIndex).Value = iValue Next End If End Sub Private Sub optChoices_Click(index As Integer) 'Set flag for increase/decrease button routines. imChoices = index End Sub Private Sub optChoices_MouseUp(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) 'Set focus to most likely initial choice given defaults 'of the MhThreeD controls at startup If index = 0 Then cmdDecreasePercent.SetFocus Else cmdIncreasePercent.SetFocus End If End Sub