home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form fMh3dCmd Caption = "Form1" ClientHeight = 6636 ClientLeft = 1716 ClientTop = 1872 ClientWidth = 5940 Height = 7236 Left = 1668 LinkTopic = "Form1" ScaleHeight = 6636 ScaleWidth = 5940 Top = 1320 Width = 6036 Begin VB.PictureBox Picture1 Height = 495 Index = 2 Left = 6720 Picture = "fMh3dCmd.frx":0000 ScaleHeight = 444 ScaleWidth = 444 TabIndex = 3 Top = 1320 Width = 495 End Begin VB.PictureBox Picture1 Height = 495 Index = 1 Left = 6720 Picture = "fMh3dCmd.frx":0316 ScaleHeight = 444 ScaleWidth = 444 TabIndex = 2 Top = 720 Width = 495 End Begin VB.PictureBox Picture1 Height = 495 Index = 0 Left = 6720 Picture = "fMh3dCmd.frx":0598 ScaleHeight = 444 ScaleWidth = 444 TabIndex = 1 Top = 120 Width = 495 End Begin Mh3dfrmLibCtl.Mh3dFrame frmStatePicture Height = 3012 Left = 120 TabIndex = 5 Top = 3456 Width = 5652 _Version = 65536 _ExtentX = 9975 _ExtentY = 5318 _StockProps = 77 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 = "fMh3dCmd.frx":081A NoPrefix = 0 'False FormatString = "" Caption = "Mh3dFrame1" Begin Mh3dcmdLibCtl.Mh3dCommand Mh3dCommand2 Height = 2415 Left = 240 TabIndex = 9 Top = 360 Width = 5175 _Version = 65536 _ExtentX = 9128 _ExtentY = 4260 _StockProps = 15 Caption = "Mh3dCommand2" TintColor = 16711935 Alignment = 2 AutoSize = -1 'True BevelSize = 2 BorderColor = -2147483642 BorderStyle = 2 FillColor = -2147483633 FontTransparent = -1 'True LightColor = -2147483628 PictureDown = "fMh3dCmd.frx":0836 PicturePressed = "fMh3dCmd.frx":0852 PictureUp = "fMh3dCmd.frx":086E ShadowColor = -2147483632 TextColor = -2147483630 Picture = "fMh3dCmd.frx":088A BevelStyle = 1 MouseIcon = "fMh3dCmd.frx":08A6 End End Begin Mh3dcmdLibCtl.Mh3dCommand Mh3dCommand1 Height = 1335 Left = 120 TabIndex = 8 Top = 120 Width = 5655 _Version = 65536 _ExtentX = 9975 _ExtentY = 2355 _StockProps = 15 Caption = "Mh3dCommand1" TintColor = 16711935 Alignment = 2 AutoSize = -1 'True BevelSize = 2 BorderColor = -2147483642 BorderStyle = 2 FillColor = -2147483633 FontTransparent = -1 'True LightColor = -2147483628 PictureDown = "fMh3dCmd.frx":08C2 PicturePressed = "fMh3dCmd.frx":08DE PictureUp = "fMh3dCmd.frx":08FA ShadowColor = -2147483632 TextColor = -2147483630 Picture = "fMh3dCmd.frx":0916 BevelStyle = 1 MouseIcon = "fMh3dCmd.frx":0932 End Begin Mh3dcmdLibCtl.Mh3dCommand cmdDecreasePercent Height = 495 Left = 120 TabIndex = 7 Top = 1560 Width = 2775 _Version = 65536 _ExtentX = 4895 _ExtentY = 873 _StockProps = 15 Caption = "Mh3dCommand3" TintColor = 16711935 Alignment = 2 AutoSize = -1 'True BevelSize = 2 BorderColor = -2147483642 BorderStyle = 2 FillColor = -2147483633 FontTransparent = -1 'True LightColor = -2147483628 PictureDown = "fMh3dCmd.frx":094E PicturePressed = "fMh3dCmd.frx":096A PictureUp = "fMh3dCmd.frx":0986 ShadowColor = -2147483632 TextColor = -2147483630 Picture = "fMh3dCmd.frx":09A2 BevelStyle = 1 MouseIcon = "fMh3dCmd.frx":09BE End Begin Mh3dcmdLibCtl.Mh3dCommand cmdIncreasePercent Height = 495 Left = 3000 TabIndex = 6 Top = 1560 Width = 2775 _Version = 65536 _ExtentX = 4895 _ExtentY = 873 _StockProps = 15 Caption = "Mh3dCommand2" TintColor = 16711935 Alignment = 2 AutoSize = -1 'True BevelSize = 2 BorderColor = -2147483642 BorderStyle = 2 FillColor = -2147483633 FontTransparent = -1 'True LightColor = -2147483628 PictureDown = "fMh3dCmd.frx":09DA PicturePressed = "fMh3dCmd.frx":09F6 PictureUp = "fMh3dCmd.frx":0A12 ShadowColor = -2147483632 TextColor = -2147483630 Picture = "fMh3dCmd.frx":0A2E BevelStyle = 1 MouseIcon = "fMh3dCmd.frx":0A4A End Begin MhcommdlLib.MhCommonDialog Mhcommdl1 Height = 336 Left = 0 TabIndex = 4 Top = 0 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 Caption = "Label1" Height = 1164 Left = 120 TabIndex = 0 Top = 2196 Width = 5652 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 itmMultiline Caption = "&Multiline Caption" End Begin VB.Menu itmState Caption = "&Use as State Button" End Begin VB.Menu itmBevelStyle Caption = "&Bevel Style" Begin VB.Menu itmBevels Caption = "&Raised/Lowered" Checked = -1 'True Index = 0 End Begin VB.Menu itmBevels Caption = "&Lowered/Raised" Index = 1 End Begin VB.Menu itmBevels Caption = "&Chiseled" Index = 2 End End Begin VB.Menu itmBorderStyle Caption = "Border &Style" Begin VB.Menu itmBorders Caption = "&None" Index = 0 End Begin VB.Menu itmBorders Caption = "&Single Line" Checked = -1 'True Index = 1 End Begin VB.Menu itmBorders Caption = "Single Line with &Rounded Corners" Index = 2 End End End Begin VB.Menu mnuColors Caption = "&Colors" Begin VB.Menu itmColors Caption = "&BorderColor" Index = 0 End Begin VB.Menu itmColors Caption = "&FillColor" Index = 1 End Begin VB.Menu itmColors Caption = "&LightColor" Index = 2 End Begin VB.Menu itmColors Caption = "&ShadowColor" Index = 3 End Begin VB.Menu itmColors Caption = "&TextColor" Index = 4 End End Begin VB.Menu mnuPictures Caption = "&Pictures" Begin VB.Menu itmPictures Caption = "&None" Checked = -1 'True Index = 0 End Begin VB.Menu itmPictures Caption = "&Stretch to fit" Index = 1 End Begin VB.Menu itmPictures Caption = "&Original Size" Index = 2 End Begin VB.Menu itmPictures Caption = "&Replicate" Index = 3 End End Attribute VB_Name = "fMh3dCmd" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit Dim imDown As Integer Dim imButtonHeight As Integer Dim imButtonWidth As Integer Const im_TRUE = -1, im_FALSE = 0 Const im_LEFT = 0, im_TOP = 0, im_RIGHT = 1, im_BOTTOM = 1, im_CENTER = 2 Const im_BORDERCOLOR = 0, im_FILLCOLOR = 1, im_LIGHTCOLOR = 2, im_SHADOWCOLOR = 3, im_TEXTCOLOR = 4 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 im_NOSPIN = 0, im_LEFTSPIN = 1, im_RIGHTSPIN = 2 Const im_RESIZE = 0, im_ATSIZE = 1, im_REPLICATE = 2 Const im_LEAD = 0, im_STATE = 1, im_ALIGN = 2, im_BEVEL = 3, im_BORDER = 4, im_MULTI = 5, im_COLOR = 6, im_PICTURE = 7 Const im_GRAY = &HC0C0C0 Const im_BLACK = &H0& Const im_DARK_GRAY = &H808080 Const im_WHITE = &HFFFFFF Const CC_PREVENTFULLOPEN = &H4& Const CDERR_DIALOGFAILURE = -32768 Sub cmdDecreasePercent_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Allows for continuous decrease of the value of example control. '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 'If user is pressing the mouse button, set flag and do case If Button Then imDown = im_TRUE 'if there's already no discernable bevel, quit routine If Mh3dCommand1.BevelSize < 0 Then Mh3dCommand1.SetFocus Exit Sub End If 'Otherwise, reduce the bevel While imDown And Mh3dCommand1.BevelSize > 0 Mh3dCommand1.BevelSize = Mh3dCommand1.BevelSize - 1 DoEvents Wend End If End Sub Sub cmdDecreasePercent_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Sets flag when user quits pressing button imDown = im_FALSE End Sub Sub cmdIncreasePercent_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Allows for continuous increase of the value of example control. 'Routine checks to make sure button is down, then it sets 'flag variable so we know when user quits pressing button 'Then it increases value until limit reached or user quits. 'The top bevel size is restricted to 5 here for asthetic reasons. 'It can be larger but it isn't especially good looking. 'Do loop and DoEvents keep things going 'Flag to quit thrown again in _MouseUp event 'If user is pressing the mouse button, set flag and do case If Button Then imDown = im_TRUE 'if there's already no discernable bevel, quit routine If Mh3dCommand1.BevelSize > 5 Then Mh3dCommand1.SetFocus Exit Sub End If 'Otherwise, reduce the bevel Do Mh3dCommand1.BevelSize = Mh3dCommand1.BevelSize + 1 DoEvents Loop While imDown And Mh3dCommand1.BevelSize < 5 End If End Sub Sub cmdIncreasePercent_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Sets flag when user quits pressing button imDown = im_FALSE End Sub Sub Form_Activate() 'Set focus for statup cmdIncreasePercent.SetFocus End Sub Sub Form_Load() 'Because this is an example, we will set all properties 'through code except those that are explicitly designtime-only 'properties such as the control name 'Set properties for the form fMh3dCmd.Caption = "MicroHelp Mh3dCommand Example" 'Set properties for Mh3DCommand1 'These variables are used for resizing the control if necessary imButtonHeight = Mh3dCommand1.Height imButtonWidth = Mh3dCommand1.Width Mh3dCommand1.Caption = "Single Line Caption" 'Set properties for frame frmStatePicture.BevelSize = 1 frmStatePicture.Caption = "Press here to see multiple state images" 'Set properties for Mh3DCommand2 Mh3dCommand2.BevelSize = 1 Mh3dCommand2.StateButton = True Mh3dCommand2.AutoSize = False Mh3dCommand2.WallPaper = im_RESIZE Mh3dCommand2.PictureUp = Picture1(0).Picture Mh3dCommand2.PicturePressed = Picture1(1).Picture Mh3dCommand2.PictureDown = Picture1(2).Picture 'Set bevel button properties cmdDecreasePercent.Alignment = im_CENTER cmdDecreasePercent.Caption = "Decrease Bevel" cmdIncreasePercent.Alignment = im_CENTER cmdIncreasePercent.Caption = "Increase Bevel" 'Set properties for xplanation label lblXplain.WordWrap = True lblXplain.Caption = Xplain(im_LEAD) ' center form to screen Move Abs(Screen.Width - Width) \ 2, Abs(Screen.Height - Height) \ 2 End Sub Sub itmAlign_Click(Index As Integer) 'The control's horizontal alignment can be justified 'left, right and centered. Dim iIndex As Integer 'Turn checks off For iIndex = 0 To 2 itmAlign(iIndex).Checked = False Next 'Make choice and set check Select Case Index Case im_LEFT Mh3dCommand1.Alignment = Index itmAlign(Index).Checked = True Case im_RIGHT Mh3dCommand1.Alignment = Index itmAlign(Index).Checked = True Case im_CENTER Mh3dCommand1.Alignment = Index itmAlign(Index).Checked = True End Select lblXplain.Caption = Xplain(im_ALIGN) End Sub Sub itmBevels_Click(Index As Integer) 'Routine picks bevel style for control. There's no raised 'option here because raised and lowered are automatically 'part of the lowered setting in a toggle button such as 'this one. Dim iIndex As Integer 'if Bevelsize = 0, there's nothing else to set 'so we tell the user and then exit If Mh3dCommand1.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 2 itmBevels(iIndex).Checked = False Next 'Change style and check appropriate menu item Select Case Index Case im_LOWERED Mh3dCommand1.BevelStyle = Index itmBevels(Index).Checked = True Case im_RAISED Mh3dCommand1.BevelStyle = Index itmBevels(Index).Checked = True Case im_CHISELED Mh3dCommand1.BevelStyle = Index itmBevels(Index).Checked = True Case im_SHADOWLEFT Mh3dCommand1.BevelStyle = Index itmBevels(Index).Checked = True Case im_SHADOWRIGHT Mh3dCommand1.BevelStyle = Index itmBevels(Index).Checked = True End Select lblXplain.Caption = Xplain(im_BEVEL) End Sub Sub itmBorders_Click(Index As Integer) 'Sets border size for control Dim iIndex As Integer 'Turn checks off For iIndex = 0 To 2 itmBorders(iIndex).Checked = False Next 'Makes selection and set appropriate check Select Case Index Case im_NONE Mh3dCommand1.BorderStyle = Index itmBorders(Index).Checked = True Case im_SINGLE Mh3dCommand1.BorderStyle = Index itmBorders(Index).Checked = True Case im_ROUNDED Mh3dCommand1.BorderStyle = Index itmBorders(Index).Checked = True End Select lblXplain.Caption = Xplain(im_BORDER) End Sub 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 If Index = 0 And Mh3dCommand1.BorderStyle = im_NONE Then MsgBox "You must set Border Style to something other than none for this property to 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 Mh3dCommand1.BorderColor = Mhcommdl1.Color Case im_FILLCOLOR Mh3dCommand1.FillColor = Mhcommdl1.Color Case im_LIGHTCOLOR Mh3dCommand1.LightColor = Mhcommdl1.Color Case im_SHADOWCOLOR Mh3dCommand1.ShadowColor = Mhcommdl1.Color Case im_TEXTCOLOR Mh3dCommand1.TextColor = Mhcommdl1.Color End Select lblXplain.Caption = Xplain(im_COLOR) Exit Sub ColorError: Select Case Index Case im_BORDERCOLOR Mh3dCommand1.BorderColor = Mh3dCommand1.BorderColor Case im_FILLCOLOR Mh3dCommand1.FillColor = Mh3dCommand1.FillColor Case im_LIGHTCOLOR Mh3dCommand1.LightColor = Mh3dCommand1.LightColor Case im_SHADOWCOLOR Mh3dCommand1.ShadowColor = Mh3dCommand1.ShadowColor Case im_TEXTCOLOR Mh3dCommand1.TextColor = Mh3dCommand1.TextColor End Select Exit Sub End Sub Sub itmExit_Click() 'Unload form and quit Unload fMh3dCmd End End Sub Sub itmMultiline_Click() 'Set multiline function of control If Mh3dCommand1.MultiLine = False Then Mh3dCommand1.MultiLine = True Mh3dCommand1.Caption = "This rather verbose piece of text is an example of a multiline caption for the MicroHelp Mh3dCommand button custom control" itmMultiline.Caption = "Single Line Caption" Else Mh3dCommand1.MultiLine = False Mh3dCommand1.Caption = "Single line caption" itmMultiline.Caption = "Multiline Caption" End If lblXplain.Caption = Xplain(im_MULTI) End Sub Private Sub itmPictures_Click(Index As Integer) 'This routine places a picture in the frame area. Dim iIndex As Integer 'Turn checks off For iIndex = 0 To 3 itmPictures(iIndex).Checked = False Next 'Place picture and check menu item Select Case Index Case 0 'If they don't want a picture in the control Mh3dCommand1.Picture = LoadPicture("") SetButtonSize itmPictures(Index).Checked = True Case 1 Mh3dCommand1.AutoSize = False Mh3dCommand1.WallPaper = im_RESIZE Mh3dCommand1.Picture = Picture1(1).Picture itmPictures(Index).Checked = True Case 2 Mh3dCommand1.AutoSize = False Mh3dCommand1.WallPaper = im_ATSIZE Mh3dCommand1.Picture = Picture1(1).Picture SetButtonSize itmPictures(Index).Checked = True Case 3 SetButtonSize Mh3dCommand1.Picture = Picture1(1).Picture Mh3dCommand1.WallPaper = im_REPLICATE itmPictures(Index).Checked = True End Select lblXplain.Caption = Xplain(im_PICTURE) End Sub Sub itmState_Click() 'The control can be used as a state button, 'meaning it can remain in the depressed position 'to indicate that it has been pressed and the 'routine is executing. The state can be 'programmatically reset at the end of the routine If Mh3dCommand1.StateButton = False Then Mh3dCommand1.StateButton = True itmState.Caption = "Use As Non-State Button" Else Mh3dCommand1.StateButton = False itmState.Caption = "Use As State Button" End If lblXplain.Caption = Xplain(im_STATE) End Sub Sub SetButtonSize() 'Resizes the button to it's original startup size Mh3dCommand1.Height = imButtonHeight Mh3dCommand1.Width = imButtonWidth End Sub Function Xplain(Index As Integer) As String Select Case Index Case im_LEAD Xplain = "MicroHelp's Mh3dCommand Button is an enhanced command button that allows you to display pictures, control the 3-D appearance of the button, determine all the colors used on the control, provide multiline-captions, provide a " & Chr$(34) & "state" & Chr$(34) & " condition that determines whether the button appears up or down and display different bitmaps for each of those states." Case im_STATE Xplain = "Mh3dCommand Button has the capacity to be a state button, meaning it can remain in the down position until the user either clicks on it again or the programmer changes the boolean .Value property to reset the control. The button at the bottom of the form is always a state button. The button at the top can be made a state button by clicking Options/Use As State Button" Case im_ALIGN Xplain = "The text on a Mh3dCommand Button can be justified to the left, right or centered in the control and this alignment property can be set at runtime if need be." Case im_BEVEL Xplain = "The bevel of the control -- a combination of dark and light areas at the edge of the control -- can be set. While you have full control over the colors of these bevel areas, a combination of black, dark gray and white provides the three-dimensional look most programmers want. While the bevelsize in this demo tops out at 5, you could dramatically increase the bevel for an unusual look." Case im_BORDER Xplain = "The Mh3dCommand button can be used with no border, with a border with squared corners or the default Windows standard of a border with rounded corners. The programmer can control the color of the border." Case im_MULTI Xplain = "The Mh3dCommand button can display single-line captions, just like the Visual Basic command button. But in addition, it can display text on multiple lines, centered or justified left or right." Case im_COLOR Xplain = "Programmers have complete control over the colors used in the button. The control's text, fill area, border and bevels can all be set to custom colors to match the needs of your application." Case im_PICTURE Xplain = "Mh3dCommand buttons can display pictures at original size, stretched to the size of the control or replicated to fill the control. A single picture can be used or multiple pictures can be used for the button up, down and pressed states. Press the bottom button for an example of that in action." End Select End Function 
(.txt)