精华内容
下载资源
问答
  • 摘要:VB源码,其它类别,时钟,滚动条 VB时钟+VB滚动条+字体,里面包括了VB的时钟、text、滚动条等控件的用法和实例源代码,学习学习如何适时预览的字体设置程序,可适时设置字体孝字号、垂直和水平宽度。
  • 内容索引:VB源码,界面编程,滑块,滚动条,字体 VB使用拖动条改变字体大小,用鼠标拖动滑块,窗口内的文字会跟着变变小,很实用的一个例子,希望对大家有帮助。
  • 运用vb编程,用来改变字体大小,包含源代码。有利于初学者的学习
  • 要求利用滚动条和标签控件实现对标签字体大小的任意改变,如图所示。 提示 将滚动条的Min、Max分别设置为字号的最小值和最大值 当拖动滑块时,字体取原来值,字号跟着变化。 参考代码 P...

    题目来源:大工慕课 链接
    原题:Visual Basic程序设计教程(第二版)龚沛曾主编,高等教育出版社 实验4-9
    作者:Caleb Sung

    题目要求

    任意改变文本的字号。要求利用滚动条和标签控件实现对标签字体大小的任意改变,如图所示。
    这里写图片描述

    提示

    1. 将滚动条的Min、Max分别设置为字号的最小值和最大值
    2. 当拖动滑块时,字体取原来值,字号跟着变化。

    参考代码

    Private Sub HScroll1_Change()
        n = HScroll1.Value
        Label1.FontSize = n
        Label1.Caption = n & "号字"
    End Sub
    
    展开全文
  • VB使用拖动改变字体大小,用鼠标拖动滑块,窗口内的文字会跟着变变小,很实用的一个例子,希望对大家有帮助。
  • VB自绘滚动条控件(COX)

    2021-12-12 12:37:29
    V友们都知道VB自带有两个滚动条控件:HScrollBar和VScrollBar,但今天我们来自己"画"一个功能类似的滚动条COX,以以上原理图为目的,用户设置滚动条最大值和最小值以及滚动值,来回拖动滑块按钮改变滚动值,输出滚动...

    如图:
    在这里插入图片描述
    通俗原理:
    在这里插入图片描述
    V友们都知道VB自带有两个滚动条控件:HScrollBar和VScrollBar,但今天我们来自己"画"一个功能类似的滚动条COX,以以上原理图为目的,用户设置滚动条最大值和最小值以及滚动值,来回拖动滑块按钮改变滚动值,输出滚动值。控件样式为横向模式,废话少说,直接开干……
    启动VB6.0主程序,“添加用户控件"添加一个COX控件,切换到代码编辑区。
    '一、添加必要的API函数:
    Option Explicit
    '创建一个圆角矩形,该矩形由X1,Y1-X2,Y2确定,并由X3,Y3确定的椭圆描述圆角弧度
    Private Declare Function CreateRoundRectRgn Lib “gdi32” (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
    '改变窗口的区域
    Private Declare Function SetWindowRgn Lib “user32” (ByVal Hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    '用当前选定的画笔画一个圆角矩形,并用当前选定的刷子在其中填充。X3和Y3定义了用于生成圆角的椭圆
    Private Declare Function RoundRect Lib “gdi32” (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
    '显示文本
    Private Declare Function DrawText Lib “user32” Alias “DrawTextA” (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    '用这个函数删除GDI对象,比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放
    Private Declare Function DeleteObject Lib “gdi32” (ByVal hObject As Long) As Long
    '滑块按钮和文本的位置
    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    Private Const DT_CENTER = &H1 '文本垂直居中
    Private Const DT_VCENTER = &H4 '指示文本对齐格式化矩形的中部
    Private Const DT_SINGLELINE = &H20 '只画单行
    '用于鼠标移入移出控件范围的API
    '获取鼠标指针的当前位置
    Private Declare Function GetCursorpos Lib “user32” Alias “GetCursorPos” (lpPoint As POINTAPI) As Long
    '获得整个窗口的范围矩形,窗口的边框、标题栏、滚动条及菜单等都在这个矩形内
    Private Declare Function GetWindowRect Lib “user32” (ByVal Hwnd As Long, lpRect As RECT) As Long
    '判断函数调用时指定虚拟键的状态
    Private Declare Function GetAsyncKeyState Lib “user32” (ByVal vKey As Long) As Integer
    '鼠标位置
    Private Type POINTAPI
    x As Long
    y As Long
    End Type
    '---------------------------------------------------------------------------------------------------------------------------------------
    '二、添加其他变量及控件事件
    Dim WithEvents TimCom1 As Timer '定义判断鼠标事件的计时器
    Dim SliderObject As RECT '定义滑块及文本的位置变量
    Private Const SR_WIDTH As Long = 30 '滑块的宽度
    Dim SR_Min As Double, SR_Max As Double, SR_Value As Double '最小值,最大值,滑动的值
    Dim comColor(2) As Long '按钮边框线、背景、字体颜色
    Dim Aix As Boolean '鼠标在滑块按钮的颜色切换"通行卡”
    Dim Bcolor(9) As Long '滑块边框线和背景颜色(0-1弹起边框线和背景颜色,2-3鼠标经过时边框线和背景颜色,4-5鼠标按下时边框线和背景颜色,6-7控件无效的边框线和背景颜色)
    Dim Fcolor(3) As Long '字体颜色(0弹起颜色,1鼠标经过颜色,2鼠标按下颜色,3无效颜色)
    Public Event Scroll() '控件输出值事件
    '----------------------------------------------------------------------------------------------------------------------------------------
    '三、初始化控件及变量参数
    Private Sub UserControl_Initialize()
    UserControl.AutoRedraw = True: UserControl.ScaleMode = vbPixels
    Set TimCom1 = UserControl.Controls.Add(“VB.Timer”, “TimCom1”)
    TimCom1.Interval = 1: TimCom1.Enabled = False
    Max = 32767
    Min = 0
    Value = 0
    Bcolor(0) = RGB(0, 0, 0): Bcolor(1) = RGB(83, 83, 83): Bcolor(2) = RGB(120, 120, 120): Bcolor(3) = RGB(150, 150, 150): Bcolor(4) = RGB(0, 0, 0): Bcolor(5) = RGB(50, 50, 50): Bcolor(6) = RGB(168, 168, 168): Bcolor(7) = RGB(240, 240, 240)
    Bcolor(8) = RGB(125, 125, 125): Bcolor(9) = RGB(222, 222, 222): Fcolor(0) = vbWhite: Fcolor(1) = vbYellow: Fcolor(2) = RGB(255, 100, 0): Fcolor(3) = RGB(100, 100, 100)
    Call MoveVilss(Value)
    End Sub

    Private Sub UserControl_Resize()
    If UserControl.Width < (SR_WIDTH * 15) * 2 Then UserControl.Width = (SR_WIDTH * 15) * 2
    If UserControl.Height < 255 Then UserControl.Height = 255
    Call RoundedCorners
    comColor(0) = Bcolor(0): comColor(1) = Bcolor(1): comColor(2) = Fcolor(0)
    Call MoveVilss(Value)
    End Sub

    '控件圆角样式
    Private Sub RoundedCorners()
    Dim hRgn(2) As Long
    hRgn(0) = CreateRoundRectRgn(0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, 3, 3)
    hRgn(1) = SetWindowRgn(UserControl.Hwnd, hRgn(0), True)
    For hRgn(2) = 0 To 1
    Call DeleteObject(hRgn(hRgn(2)))
    Next
    End Sub
    '----------------------------------------------------------------------------------------------------------------------------------------
    '四、编写三个核心函数
    '1、用户设置 value 的值(输入)
    Private Function MoveVilss(ByVal Vworth As Double)
    Dim sldScale As Single, SliderObject As RECT, SldPos(1) As Single
    If Vworth > Max Then Vworth = SR_Max: Value = SR_Max
    sldScale = (UserControl.ScaleWidth - SR_WIDTH) / (SR_Max - SR_Min)
    Call SliderPosition(CInt((Vworth - SR_Min) * sldScale))
    End Function
    '2、滑块按钮改变滚动值(输出)
    Private Sub SlidingBlock(ByVal x As Single)
    Dim SldPos(1) As Single
    Dim sldScale As Double
    SldPos(0) = x - SR_WIDTH / 2
    SldPos(1) = IIf(x < SR_WIDTH / 2, 0, IIf(x > UserControl.ScaleWidth - SR_WIDTH / 2, UserControl.ScaleWidth - SR_WIDTH, SldPos(0)))
    sldScale = (UserControl.ScaleWidth - SR_WIDTH) / (SR_Max - SR_Min)
    On Error GoTo Nx
    SR_Value = CInt(SldPos(1) / sldScale)
    Nx:
    Call SliderPosition(SldPos(0))
    End Sub
    '3、显示滑块和百分比
    Private Sub SliderPosition(ByVal Vprice As Double)
    Dim SldPos(1) As Single, Rectangle(1) As Long
    SliderObject.Left = IIf(Vprice < 1, 1, IIf(Vprice + SR_WIDTH >= UserControl.ScaleWidth, UserControl.ScaleWidth - SR_WIDTH - 2, Vprice))
    SliderObject.Top = 2
    SliderObject.Right = SliderObject.Left + SR_WIDTH
    SliderObject.Bottom = UserControl.ScaleHeight - 2
    UserControl.Refresh
    UserControl.Cls
    UserControl.BackColor = Bcolor(9)
    UserControl.FillStyle = 0
    UserControl.ForeColor = comColor(0)
    UserControl.FillColor = comColor(1)
    Rectangle(0) = RoundRect(UserControl.hdc, SliderObject.Left, SliderObject.Top, SliderObject.Right, SliderObject.Bottom, 3, 3)
    UserControl.ForeColor = comColor(2)
    DrawText UserControl.hdc, CInt(SR_Value / SR_Max * 100) & “%”, -1, SliderObject, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
    UserControl.FillStyle = 1
    UserControl.ForeColor = Bcolor(8)
    Rectangle(1) = RoundRect(UserControl.hdc, 0, 0, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1, 3, 3)
    DeleteObject Rectangle(0): DeleteObject Rectangle(1)
    RaiseEvent Scroll
    End Sub
    '----------------------------------------------------------------------------------------------------------------------------------------
    '五、处理鼠标事件
    Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button <> 1 Then Exit Sub
    comColor(0) = Bcolor(4): comColor(1) = Bcolor(5): comColor(2) = Fcolor(2)
    Call SlidingBlock(x)
    Aix = True
    End Sub

    Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If x > SliderObject.Left And x < SliderObject.Right And y > SliderObject.Top And y < SliderObject.Bottom Then
    TimCom1.Enabled = True
    If Aix <> True Then comColor(0) = Bcolor(2): comColor(1) = Bcolor(3): comColor(2) = Fcolor(1): Call MoveVilss(Value)
    Else
    If Aix <> True Then comColor(0) = Bcolor(0): comColor(1) = Bcolor(1): comColor(2) = Fcolor(0): Call MoveVilss(Value)
    End If
    If Button = 1 Then
    comColor(0) = Bcolor(4): comColor(1) = Bcolor(5): comColor(2) = Fcolor(2)
    Call SlidingBlock(x)
    End If
    End Sub

    Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    comColor(0) = Bcolor(0): comColor(1) = Bcolor(1): comColor(2) = Fcolor(0)
    Call MoveVilss(Value)
    Aix = False
    End Sub
    '----------------------------------------------------------------------------------------------------------------------------------------
    '六、处理鼠标移出控件范围的事件
    Private Sub TimCom1_Timer()
    Dim rt As RECT, Point As POINTAPI
    GetCursorpos Point
    GetWindowRect UserControl.Hwnd, rt
    If Point.x < rt.Left Or Point.x > rt.Right Or Point.y < rt.Top Or Point.y > rt.Bottom Then
    If Aix <> True Then
    comColor(0) = Bcolor(0): comColor(1) = Bcolor(1): comColor(2) = Fcolor(0)
    Call MoveVilss(Value)
    TimCom1.Enabled = False
    End If
    End If
    End Sub
    '----------------------------------------------------------------------------------------------------------------------------------------
    '七、编写控件各个属性
    '最大数值
    Public Property Get Max() As Double
    Max = SR_Max
    End Property

    Public Property Let Max(ByVal vNewValue As Double)
    SR_Max = vNewValue
    PropertyChanged “Max”
    End Property

    '最小数值
    Public Property Get Min() As Double
    Min = SR_Min
    End Property

    Public Property Let Min(ByVal vNewValue As Double)
    SR_Min = vNewValue
    PropertyChanged “Min”
    End Property

    '进度值
    Public Property Get Value() As Double
    Value = SR_Value
    End Property

    Public Property Let Value(ByVal vNewValue As Double)
    SR_Value = vNewValue
    Call MoveVilss(vNewValue)
    PropertyChanged “Value”
    End Property

    '控件边框线及背景颜色
    Public Property Get BackColor1() As OLE_COLOR
    BackColor1 = Bcolor(8)
    End Property

    Public Property Let BackColor1(ByVal vNewValue As OLE_COLOR)
    Bcolor(8) = vNewValue
    Call MoveVilss(Value)
    PropertyChanged “BackColor1”
    End Property

    Public Property Get BackColor2() As OLE_COLOR
    BackColor2 = Bcolor(9)
    End Property

    Public Property Let BackColor2(ByVal vNewValue As OLE_COLOR)
    Bcolor(9) = vNewValue
    Call MoveVilss(Value)
    PropertyChanged “BackColor2”
    End Property

    '滑块按钮边框线颜色
    Public Property Get ButColorA1() As OLE_COLOR
    ButColorA1 = Bcolor(0)
    End Property

    Public Property Let ButColorA1(ByVal vNewValue As OLE_COLOR)
    Bcolor(0) = vNewValue
    comColor(0) = vNewValue
    Call MoveVilss(Value)
    PropertyChanged “ButColorA1”
    End Property

    Public Property Get ButColorA2() As OLE_COLOR
    ButColorA2 = Bcolor(1)
    End Property

    Public Property Let ButColorA2(ByVal vNewValue As OLE_COLOR)
    Bcolor(1) = vNewValue
    comColor(1) = vNewValue
    Call MoveVilss(Value)
    PropertyChanged “ButColorA2”
    End Property

    Public Property Get ButColorB1() As OLE_COLOR
    ButColorB1 = Bcolor(2)
    End Property

    Public Property Let ButColorB1(ByVal vNewValue As OLE_COLOR)
    Bcolor(2) = vNewValue
    PropertyChanged “ButColorB1”
    End Property

    Public Property Get ButColorB2() As OLE_COLOR
    ButColorB2 = Bcolor(3)
    End Property

    Public Property Let ButColorB2(ByVal vNewValue As OLE_COLOR)
    Bcolor(3) = vNewValue
    PropertyChanged “ButColorB2”
    End Property

    Public Property Get ButColorC1() As OLE_COLOR
    ButColorC1 = Bcolor(4)
    End Property

    Public Property Let ButColorC1(ByVal vNewValue As OLE_COLOR)
    Bcolor(4) = vNewValue
    PropertyChanged “ButColorC1”
    End Property

    Public Property Get ButColorC2() As OLE_COLOR
    ButColorC2 = Bcolor(5)
    End Property

    Public Property Let ButColorC2(ByVal vNewValue As OLE_COLOR)
    Bcolor(5) = vNewValue
    PropertyChanged “ButColorC2”
    End Property

    Public Property Get ButColorD1() As OLE_COLOR
    ButColorD1 = Bcolor(6)
    End Property

    Public Property Let ButColorD1(ByVal vNewValue As OLE_COLOR)
    Bcolor(6) = vNewValue
    PropertyChanged “ButColorD1”
    End Property

    Public Property Get ButColorD2() As OLE_COLOR
    ButColorD2 = Bcolor(7)
    End Property

    Public Property Let ButColorD2(ByVal vNewValue As OLE_COLOR)
    Bcolor(7) = vNewValue
    PropertyChanged “ButColorD2”
    End Property

    '字体颜色
    Public Property Get ForeColor() As OLE_COLOR
    ForeColor = Fcolor(0)
    End Property

    Public Property Let ForeColor(ByVal vNewValue As OLE_COLOR)
    Fcolor(0) = vNewValue
    comColor(2) = vNewValue
    Call MoveVilss(Value)
    PropertyChanged “ForeColor”
    End Property

    Public Property Get ForeColor1() As OLE_COLOR
    ForeColor1 = Fcolor(1)
    End Property

    Public Property Let ForeColor1(ByVal vNewValue As OLE_COLOR)
    Fcolor(1) = vNewValue
    PropertyChanged “ForeColor1”
    End Property

    Public Property Get ForeColor2() As OLE_COLOR
    ForeColor2 = Fcolor(2)
    End Property

    Public Property Let ForeColor2(ByVal vNewValue As OLE_COLOR)
    Fcolor(2) = vNewValue
    PropertyChanged “ForeColor2”
    End Property

    Public Property Get ForeColor3() As OLE_COLOR
    ForeColor3 = Fcolor(3)
    End Property

    Public Property Let ForeColor3(ByVal vNewValue As OLE_COLOR)
    Fcolor(3) = vNewValue
    PropertyChanged “ForeColor3”
    End Property
    '----------------------------------------------------------------------------------------------------------------------------------------
    '八、读写各个属性值
    '储存属性参数值到内存
    Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    '- - - 按钮背景颜色 - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Call PropBag.WriteProperty(“Max”, SR_Max, 32767)
    Call PropBag.WriteProperty(“Min”, SR_Min, 0)
    Call PropBag.WriteProperty(“Value”, SR_Value, 0)
    Call PropBag.WriteProperty(“BackColor2”, UserControl.BackColor, RGB(255, 255, 255))
    Call PropBag.WriteProperty(“ButColorA1”, Bcolor(0), RGB(0, 0, 0))
    Call PropBag.WriteProperty(“ButColorA2”, Bcolor(1), RGB(83, 83, 83))
    Call PropBag.WriteProperty(“ButColorB1”, Bcolor(2), RGB(120, 120, 120))
    Call PropBag.WriteProperty(“ButColorB2”, Bcolor(3), RGB(150, 150, 150))
    Call PropBag.WriteProperty(“ButColorC1”, Bcolor(4), RGB(0, 0, 0))
    Call PropBag.WriteProperty(“ButColorC2”, Bcolor(5), RGB(50, 50, 50))
    Call PropBag.WriteProperty(“ButColorD1”, Bcolor(6), RGB(168, 168, 168))
    Call PropBag.WriteProperty(“ButColorD2”, Bcolor(7), RGB(240, 240, 240))
    Call PropBag.WriteProperty(“BackColor1”, Bcolor(8), RGB(125, 125, 125))
    Call PropBag.WriteProperty(“BackColor2”, Bcolor(9), RGB(222, 222, 222))
    '- - - 按钮字体颜色 - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Call PropBag.WriteProperty(“ForeColor”, Fcolor(0), vbWhite)
    Call PropBag.WriteProperty(“ForeColor1”, Fcolor(1), vbYellow)
    Call PropBag.WriteProperty(“ForeColor2”, Fcolor(2), RGB(100, 255, 0))
    Call PropBag.WriteProperty(“ForeColor3”, Fcolor(3), RGB(100, 100, 100))
    End Sub

    '从内存里读取属性设置值
    Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    '- - - 按钮背景颜色 - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    SR_Max = PropBag.ReadProperty(“Max”, 32767)
    SR_Min = PropBag.ReadProperty(“Min”, 0)
    SR_Value = PropBag.ReadProperty(“Value”, 0)
    UserControl.BackColor = PropBag.ReadProperty(“BackColor2”, RGB(255, 255, 255))
    Bcolor(0) = PropBag.ReadProperty(“ButColorA1”, RGB(0, 0, 0))
    Bcolor(1) = PropBag.ReadProperty(“ButColorA2”, RGB(83, 83, 83))
    Bcolor(2) = PropBag.ReadProperty(“ButColorB1”, RGB(120, 120, 120))
    Bcolor(3) = PropBag.ReadProperty(“ButColorB2”, RGB(150, 150, 150))
    Bcolor(4) = PropBag.ReadProperty(“ButColorC1”, RGB(0, 0, 0))
    Bcolor(5) = PropBag.ReadProperty(“ButColorC2”, RGB(50, 50, 50))
    Bcolor(6) = PropBag.ReadProperty(“ButColorD1”, RGB(168, 168, 168))
    Bcolor(7) = PropBag.ReadProperty(“ButColorD2”, RGB(240, 240, 240))
    Bcolor(8) = PropBag.ReadProperty(“BackColor1”, RGB(125, 125, 125))
    Bcolor(9) = PropBag.ReadProperty(“BackColor2”, RGB(222, 222, 222))
    '- - - 按钮字体颜色 - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Fcolor(0) = PropBag.ReadProperty(“ForeColor”, vbWhite)
    Fcolor(1) = PropBag.ReadProperty(“ForeColor1”, vbYellow)
    Fcolor(2) = PropBag.ReadProperty(“ForeColor2”, RGB(255, 100, 0))
    Fcolor(3) = PropBag.ReadProperty(“ForeColor3”, RGB(100, 100, 100))
    comColor(0) = Bcolor(0): comColor(1) = Bcolor(1): comColor(2) = Fcolor(0): Call MoveVilss(Value)
    End Sub
    '----------------------------------------------------------------------------------------------------------------------------------------
    '----------------------------------------------------------------------------------------------------------------------------------------
    '到此一个简易的滚动条COX控件就完成了,至于控件界面美化或更多功能自己改动和研究啦,嘿嘿~~
    '转载请标明出处:https://blog.csdn.net/ty5858?spm=1010.2135.3001.5421

    展开全文
  • 展开全部1、首先我们打开vb6.0软件进入到标准”工程1“界面,这些32313133353236313431303231363533e78988e69d8331333433626538比较简单,就不一一上图了,在”form1“窗口上加载一个文本框”text1”如图。...

    展开全部

    1、首先我们打开vb6.0软件进入到标准”工程1“界面,这些32313133353236313431303231363533e78988e69d8331333433626538比较简单,就不一一上图了,在”form1“窗口上加载一个文本框”text1”如图。

    2、文本框加载好以后,需要在右边属性界面设置它的高度和宽度。

    3、点击属性界面的“height”设置文本框“text1”的高度为2000,再点击“width”设置文本框“text1”的宽度为2500如图。

    4、然后再在文本框“text1”下面加载一个水平滚动条,然后设置水平滚动条的属性最大值“max“为2500”value“的值也为2500,最后更改水平滚动条的名称为”h1“如图。

    5、然后把水平滚动条的最大位移量(largechange)设置为20最小位移量(smallchange)设置为2如图。

    6、按照上面的方法,我们再把垂直滚动条加上,设置它的属性最大值为2000"value"值为2000,更改垂直水平条名称为v1,再设置垂直水平条最大位移量为20最小位移量为2如图。

    7、然后是给这个工程编写程序:

    PrivateSubh1_Change()

    Text1.Width=h1.Value(文本框的宽度等于水平滚动条的value值)

    EndSub

    PrivateSubv1_Change()

    Text1.Height=v1.Value(文本框的高度等于垂直滚动条的value值)

    EndSub

    8、即可随意调整文本框大小,拉水平滚动条文本框会宽度会随水平滚动条改变,拉垂直滚动条文本框高度会随垂直滚动条改变。

    展开全文
  • 设置窗体坐标尺度模式和字体大小 Me .ScaleMode = vbPixels Me .FontSize = List1.FontSize 设置列表框的水平滚动条 Call setListWidth End Sub '方法二:-------------------------------------------...
    Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
    Private Const LB_SETHORIZONTALEXTENT = &H194
    --------------------------------------------------------------------------------------------------
    Private Sub setListWidth() '如果列表框不够宽,则增加水平滚动条 Dim i As Integer Dim List_MaxL As Integer '获得选项内容的最大长度 For i = 0 To List1.ListCount - 1 '&apos;让list_maxl中保存最长的一条字串 If Len(List1.List(i)) > List_MaxL Then List_MaxL = Len(List1.List(i)) + 2 End If Next i '判断是否内容显示不完全,如果是则添加水平滚动条 If Me.TextWidth("AA ") * List_MaxL > List1.Width Then SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, Me.TextWidth("a") * List_MaxL, ByVal 0& End If End Sub
    --------------------------------------------------------------------------------------------------
    Private Sub Form_Load()
          Dim i     As Integer
          '为ListBox控件添加选项
          For i = 0 To 100
                List1.AddItem ("这是,最据jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj:(第   " + CStr(i)) & "行) "
               'List1.AddItem   ( "(第   "   +   CStr(i))   &   "行) "
          Next i
         ' 设置窗体坐标尺度模式和字体大小
          Me.ScaleMode = vbPixels
          Me.FontSize = List1.FontSize
         设置列表框的水平滚动条
          Call setListWidth
    End Sub


    '方法二:-----------------------------------------------------------------------------------------------

    '添加 ListBox 水平滚动条-------------------------------------------------
    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    
    Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, _
    ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    
    Const LB_SETHORIZONTALEXTENT = &H194
    Const DT_CALCRECT = &H400
    
    
    
    Public Function ListTextWidth(ByRef lstThis As ListBox) As Long '获取最长项目的象素长度值
    Dim i As Long
    Dim tR As RECT
    Dim lW As Long
    Dim lWidth As Long
    Dim lHDC As Long
    With lstThis.Parent.Font
    .Name = lstThis.Font.Name
    .Size = lstThis.Font.Size
    .Bold = lstThis.Font.Bold
    .Italic = lstThis.Font.Italic
    End With
    lHDC = lstThis.Parent.hdc
    For i = 0 To lstThis.ListCount - 1 '遍历所有的列表项以找到最长的项
    DrawText lHDC, lstThis.List(i), -1, tR, DT_CALCRECT
    lW = tR.Right - tR.Left + 8
    If lW > lWidth Then lWidth = lW
    Next
    ListTextWidth = lWidth + 20 '返回最长列表项的长度(像素)
    End Function

    Private Sub Form_Load()
    '设置 List 横向滚动条
    dim l As Long
    l = ListTextWidth(ltCol)
    SendMessage ltCol.hwnd, LB_SETHORIZONTALEXTENT, l, 0
    
    End Sub
     
       

     

     
     

     


     

     



    转载于:https://www.cnblogs.com/wx881208/p/4180035.html

    展开全文
  • * 1:按钮样式设置 * 2:文本框样式设置 * 3:进度条样式 * 4:滑块条样式 * 5:单选框样式 * 6:滚动条样式 * 7:可自由设置对象的高度宽度大小等 * 8:自带默认参数值 三、效果图 五、核心代码 #pragma execution_...
  • 滚动条的scroll事件

    千次阅读 2021-06-11 04:30:07
    vb中,滚动条的scroll 事件和change 事件的区别scroll和change的区别为:指代不同、用法不同、侧重点不同 一、指代不同scroll:滚屏,滚动。change:变更,变革。 二、用法不同scroll:过去式,scrolled,过去分词...
  • vb 自制的滚动显示控件,实现平滑滚动,可以设置开启关闭滚动设置滚动速度、设置字体、背景、及字体大小等。 如果需要源代码,请email:hamll@163.com
  • 滚动条(ScorllBar)和Slider控件都有水平和垂直两种,Slider控件位于Micosofte Windows Common Control 6.0部件种,应用“部件”对话框设置对它的引用才可出现在工具箱中。1.滚动条(ScorllBar)和Slider控件共同具有的...
  • VB属性对应的中文AAction返回或设置被显示的对话框(CommandDialog)的类型,在设计时无效。ActiveControl活动控件ActiveForm活动窗体Alignment文本对齐类型Align指定图形在图片框中的位置Archive文本列表框是否含有...
  • windows form chart控件功能已经非常强大了,做出来效果也是相当好看。更重要的是使用起来相当的方便。 现在要介绍的chart图表的放大与缩小功能,当...放大后的效果,可以看具体某一个值的大小了。 图2 图3
  • 知识点三:常用控件与界面设计重点:1、掌握列表框、组合框、选项按钮、复选按钮、滚动条等控件的常用的属性、方法、事件2、掌握菜单的设计(7)列表框(ListBox):用于列出可供用户选择的项目列表。用户可以从中选择一...
  • 这个题目,其实和我用的项目没什么关系,不过顶一下吧,我主要是用的垂直滚动条。就是滚动条是根据信息自动滚动了,但是文字会显示不全所以还是使用SetCurSel这个接口来直接实现了,毕竟现在要求还不是很严,如果...
  • 2017年9月计算机二级《VB》选择题题库参考答案与解析(1)D【解析】文本框的ScrollBars属性值,0表示无滚动条,1表示只有水平滚动条,2表示只有垂直滚动条,3表示水平和垂直滚动条都有。故D选项正确。(2)C【解析】参数...
  • 一、选择题第一章开启VB编程之旅1.(2011)31.在Visual Basic6.0集成开发环境中,不能运行程序的操作是A.按“F5”键B.从“运行”菜单中选择“启动”命令C.在工具栏中单击“启动”按钮D.按“F6”键2.(2012)31.在...
  • 1、VB6.0对口升学考点分析与总结第一章 VB使用基础1、VB的特点2、VB的启动与退出3、VB的窗口组成4、VB的属性窗口中、代码窗口的打开操作方法5、VB程序的保存及各种文件的扩展名6、VB程序的运行方法7、对象、属性、...
  • Win32的标准控件之中,列表控件(ListBox)并没有和列表视图(ListView)一样提供水平滚动条,所以如果列表项的长度超过列表的宽度的话,那么超出的部分将无法显示。在本文中我将以一个简单的例子来说明如何使用SDK...
  • 20套 VB上机考试操作练习题第20套 上机考试操作模拟试题一、基本操作题(1)在名称为Form1的窗体上绘制一个文本框,名称为Txt1,字体为"宋体",文本框中的初始内容为"二级Visual Basic";再绘制一个命令按钮,名称为...
  • 《大一VB编程计算机期末考试试题库》由会员分享,可在线阅读,更多相关《大一VB编程计算机期末考试试题库(9页珍藏版)》请在人人文库网上搜索。1、试卷编号: 9335 所属语言: Visual Basic 试卷方案:28_考试 试卷...
  • 2013年 VB对口升学真题

    2021-07-25 00:36:22
    《2013年 VB对口升学真题》由会员分享,可在线阅读,更多相关《2013年 VB对口升学真题(4页珍藏版)》请在人人文库网上搜索。1、Visual Basic语言程序设计 一、 选择题1、 窗体上有一个文本框,且为该文本框编写了...
  • vb.net控件

    千次阅读 2020-04-28 14:49:22
    vb.net 的 Label 控件 label(标签)控件用于显示文本,是设计应用程序界面时经常要用到的控件之一, 主要是用于显示其他控件名称,描述程序运行状态或标识程序运行的结果信息等 等,响应程序的事件或跟踪程序运行的...
  • 商场搞活动想要制作一个抽奖程序,今天我们就来看看使用vb6.0制作抽奖小程序的教程。选择“用户自定义规则”并点击“新建”按钮,弹出选择新规则类型对话 框(如图35),新建一个自定义规则。3、每天的同一时间定时...
  • VB.NET(1)——创建第一个窗口程序

    千次阅读 2020-04-11 21:43:05
    1.创建项目 下载Visual Studio 2010及其以上的版本,作者是2013版。 文件->新建项目。 在弹出的对话框内,左侧选择其他语言,选择...我们需要在上面添加控件,每个控件都是一个对象,VB.NET是OOP(面向对象编程...
  • VB常用控件介绍

    千次阅读 2018-02-16 16:24:30
    (7) ScrollBars 属性: 用来设置滚动条模式, 有四种选择: ScrollBars.None (无滚动条), ScrollBars.Horizontal(水平滚动条),ScrollBars.Vertical(垂直滚动条),ScrollBars.Both(水平和垂直滚动...
  • 改为正确的内容, 完成以下功能:如果在列表框中选择一种字体,然后移动滚动条中的滚动框,则可使文本框中的文字按所选择的字体显示,并可随着滚动框的移动放大或缩小;如果不选择字体直接移动滚动框,则显示一个信息...
  • 1 点击工具-选项-编辑器格式,把代码改成... 2 从以下网站下载VB6增强工具,可以支持鼠标滚轮代替右侧滚动条查看代码,按F3还可以切换代码窗口和设计窗口。 http://www.greenxf.com/soft/21255.html  ...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 2,463
精华内容 985
关键字:

vb滚动条设置字体大小