精华内容
下载资源
问答
  • 关于VB里的ScaleMode问题

    千次阅读 2018-12-07 21:00:30
    我是一个VB初学者,最近苦恼于VB的窗体和控件的ScaleMode问题,VB里默认的ScaleMode是twip,而往往我们希望它是pixel,虽然在属性面板里面能够将ScaleMode改为"3-Pixel",但是我发现在程序中返回某个窗体...

    我是一个VB初学者,最近苦恼于VB的窗体和控件的ScaleMode问题,VB里默认的ScaleMode是twip,而往往我们希望它是pixel,虽然在属性面板里面能够将ScaleMode改为"3-Pixel",但是我发现在程序中返回某个窗体或控件的属性时还是返回为很大的twips值,比如有一个PictureBox控件picMyPic,那么假如在程序中用另一个变量iWidth来接收控件的宽度:iWidth = picMyPic.Width,则它还是返回一个很大的twip值,比如返回6100,而控件的宽度大概只有两百多像素。
    所以请问有没有办法,让它返回一个以像素为单位的数值?twip和pixel之间又是如何转换的?
    设置form的scalemode=3只能使
    picMyPic.scaleWidth为象素
    picMyPic.Width当然为Twip,因为你没有把picMyPic.salemode=3
    ScaleX、ScaleY 方法

    用以将 Form,PictureBox 或 Printer 的宽度或高度值从一种 ScaleMode 属性的度量单位转换到另一种。不支持命名参数。

    语法

    object.ScaleX (width, fromscale, toscale)

    object.ScaleY (height, fromscale, toscale)

    ScaleX 和 ScaleY 方法的语法包含如下部分:

    部分 描述
    object 可选的。一个对象表达式,其值为“应用于”列表中的一个对象。如果省略 object,则带有焦点的 Form 对象缺省为 object。
    width 必需的。为 object 指定被转换的度量单位的数量。
    height 必需的。为 object 指定被转换的度量单位的数量。
    fromscale 可选的。一个常数或数值,按照下列设置中的描述,指定 object 的 width 或 height 从哪一种坐标系统转换。fromscale 可取的数值与 ScaleMode 属性的数值加上 HiMetric 的新数值相同。
    toscale 可选的。一个常数或数值,按照下列“设置值”中的描述,指定 object 的 width 或 height 转换到哪一种坐标系统。toscale 可取的数值与 ScaleMode 属性的数值加上 HiMetric 的新数值相同。

    设置值

    用于 fromscale 和 toscale 设置值有:

    常数 值 描述
    vbUser 0 用户定义:指示 object 的宽度和高度设置为自定义值。
    vbTwips 1 缇(每逻辑英寸 1440 缇;每逻辑厘米 567 缇)。
    vbPoints 2 磅(每逻辑英寸 72 点)。
    vbPixels 3 像素 (显示器或打印机分辨率的最小单位)。
    vbCharacters 4 字符(水平 = 每单位 120 缇,垂直 = 每单位 240 缇)。
    vbInches 5 英寸
    vbMillimeters 6 毫米
    vbCentimeters 7 厘米
    vbHimetric 8 HiMetric。如果省略 fromscale,则 HiMetric 为缺省值。
    vbContainerPosition 9 决定控件位置。
    vbContainerSize 10 决定控件大小。

    说明

    ScaleX 和 ScaleY 方法按 fromscale 指定的度量单位取值(width 或 height),并将它转换为 toscale 指定的度量单位下相应的值。

    也可以结合 PaintPicture 方法使用 ScaleX 和 ScaleY。
    15twip=1pixel
    实际上可以用Screen.TwipsPerPixelX和Screen.TwipsPerPixelY作为系数来转换
    PixelX = TwipX/Screen.TwipsPerPixelX
    PixelY = TwipY/Screen.TwipsPerPixelY

    展开全文
  • 从上边的表格可以看出: ...而UserControl.Extender的Top和Left属性的单位和控件所在容器的ScaleMode相同. 控件内部Mouse事件中的X和Y与ActiveX控件自身的ScaleMode相关. Form的Width和Height总是以Tw


    从上边的表格可以看出:

    ActiveX控件的内部属性中,UserControl的Width和Height总是以Twips为单位的.

    而UserControl.Extender的Top和Left属性的单位和控件所在容器的ScaleMode相同.

    控件内部Mouse事件中的X和Y与ActiveX控件自身的ScaleMode相关.

    Form的Width和Height总是以Twips为单位.

    Form内部Mouse事件中的X和Y与Form的ScaleMode相关.


    注:

    内部属性值表示在设计控件时的内部代码获取或者设置的控件属性值。

    外部属性值表示在使用控件的窗体代码中获取或者设置的控件属性值。

    自身ScaleMode表示在设计控件时控件的ScaleMode属性。

    容器ScaleMode表示在使用控件的窗体中,存放控件的容器的ScaleMode。

    展开全文
  • 如何理解VB窗体中的scale类属性及width height属性之间的关系  VB中的SCALEHIEGT,SCALEWIDTH,与窗体中的WIDTH,HEIGHT的区别及关系是许多VB初学者难以理解的。本人在学习DELPHI的过程中也曾经对这类似的概论搞不...

    如何理解VB窗体中的scale类属性及width height属性之间的关系
        VB中的SCALEHIEGT,SCALEWIDTH,与窗体中的WIDTH,HEIGHT的区别及关系是许多VB初学者难以理解的。本人在学习DELPHI的过程中也曾经对这类似的概论搞不清楚,但通过这次对VB中这些类似概念的学习后,可以说是已掌握了这种概念及原理了。现在回头看DELPHI的相关知识点有豁然开朗的感觉,VB的确是可视化编程入门的最佳语言。

     

    问题的提出
        在VB中默认的度量单位是缇,这是一种跟屏幕分辨率无关的一种度量单位,主要是用在打印机上的,大概是1缇=1/20磅。其它的一些单位请查看MSDN。使用缇就会给我们带来一些麻烦,因为我们都习惯于使用像素来度量窗体及控件的大小,并使用显示器当前的分辨率作参考物来确定窗体的适当大小,当我们想动态地改变窗体的大小的时候我们该如何确定正确的数值呢,想动态地移动窗体中的控件,该如何确定控件的位置呢?同时,在VB的窗体中同时存在着这样的一些属性:scaleWidth,scaleHeight,scaleLeft,scaleTop,scaleMode,Width,Height,他们之间是怎样的关系,是如何影响窗体中控件的大小的呢?通过下面的解说,我们就能解决上面所提到的问题。

        其实在VB中的窗体内部(除去窗体边框及标标题栏的区域)有一个类似于画布的东西,它始终是占满整个窗体区域的,他有一个坐标系统,默认的是原点就是窗体的左上角,坐标是0,0 然后往左伸延的就是X轴,往下就是Y轴了,但是这个坐标的单位默认就是缇,当然我们是可以修改成其它类型的单位,要修改度量单位的话就要设定窗体的scaleMode属性。如:设为像素scaleMode=3 。这个坐标系统是用来确定要在什么位置上通过PRINT等方法来作图的,以及确定在这个容器中的什么位置上放置控件,以及跟窗体宽和高的比例情况。
    VB使用的度量单位共有8种。系统默认的度量单位是缇(Twip,1厘米=576缇),用户可以根据需要,选择系统提供的其它标准度量单位。度量单位的设置是由窗体或图片框的ScaleMode属性定义的。其属性值及对应的度量单位及用法见表9-1-1。
    表9-1-1 VB的度量单位
    属性值 字符常量 说明
    VbUser 用户自定义类型。若用户使用ScaleWidth、ScaleHeight、ScaleTop、ScaleLeft设置坐标系统,VB会自动设置ScaleMode为0
    1 VbTwips 默认值,以Twip为单位。1英寸=144 Twip
    2 VbPoints 以磅(Point)为单位,1英寸=72磅
    3 VbPixels 像素(Pixel),即显示器分辨率的最小单位。
    4 VbCharacters 字符, 1个字符宽度=120 Twip,1个字符高度=240 Twip
    5 VbInches 英寸
    6 VbMillimeters 毫米
    7 VbCentimeters 厘米
    说明:
    ⑴ 上表中,除了0和3外,其余规格均可用于打印机,所使用的单位长度就是打印机上输出的长度。
    ⑵ ScaleMode属性可以在设计阶段在属性窗口设置,也可以通过程序代码设置。例如:
    Form1.ScaleMode=5      ‘窗体坐标系统以英寸为单位
    Picture1.ScaleMode=7     ‘图片框坐标系统以厘米为单位

     

    预备知识
        其实在VB中的窗体内部(除去窗体边框及标标题栏的区域)有一个类似于画布的东西,它始终是占满整个窗体区域的,他有一个坐标系统,默认的是原点就是窗体的左上角,坐标是0,0 然后往左伸延的就是X轴,往下就是Y轴了,但是这个坐标的单位默认就是缇,当然我们是可以修改成其它类型的单位,要修改度量单位的话就要设定窗体的scaleMode属性。如:设为像素scaleMode=3。这个坐标系统是用来确定要在什么位置上通过PRINT等方法来作图的,以及确定在这个容器中的什么位置上放置控件,以及跟窗体宽和高的比例情况。

    scale类属性的作用
        清楚了窗体有这样一个画布及它的坐标后,我们再来看看有关这个坐标系统的属性。这些scale类型属性主要是用来设定画布坐标系统的数值跟窗体的高宽数值比例情况的。具体是怎样的关系及怎样影响在下面有论说。scaleLeft,scaleTop这两个属性是用来设定这个坐标系统的原点位置的,系统默认的scaleLeft,scaleTop是0,也就是说原点在窗体的左上角了,坐标系统只有大于0的那一块坐标,这样的好处是可以很直观地使用这个坐标系统因为参照点是0且是从窗体的左上角开始的。如果把这两个值设定为大于0的话,画布的坐标就有正负区域了,这样就更像我们数学上的坐标系统了。scaleMode用于设定坐标轴的度量单位。


    width,Height的作用
        这两个属性是用于设定窗体的宽和高,他们的单位始终是缇,会直接影响到画布的大小及坐标的比例情况,要动态设置窗体的大小也只能通过这两个属性来设定。


    这些属性的关系
        默认情况下,窗体的宽和高是跟窗体上的画布的宽和高是一样大小的,且画布的坐标原点就是窗体的左上角。也就是说,画布的宽和窗体的宽是1:1的关系,也就是说画布的1缇宽度相当于窗体的1缇宽度。那么当我们在窗体上用print.circle (500,500),200来画一个圆的时候,原点就是在距窗体顶部500个缇,左边500个缇,半径是200个缇。现在我们尝试把窗体上的scaleHeight,scaleWidth修改为原来的1/2,现在也是用同样的方法来画一个圆,对比这一下现在的圆跟修改前的圆,可以发现当前圆的半径比原来的扩大了一倍,而且圆心的位置也改变了。同样的参数为什么会有不一要结果呢?这就是scaleHeight scaleWidth起的作用,假如窗体原本的width是1000缇,scaleWidth也是1000缇,也就是说他们是1:1的关系,我们用 print.circle (500,500),200在画布上画出来的圆所用的尺寸单位是1:1的,明确一点说就是在画布宽上所画的一缇就是窗体宽度的一缇,但修改了scaleWidth后,比如说是原来值的一半,情况就不一样了,画布跟窗体的比例就变成是1:2了,在画布看来,要用原来数值的一半来表示窗体的宽,那么只能是1个缇来表示窗体width的两个缇了,这样的话如果还是用原来参数来使用print方法来作圆的话,出来的圆就是原来的两倍了。情况就有点像要在一张白张上把整个中国地图画出来一样,张上的一毫米就相当于实际十万八千公里了。这就是scale属性跟窗体width,height之间或关系了。


    缇跟像素的关系
    我们可以通过VB的系统对像screen的twipPerPixersX及twipPerPixersX属性来返回当前分辨率下每一像素所占缇,默认情况下应该是15。但这个值是不是固定的呢?答案是不的,屏幕也是一个画布,同时也像窗体一样有高和宽,要返回15的前提条件是scaleWidth跟width是1:1,scaleHeight跟height也是1:1。
    总结
        窗体上有一个画布,它的坐标系统默认是跟窗体一样的,但可以通过scale类属性可以去修改。通过这些scale类属性我们可以开发出一种具有图形放大缩小功能的程序,只要把作图的方法中参数保持不变,动态改变scale属性就可以达到目的,这种关系是成反比的,也就是说参数不变,scale减小的话图形就放大。这类程序的例子就像是股票分析软件中的成交量图。
        另:DELPHI也有类似的画布机制。原理是基本上一致的。

    展开全文
  • VB通过调用DLL实现图片实时旋转,可360度旋转,掩码色改变,甚至可以调整图片透明度、亮度、色相、饱和度、大小缩放等图片常用的值。程序很好的解决了GetDC引起内存泄露问题,兼容Win98至Win7环境。Dll文件由VC生成...
  • 一款个性的表格效果,Vb源代码,简单有效的例子,请仔细看一下Picture1的ScaleMode属性的用法和定义,对学习Vb很有帮助的。
  • 本压缩包为vb标准控件的介绍,通过此文档,你可以对vb控件有个全面的认识,在编程时做到事半功倍,各种控件介绍详细、清晰。有助于读者查阅
  • Printer.ScaleMode = 6 Printer.FontBold = False Printer.ScaleLeft = -20 Printer.ScaleTop = -25 Printer.ScaleWidth = 210 Printer.ScaleHeight = 297 usewidth = Printer.ScaleWidth - 40 ...
  • VB自制进度条控件

    2021-03-22 18:00:47
    一、“添加用户控件”,命名为"ProgressBar",代码如下: Option Explicit Public Enum U_TextAlignments [Left Top] = 1 [Left Middle] = 2 [Left Bottom] = 3 [Center Top] = 4 [Center Middle] = 5 ...

    在这里插入图片描述

    一、“添加用户控件”,命名为"ProgressBar",代码如下:
    Option Explicit

    Public Enum U_TextAlignments
    [Left Top] = 1
    [Left Middle] = 2
    [Left Bottom] = 3
    [Center Top] = 4
    [Center Middle] = 5
    [Center Bottom] = 6
    [Right Top] = 7
    [Right Middle] = 8
    [Right Bottom] = 9
    End Enum

    Public Enum U_TextEffects
    [Normal] = 1
    [Embossed] = 2
    [Engraved] = 3
    [OutLine] = 4
    [Shadow] = 5
    End Enum

    Public Enum U_OrientationsS
    [Horizontal] = 1
    [Vertical] = 2

    End Enum

    Public Enum U_TextStyles
    [PBValue] = 1
    [PBPercentage] = 2
    [CustomText] = 3
    [PBNoneText] = 4
    End Enum

    Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
    End Type

    Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
    End Type

    Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
    End Type

    Private Type cRGB
    Blue As Byte
    Green As Byte
    Red As Byte
    End Type

    Enum U_Themes
    [IceOrange] = 1
    [IceYellow] = 2
    [IceGreen] = 3
    [IceCyan] = 4
    [IceBangel] = 5
    [IcePurple] = 6
    [IceRed] = 7
    [IceBlue] = 8
    [Vista] = 9
    [Custome] = 10
    End Enum
    Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
    End Type

    Public Enum GRADIENT_DIRECT
    [Left to Right] = &H0
    [Top to Bottom] = &H1
    End Enum

    Private Type TRIVERTEX
    x As Long
    y As Long
    Red As Integer
    Green As Integer
    Blue As Integer
    Alpha As Integer
    End Type

    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
    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 SetDIBitsToDevice Lib “gdi32” (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
    Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
    Private Declare Function GradientFillRect Lib “msimg32” Alias “GradientFill” (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
    Private Declare Function SetRect Lib “user32” (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long

    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type

    Const GRADIENT_FILL_RECT_H As Long = &H0
    Const GRADIENT_FILL_RECT_V As Long = &H1
    Private Const BI_RGB = 0&
    Private Const DIB_RGB_COLORS = 0

    Private U_TextStyle As U_TextStyles
    Private U_Theme As U_Themes
    Private U_Orientation As U_OrientationsS
    Private U_Text As String
    Private U_TextColor As OLE_COLOR
    Private U_TextAlign As U_TextAlignments
    Private U_TextFont As Font
    Private U_TextEC As OLE_COLOR
    Private U_TextEffect As U_TextEffects
    Private U_RoundV As Long
    Private U_Min As Long
    Private U_Value As Long
    Private U_Max As Long
    Private U_Enabled As Boolean
    Private c(16) As Long
    Private U_PBSCC1 As OLE_COLOR
    Private U_PBSCC2 As OLE_COLOR

    Private Sub UserControl_Initialize()
    UserControl.AutoRedraw = True
    End Sub

    Private Sub UserControl_Resize()
    Bar_Draw
    End Sub

    Public Property Let Value(ByVal NewValue As Long)
    If NewValue > U_Max Then NewValue = U_Max
    If NewValue < U_Min Then NewValue = U_Min
    U_Value = NewValue

    PropertyChanged "Value"
    Bar_Draw
    

    End Property

    Public Property Get Value() As Long
    Value = U_Value
    End Property

    Public Property Let Max(ByVal NewValue As Long)
    If NewValue < 1 Then NewValue = 1
    If NewValue <= U_Min Then NewValue = U_Min + 1
    U_Max = NewValue
    If Value > U_Max Then Value = U_Max
    PropertyChanged “Max”
    Bar_Draw
    End Property
    Public Property Get Max() As Long
    Max = U_Max
    End Property

    Public Property Let Min(ByVal NewValue As Long)
    If NewValue >= U_Max Then NewValue = Max - 1
    If NewValue < 0 Then NewValue = 0
    U_Min = NewValue
    If Value < U_Min Then Value = U_Min

    PropertyChanged "Min"
    Bar_Draw
    

    End Property
    Public Property Get Min() As Long
    Min = U_Min
    End Property
    Public Property Get RoundedValue() As Long
    RoundedValue = U_RoundV
    End Property

    Public Property Let RoundedValue(ByVal NewValue As Long)
    U_RoundV = NewValue
    PropertyChanged “RoundedValue”
    Bar_Draw
    End Property

    Public Property Get Enabled() As Boolean
    Enabled = U_Enabled
    End Property

    Public Property Let Enabled(ByVal NewValue As Boolean)
    U_Enabled = NewValue
    PropertyChanged “Enabled”
    Bar_Draw
    End Property
    Private Sub UserControl_InitProperties()
    Max = 100
    Min = 0
    Value = 50
    RoundedValue = 5
    Enabled = True
    Theme = 1
    TextForeColor = vbBlack
    Text = “U11D ProgressBar”
    TextAlignment = [Center Middle]
    TextEffect = Shadow
    TextEffectColor = vbWhite
    TextStyle = CustomText
    Orientations = Horizontal
    Set TextFont = Ambient.Font
    End Sub
    Public Property Let Theme(ByVal NewValue As U_Themes)

    U_Theme = NewValue
    PropertyChanged "Theme"
    

    Bar_Draw
    End Property

    Public Property Get Theme() As U_Themes
    Theme = U_Theme
    End Property

    Public Property Let TextStyle(ByVal NewValue As U_TextStyles)
    U_TextStyle = NewValue
    PropertyChanged “TextStyle”
    Bar_Draw
    End Property
    Public Property Get TextStyle() As U_TextStyles
    TextStyle = U_TextStyle
    End Property

    Public Property Get Orientations() As U_OrientationsS
    Orientations = U_Orientation
    End Property

    Public Property Let Orientations(ByVal NewValue As U_OrientationsS)
    U_Orientation = NewValue
    PropertyChanged “Orientations”
    Bar_Draw
    End Property

    Public Property Get TextAlignment() As U_TextAlignments
    TextAlignment = U_TextAlign
    End Property

    Public Property Let TextAlignment(ByVal NewValue As U_TextAlignments)
    U_TextAlign = NewValue
    PropertyChanged “TextAlignment”
    Bar_Draw
    End Property

    Public Property Get Text() As String
    Text = U_Text
    End Property

    Public Property Let Text(ByVal NewValue As String)
    U_Text = NewValue
    PropertyChanged “Text”
    Bar_Draw
    End Property
    Public Property Get TextEffectColor() As OLE_COLOR
    TextEffectColor = U_TextEC
    End Property

    Public Property Let TextEffectColor(ByVal NewValue As OLE_COLOR)
    U_TextEC = NewValue
    PropertyChanged “TextEffectColor”
    Bar_Draw
    End Property

    Public Property Get TextEffect() As U_TextEffects
    TextEffect = U_TextEffect
    End Property

    Public Property Let TextEffect(ByVal NewValue As U_TextEffects)
    U_TextEffect = NewValue
    PropertyChanged “TextEffect”
    Bar_Draw
    End Property

    Public Property Get TextForeColor() As OLE_COLOR
    TextForeColor = U_TextColor
    End Property

    Public Property Let TextForeColor(ByVal NewValue As OLE_COLOR)
    U_TextColor = NewValue
    PropertyChanged “TextForeColor”
    Bar_Draw
    End Property
    Public Property Get TextFont() As Font
    Set TextFont = U_TextFont
    End Property

    Public Property Set TextFont(ByVal NewValue As Font)
    Set U_TextFont = NewValue
    Set UserControl.Font = NewValue
    PropertyChanged “TextFont”
    Bar_Draw
    End Property

    Public Property Get PBSCustomeColor1() As OLE_COLOR
    PBSCustomeColor1 = U_PBSCC1
    End Property

    Public Property Let PBSCustomeColor1(ByVal NewValue As OLE_COLOR)
    U_PBSCC1 = NewValue
    PropertyChanged “PBSCustomeColor1”
    Bar_Draw
    End Property
    Public Property Get PBSCustomeColor2() As OLE_COLOR
    PBSCustomeColor2 = U_PBSCC2
    End Property

    Public Property Let PBSCustomeColor2(ByVal NewValue As OLE_COLOR)
    U_PBSCC2 = NewValue
    PropertyChanged “PBSCustomeColor2”
    Bar_Draw
    End Property
    Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    On Error Resume Next
    With PropBag

    Max = .ReadProperty("Max", 100)
    Min = .ReadProperty("Min", 0)
    Value = .ReadProperty("Value", 50)
    RoundedValue = .ReadProperty("RoundedValue", 5)
    Enabled = .ReadProperty("Enabled", True)
    Theme = .ReadProperty("Theme", 1)
    TextStyle = .ReadProperty("TextStyle", 1)
    Orientations = .ReadProperty("Orientations", Horizontal)
    Text = .ReadProperty("Text", Ambient.DisplayName)
    TextEffectColor = .ReadProperty("TextEffectColor", RGB(200, 200, 200))
    TextEffect = .ReadProperty("TextEffect", 1)
    TextAlignment = .ReadProperty("TextAlignment", 5)
    Set TextFont = .ReadProperty("TextFont", Ambient.Font)
    TextForeColor = .ReadProperty("TextForeColor", 0)
    PBSCustomeColor2 = .ReadProperty("PBSCustomeColor2", vbBlack)
    PBSCustomeColor1 = .ReadProperty("PBSCustomeColor1", vbBlack)
    End With
    

    End Sub

    Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
    .WriteProperty “Orientations”, U_Orientation, Horizontal
    .WriteProperty “Max”, U_Max, 100
    .WriteProperty “Min”, U_Min, 0
    .WriteProperty “Value”, U_Value, 50
    .WriteProperty “RoundedValue”, U_RoundV, 5
    .WriteProperty “Enabled”, U_Enabled, True
    .WriteProperty “Theme”, U_Theme, 1
    .WriteProperty “TextStyle”, U_TextStyle, 1
    .WriteProperty “TextFont”, U_TextFont, Ambient.Font
    .WriteProperty “TextForeColor”, U_TextColor, vbBlack
    .WriteProperty “TextAlignment”, U_TextAlign, 5
    .WriteProperty “Text”, U_Text, “”
    .WriteProperty “TextEffectColor”, U_TextEC, RGB(200, 200, 200)
    .WriteProperty “TextEffect”, U_TextEffect, 1
    .WriteProperty “PBSCustomeColor2”, U_PBSCC2, vbBlack
    .WriteProperty “PBSCustomeColor1”, U_PBSCC1, vbBlack
    End With
    End Sub

    Private Sub Bar_Draw()
    On Error Resume Next
    Dim i, S, z, y, q As Long
    Dim U_LRECT As Long

    U_LRECT = CreateRoundRectRgn(0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, U_RoundV, U_RoundV)
    SetWindowRgn UserControl.hwnd, U_LRECT, True

    i = U_Max: S = U_Value: z = U_Max
    y = (S * 100 / z)
    q = (y * UserControl.ScaleWidth / 100)
    

    If Orientations = Vertical Then q = (y * UserControl.ScaleHeight / 100)

    CheckTheme

    If Enabled = False Then
    Dim II As Byte
    For II = 0 To 16
    c(II) = ColourTOGray(c(II))
    Next II
    End If

    UserControl.Cls

    If U_Orientation = Horizontal Then

    GradientTwoColour UserControl.hDC, [Top to Bottom], c(0), c(2), 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight / 2
    GradientTwoColour UserControl.hDC, [Top to Bottom], c(4), c(6), 0, UserControl.ScaleHeight / 2, UserControl.ScaleWidth, UserControl.ScaleHeight

    'DrawGradientFourColour UserControl.hDC, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight / 2, c(0), c(1), c(2), c(3)
    'DrawGradientFourColour UserControl.hDC, 0, UserControl.ScaleHeight / 2, UserControl.ScaleWidth, UserControl.ScaleHeight / 2 - 1, c(4), c(5), c(6), c(7)

    If Value >= 1 Then

    GradientTwoColour UserControl.hDC, [Top to Bottom], c(8), c(10), 0, 0, q, UserControl.ScaleHeight / 2
    GradientTwoColour UserControl.hDC, [Top to Bottom], c(12), c(14), 0, UserControl.ScaleHeight / 2, q, UserControl.ScaleHeight
    'DrawGradientFourColour UserControl.hDC, 0, 0, q, UserControl.ScaleHeight / 2, c(8), c(9), c(10), c(11)
    'DrawGradientFourColour UserControl.hDC, 0, UserControl.ScaleHeight / 2, q, UserControl.ScaleHeight / 2 - 1, c(12), c(13), c(14), c(15)
    End If

    ElseIf U_Orientation = Vertical Then

    GradientTwoColour UserControl.hDC, [Left to Right], c(0), c(2), 0, 0, UserControl.ScaleWidth / 2, UserControl.ScaleHeight
    GradientTwoColour UserControl.hDC, [Left to Right], c(4), c(6), UserControl.ScaleWidth / 2, 0, UserControl.ScaleWidth, UserControl.ScaleHeight

    'DrawGradientFourColour UserControl.hDC, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight / 2, c(0), c(1), c(2), c(3)
    'DrawGradientFourColour UserControl.hDC, 0, UserControl.ScaleHeight / 2, UserControl.ScaleWidth, UserControl.ScaleHeight / 2 - 1, c(4), c(5), c(6), c(7)

    If Value >= 1 Then

    GradientTwoColour UserControl.hDC, [Left to Right], c(8), c(10), 0, 0, UserControl.ScaleWidth / 2, q
    GradientTwoColour UserControl.hDC, [Left to Right], c(12), c(14), UserControl.ScaleWidth / 2, 0, UserControl.ScaleWidth, q
    'DrawGradientFourColour UserControl.hDC, 0, 0, q, UserControl.ScaleHeight / 2, c(8), c(9), c(10), c(11)
    'DrawGradientFourColour UserControl.hDC, 0, UserControl.ScaleHeight / 2, q, UserControl.ScaleHeight / 2 - 1, c(12), c(13), c(14), c(15)
    End If
    End If

    UserControl.ForeColor = c(16)
    RoundRect UserControl.hDC, 0, 0, UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1, U_RoundV, U_RoundV

    If TextStyle = PBValue Then
    DrawCaptionText Value, U_TextAlign
    ElseIf TextStyle = PBPercentage Then
    DrawCaptionText y & “%”, U_TextAlign
    ElseIf TextStyle = CustomText Then
    DrawCaptionText U_Text, U_TextAlign
    ElseIf TextStyle = PBNoneText Then
    End If
    End Sub

    Private Sub CheckTheme()
    If Theme = 1 Then
    'BACK
    c(0) = RGB(248, 246, 242)
    c(1) = RGB(248, 246, 242)
    c(2) = RGB(233, 227, 211)
    c(3) = RGB(233, 227, 211)

    c(4) = RGB(226, 215, 182)
    c(5) = RGB(226, 215, 182)
    c(6) = RGB(239, 233, 215)
    c(7) = RGB(239, 233, 215)
    'FRONT
    c(8) = RGB(251, 244, 223)
    c(9) = RGB(251, 244, 223)
    c(10) = RGB(239, 213, 133)
    c(11) = RGB(239, 213, 133)

    c(12) = RGB(203, 166, 57)
    c(13) = RGB(203, 166, 57)
    c(14) = RGB(237, 224, 187)
    c(15) = RGB(237, 224, 187)
    'FORE COLOUR
    c(16) = RGB(204, 168, 62)
    ElseIf Theme = 2 Then
    'BACK
    c(0) = RGB(247, 248, 242)
    c(1) = RGB(247, 248, 242)
    c(2) = RGB(231, 233, 211)
    c(3) = RGB(231, 233, 211)

    c(4) = RGB(222, 226, 182)
    c(5) = RGB(222, 226, 182)
    c(6) = RGB(237, 239, 215)
    c(7) = RGB(237, 239, 215)
    'FRONT
    c(8) = RGB(249, 251, 223)
    c(9) = RGB(249, 251, 223)
    c(10) = RGB(230, 239, 133)
    c(11) = RGB(230, 239, 133)

    c(12) = RGB(190, 203, 57)
    c(13) = RGB(190, 203, 57)
    c(14) = RGB(233, 237, 187)
    c(15) = RGB(233, 237, 187)
    'FORE COLOUR
    c(16) = RGB(192, 204, 62)
    ElseIf Theme = 3 Then
    'BACK
    c(0) = RGB(242, 248, 243)
    c(1) = RGB(242, 248, 243)
    c(2) = RGB(211, 233, 213)
    c(3) = RGB(211, 233, 213)

    c(4) = RGB(182, 226, 186)
    c(5) = RGB(182, 226, 186)
    c(6) = RGB(215, 239, 217)
    c(7) = RGB(215, 239, 217)
    'FRONT
    c(8) = RGB(223, 251, 225)
    c(9) = RGB(223, 251, 225)
    c(10) = RGB(133, 239, 142)
    c(11) = RGB(133, 239, 142)

    c(12) = RGB(57, 203, 70)
    c(13) = RGB(57, 203, 70)
    c(14) = RGB(187, 237, 191)
    c(15) = RGB(187, 237, 191)
    'FORE COLOUR
    c(16) = RGB(62, 204, 74)
    ElseIf Theme = 4 Then
    'BACK
    c(0) = RGB(242, 248, 247)
    c(1) = RGB(242, 248, 247)
    c(2) = RGB(211, 233, 231)
    c(3) = RGB(211, 233, 231)

    c(4) = RGB(182, 226, 222)
    c(5) = RGB(182, 226, 222)
    c(6) = RGB(215, 239, 237)
    c(7) = RGB(215, 239, 237)
    'FRONT
    c(8) = RGB(223, 251, 249)
    c(9) = RGB(223, 251, 249)
    c(10) = RGB(133, 239, 230)
    c(11) = RGB(133, 239, 230)

    c(12) = RGB(57, 203, 190)
    c(13) = RGB(57, 203, 190)
    c(14) = RGB(187, 237, 233)
    c(15) = RGB(187, 237, 233)
    'FORE COLOUR
    c(16) = RGB(62, 204, 192)
    ElseIf Theme = 5 Then
    'BACK
    c(0) = RGB(243, 242, 248)
    c(1) = RGB(243, 242, 248)
    c(2) = RGB(213, 211, 233)
    c(3) = RGB(213, 211, 233)

    c(4) = RGB(186, 182, 226)
    c(5) = RGB(186, 182, 226)
    c(6) = RGB(217, 215, 239)
    c(7) = RGB(217, 215, 239)
    'FRONT
    c(8) = RGB(225, 223, 251)
    c(9) = RGB(225, 223, 251)
    c(10) = RGB(142, 133, 239)
    c(11) = RGB(142, 133, 239)

    c(12) = RGB(70, 57, 203)
    c(13) = RGB(70, 57, 203)
    c(14) = RGB(191, 187, 237)
    c(15) = RGB(191, 187, 237)
    'FORE COLOUR
    c(16) = RGB(74, 62, 204)
    ElseIf Theme = 6 Then
    'BACK
    c(0) = RGB(248, 242, 247)
    c(1) = RGB(248, 242, 247)
    c(2) = RGB(233, 211, 231)
    c(3) = RGB(233, 211, 231)

    c(4) = RGB(226, 182, 222)
    c(5) = RGB(226, 182, 222)
    c(6) = RGB(239, 215, 237)
    c(7) = RGB(239, 215, 237)
    'FRONT
    c(8) = RGB(251, 223, 249)
    c(9) = RGB(251, 223, 249)
    c(10) = RGB(239, 133, 230)
    c(11) = RGB(239, 133, 230)

    c(12) = RGB(203, 57, 190)
    c(13) = RGB(203, 57, 190)
    c(14) = RGB(237, 187, 233)
    c(15) = RGB(237, 187, 233)
    'FORE COLOUR
    c(16) = RGB(204, 62, 192)
    ElseIf Theme = 7 Then
    'BACK
    c(0) = RGB(248, 242, 242)
    c(1) = RGB(248, 242, 242)
    c(2) = RGB(233, 211, 211)
    c(3) = RGB(233, 211, 211)

    c(4) = RGB(226, 182, 182)
    c(5) = RGB(226, 182, 182)
    c(6) = RGB(239, 215, 215)
    c(7) = RGB(239, 215, 215)
    'FRONT
    c(8) = RGB(251, 223, 223)
    c(9) = RGB(251, 223, 223)
    c(10) = RGB(239, 133, 133)
    c(11) = RGB(239, 133, 133)

    c(12) = RGB(203, 57, 57)
    c(13) = RGB(203, 57, 57)
    c(14) = RGB(237, 187, 187)
    c(15) = RGB(237, 187, 187)
    'FORE COLOUR
    c(16) = RGB(204, 62, 62)
    ElseIf Theme = 8 Then
    'BACK
    c(0) = RGB(250, 253, 254)
    c(1) = RGB(250, 253, 254)
    c(2) = RGB(228, 243, 252)
    c(3) = RGB(228, 243, 252)

    c(4) = RGB(199, 230, 249)
    c(5) = RGB(199, 230, 249)
    c(6) = RGB(237, 247, 253)
    c(7) = RGB(237, 247, 253)
    'FRONT
    c(8) = RGB(225, 247, 255)
    c(9) = RGB(225, 247, 255)
    c(10) = RGB(67, 208, 255)
    c(11) = RGB(67, 208, 255)

    c(12) = RGB(63, 112, 233)
    c(13) = RGB(63, 112, 233)
    c(14) = RGB(63, 226, 246)
    c(15) = RGB(63, 226, 246)
    'FORE COLOUR
    c(16) = RGB(23, 139, 211)
    ElseIf Theme = 9 Then
    'BACK
    c(0) = RGB(231, 243, 232)
    c(1) = RGB(231, 243, 232)
    c(2) = RGB(225, 219, 225)
    c(3) = RGB(225, 219, 225)

    c(4) = RGB(179, 189, 179)
    c(5) = RGB(179, 189, 179)
    c(6) = RGB(226, 238, 226)
    c(7) = RGB(226, 238, 226)
    'FRONT
    c(8) = RGB(223, 251, 223)
    c(9) = RGB(223, 251, 223)
    c(10) = RGB(108, 255, 108)
    c(11) = RGB(108, 255, 108)

    c(12) = RGB(26, 228, 26)
    c(13) = RGB(26, 228, 26)
    c(14) = RGB(217, 244, 217)
    c(15) = RGB(217, 244, 217)
    'FORE COLOUR
    c(16) = RGB(188, 184, 188)
    ElseIf Theme = 10 Then

    'BACK
    c(0) = LightenColor(U_PBSCC2, 180)
    c(1) = LightenColor(U_PBSCC2, 180)
    c(2) = LightenColor(U_PBSCC2, 50)
    c(3) = LightenColor(U_PBSCC2, 50)

    c(4) = U_PBSCC2
    c(5) = U_PBSCC2
    c(6) = LightenColor(U_PBSCC2, 80)
    c(7) = LightenColor(U_PBSCC2, 80)
    'FRONT
    c(8) = LightenColor(U_PBSCC1, 180)
    c(9) = LightenColor(U_PBSCC1, 180)
    c(10) = LightenColor(U_PBSCC1, 50)
    c(11) = LightenColor(U_PBSCC1, 50)

    c(12) = U_PBSCC1
    c(13) = U_PBSCC1
    c(14) = LightenColor(U_PBSCC1, 80)
    c(15) = LightenColor(U_PBSCC1, 80)
    'FORE COLOUR
    c(16) = U_PBSCC1
    End If
    End Sub

    Private Sub DrawCaptionText(ByVal TextString As String, ByVal Alignment As U_TextAlignments)
    Dim lonStartWidth As Long, lonStartHeight As Long
    Dim PBTCN, PBTCS As Long

    If Enabled = True Then
    PBTCN = U_TextColor
    PBTCS = U_TextEC
    Else
    PBTCN = ColourTOGray(U_TextColor)
    PBTCS = ColourTOGray(U_TextEC)
    End If

    UserControl.ForeColor = PBTCN

    If Alignment = 1 Then
    lonStartWidth = 1
    lonStartHeight = 0
    ElseIf Alignment = 2 Then
    lonStartWidth = 1
    lonStartHeight = (UserControl.ScaleHeight / 2) - (UserControl.TextHeight(TextString) / 2) - 1
    ElseIf Alignment = 3 Then
    lonStartWidth = 1
    lonStartHeight = (UserControl.ScaleHeight - UserControl.TextHeight(TextString)) - 1

    ElseIf Alignment = 4 Then
    lonStartWidth = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(TextString) / 2) - 1
    lonStartHeight = 0
    ElseIf Alignment = 5 Then
    lonStartWidth = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(TextString) / 2) - 1
    lonStartHeight = (UserControl.ScaleHeight / 2) - (UserControl.TextHeight(TextString) / 2) - 1
    ElseIf Alignment = 6 Then
    lonStartWidth = (UserControl.ScaleWidth / 2) - (UserControl.TextWidth(TextString) / 2) - 1
    lonStartHeight = (UserControl.ScaleHeight - UserControl.TextHeight(TextString)) - 1

    ElseIf Alignment = 7 Then
    lonStartWidth = (UserControl.ScaleWidth - UserControl.TextWidth(TextString)) - 3
    lonStartHeight = 0
    ElseIf Alignment = 8 Then
    lonStartWidth = (UserControl.ScaleWidth - UserControl.TextWidth(TextString)) - 3
    lonStartHeight = (UserControl.ScaleHeight / 2) - (UserControl.TextHeight(TextString) / 2) - 1
    ElseIf Alignment = 9 Then
    lonStartWidth = (UserControl.ScaleWidth - UserControl.TextWidth(TextString)) - 3
    lonStartHeight = (UserControl.ScaleHeight - UserControl.TextHeight(TextString)) - 1
    End If

    If U_TextEffect = Normal Then
        UserControl.CurrentX = lonStartWidth
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
    ElseIf U_TextEffect = Engraved Then
        UserControl.ForeColor = PBTCS
        UserControl.CurrentX = lonStartWidth + 1
        UserControl.CurrentY = lonStartHeight + 1
        UserControl.Print TextString
        UserControl.ForeColor = RGB(128, 128, 128)
        UserControl.CurrentX = lonStartWidth - 1
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
        UserControl.ForeColor = PBTCN
        UserControl.CurrentX = lonStartWidth
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
        
    ElseIf U_TextEffect = Embossed Then
        UserControl.ForeColor = PBTCS
        UserControl.CurrentX = lonStartWidth - 1
        UserControl.CurrentY = lonStartHeight - 1
        UserControl.Print TextString
        UserControl.ForeColor = RGB(128, 128, 128)
        UserControl.CurrentX = lonStartWidth + 1
        UserControl.CurrentY = lonStartHeight + 1
        UserControl.Print TextString
        UserControl.ForeColor = PBTCN
        UserControl.CurrentX = lonStartWidth
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
    ElseIf U_TextEffect = OutLine Then
        UserControl.ForeColor = PBTCS
        UserControl.CurrentX = lonStartWidth + 1
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
        UserControl.CurrentX = lonStartWidth - 1
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
        UserControl.CurrentY = lonStartHeight - 1
        UserControl.CurrentX = lonStartWidth
        UserControl.Print TextString
        UserControl.CurrentY = lonStartHeight + 1
        UserControl.CurrentX = lonStartWidth
        UserControl.Print TextString
        UserControl.ForeColor = PBTCN
        UserControl.CurrentX = lonStartWidth
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
        
    ElseIf U_TextEffect = Shadow Then
        UserControl.ForeColor = PBTCS
        UserControl.CurrentX = lonStartWidth + 1
        UserControl.CurrentY = lonStartHeight + 1
        UserControl.Print TextString
        UserControl.ForeColor = PBTCN
        UserControl.CurrentX = lonStartWidth
        UserControl.CurrentY = lonStartHeight
        UserControl.Print TextString
    End If
    

    End Sub

    Public Function DrawGradientFourColour(ObjectHDC As Long, Left As Long, Top As Long, Width As Long, Height As Long, TopLeftColour As Long, TopRightColour As Long, BottomLeftColour As Long, BottomRightColour As Long)
    Dim bi24BitInfo As BITMAPINFO
    Dim bBytes() As Byte
    Dim LeftGrads() As cRGB
    Dim RightGrads() As cRGB
    Dim MiddleGrads() As cRGB
    Dim TopLeft As cRGB
    Dim TopRight As cRGB
    Dim BottomLeft As cRGB
    Dim BottomRight As cRGB
    Dim iLoop As Long
    Dim bytesWidth As Long

    With TopLeft
        .Red = Red(TopLeftColour)
        .Green = Green(TopLeftColour)
        .Blue = Blue(TopLeftColour)
    End With
    
    With TopRight
        .Red = Red(TopRightColour)
        .Green = Green(TopRightColour)
        .Blue = Blue(TopRightColour)
    End With
    
    With BottomLeft
        .Red = Red(BottomLeftColour)
        .Green = Green(BottomLeftColour)
        .Blue = Blue(BottomLeftColour)
    End With
    
    With BottomRight
        .Red = Red(BottomRightColour)
        .Green = Green(BottomRightColour)
        .Blue = Blue(BottomRightColour)
    End With
    
    GradateColours LeftGrads, Height, TopLeft, BottomLeft
    GradateColours RightGrads, Height, TopRight, BottomRight
    
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = Width
        .biHeight = 1
    End With
    
    ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
    
    bytesWidth = (Width) * 3
    
    For iLoop = 0 To Height - 1
        GradateColours MiddleGrads, Width, LeftGrads(iLoop), RightGrads(iLoop)
        CopyMemory bBytes(1), MiddleGrads(0), bytesWidth
        SetDIBitsToDevice ObjectHDC, Left, Top + iLoop, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    Next iLoop
    

    End Function

    Private Function GradateColours(cResults() As cRGB, Length As Long, Colour1 As cRGB, Colour2 As cRGB)
    Dim fromR As Integer
    Dim toR As Integer
    Dim fromG As Integer
    Dim toG As Integer
    Dim fromB As Integer
    Dim toB As Integer
    Dim stepR As Single
    Dim stepG As Single
    Dim stepB As Single
    Dim iLoop As Long

    ReDim cResults(0 To Length)
    
    fromR = Colour1.Red
    fromG = Colour1.Green
    fromB = Colour1.Blue
    
    toR = Colour2.Red
    toG = Colour2.Green
    toB = Colour2.Blue
    
    stepR = Divide(toR - fromR, Length)
    stepG = Divide(toG - fromG, Length)
    stepB = Divide(toB - fromB, Length)
    
    For iLoop = 0 To Length
        cResults(iLoop).Red = fromR + (stepR * iLoop)
        cResults(iLoop).Green = fromG + (stepG * iLoop)
        cResults(iLoop).Blue = fromB + (stepB * iLoop)
    Next iLoop
    

    End Function

    Private Function Blue(Colour As Long) As Long
    Blue = (Colour And &HFF0000) / &H10000
    End Function
    Private Function Green(Colour As Long) As Long
    Green = (Colour And &HFF00&) / &H100
    End Function

    Private Function Red(Colour As Long) As Long
    Red = (Colour And &HFF&)
    End Function

    Private Function Divide(Numerator, Denominator) As Single
    If Numerator = 0 Or Denominator = 0 Then
    Divide = 0
    Else
    Divide = Numerator / Denominator
    End If
    End Function
    Public Sub GradientTwoColour(ByVal hDC As Long, ByVal Direction As GRADIENT_DIRECT, ByVal StartColor As Long, ByVal EndColor As Long, Left As Long, Top As Long, Width As Long, Height As Long)
    Dim udtVert(1) As TRIVERTEX, udtGRect As GRADIENT_RECT
    Dim UDTRECT As RECT
    'hDCObj.ScaleMode = vbPixels
    'hDCObj.AutoRedraw = True
    SetRect UDTRECT, Left, Top, Width, Height
    With udtVert(0)
    .x = UDTRECT.Left
    .y = UDTRECT.Top
    .Red = LongToSignedShort(CLng((StartColor And &HFF&) * 256))
    .Green = LongToSignedShort(CLng(((StartColor And &HFF00&) \ &H100&) * 256))
    .Blue = LongToSignedShort(CLng(((StartColor And &HFF0000) \ &H10000) * 256))
    .Alpha = 0&
    End With
    With udtVert(1)
    .x = UDTRECT.Right
    .y = UDTRECT.Bottom
    .Red = LongToSignedShort(CLng((EndColor And &HFF&) * 256))
    .Green = LongToSignedShort(CLng(((EndColor And &HFF00&) \ &H100&) * 256))
    .Blue = LongToSignedShort(CLng(((EndColor And &HFF0000) \ &H10000) * 256))
    .Alpha = 0&
    End With
    udtGRect.UpperLeft = 0
    udtGRect.LowerRight = 1
    GradientFillRect hDC, udtVert(0), 2, udtGRect, 1, Direction
    End Sub
    Private Function LongToSignedShort(ByVal Unsigned As Long) As Integer
    If Unsigned < 32768 Then
    LongToSignedShort = CInt(Unsigned)
    Else
    LongToSignedShort = CInt(Unsigned - &H10000)
    End If
    End Function
    Private Function ColourTOGray(ByVal uColor As Long) As Long
    Dim Red As Long, Blue As Long, Green As Long
    Dim gray As Long
    Red = uColor Mod 256
    Green = (uColor Mod 65536) / 256
    Blue = uColor / 65536
    gray = (Red + Green + Blue) / 3
    ColourTOGray = RGB(gray, gray, gray)
    End Function
    Private Function LightenColor(ByVal uColour As ColorConstants, Optional ByVal OffSet As Long = 1) As Long
    Dim intR As Integer, intG As Integer, intB As Integer
    intR = Abs((uColour Mod 256) + OffSet)
    intG = Abs((((uColour And &HFF00) / 256&) Mod 256&) + OffSet)
    intB = Abs(((uColour And &HFF0000) / 65536) + OffSet)
    LightenColor = RGB(intR, intG, intB)
    End Function
    '-------------------------------------------------------------------------------------------------------
    二、Form测试,代码如下:
    Option Explicit
    Dim i As Integer, B As Boolean

    Private Sub Command1_Click()
    ProgressBar1.Value = 0
    B = True
    Do
    DoEvents
    ProgressBar1.Value = i
    i = i + 1
    If i >= 10000 Or B = False Then Exit Do
    Loop
    End Sub

    Private Sub Form_Load()
    ProgressBar1.Max = 10000
    ProgressBar1.Min = 0
    ProgressBar1.Value = 0
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    B = False
    End Sub

    展开全文
  • 摘要:VB源码,图形处理,图像缩放,仿Photoshop VB功能超多的图像处理控件程序演示,控件名为ExtendPictureBox.ocx,仿Photoshop滤镜的众多功能,可以实现DrawRegularPolygon、 DrawStar、DrawDiamond等图形方法,支持...
  • Me.ScaleMode = 3 Me.Caption = "曲柄滑块机构的演示" Me.Width = 5000 Me.Height = 3500 Picture1.ScaleMode = 3 Picture1.AutoRedraw = True Picture1.Move 0, 0, Me.ScaleWidth, 150 Command1.Caption = ...
  •  .ScaleMode=3  .BorderStyle=0  DibGet .hdc,0,0,.scalewidth,.scaleheight End With CopyData InPutHei ,InPutWid picture2.AutoRedraw=True DibPut picture2.hdc picture2.refresh end sub
  • 1、VB6.0对口升学考点分析与总结第一章 VB使用基础1、VB的特点2、VB的启动与退出3、VB的窗口组成4、VB的属性窗口中、代码窗口的打开操作方法5、VB程序的保存及各种文件的扩展名6、VB程序的运行方法7、对象、属性、...
  • [原创]河南省对口升学计算机专业VB教材分析(2011-03-21 20:53:48)标签:河南省计算机杂谈VB教材知识点分析第一章 VB使用基础1、VB的特点2、VB的启动与退出3、VB的窗口组成4、VB的属性窗口中、代码窗口的打开操纵方法...
  • VB自绘滚动条控件(COX)

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

    2012-11-16 11:03:18
    一款好用的VB曲线,各种模型均已内置,Declare Function BitBlt Lib "GDI32" (ByVal hDestDC AS Long,ByVal X As Long,ByVal Y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal hSrcDC As Long,ByVal ...
  • vb添加GIF动态图片

    万次阅读 热门讨论 2012-04-28 16:52:18
    众说周知,GIF格式动画文件具有小巧、制作方便等特点,因此在网上得到广泛应用,在vb的picturebox和image控件添加图片后变成静止的了,这给我们设计VB应用程序带来了不便。原来以为实现起来特别的麻烦,又要注册控件...
  • VB控件属性使用大全

    2011-12-15 12:02:34
    ScaleMode 获得或设置一个值,指示当使用graphics方法或可定位的控件时,自定义坐标系的单位, 有8种可选: 0 自定义 1 表示单位为twip(缇),每英寸=1440缇,每厘米=567缇 2 表示单位为point(磅) ,每英寸=72磅,每磅=...
  • 该楼层疑似违规已被系统折叠隐藏此楼查看此楼‘VB6的写法Option ExplicitConst PI = 3.1415926Const Num = 36Const Num1 = Num + 1Private Sub Form_Activate()Dim M%, i%, flag%Dim L1!, L2!, L3!, L4!, w1!Dim w2#...
  • lBF As Long Const AC_SRC_OVER = &H0 Set Frm = Fm Set Panel = Fm.Controls.Add(“vb.PictureBox”, “Panel”) Panel.AutoRedraw = True Panel.AutoSize = True Panel.Picture = Pic Panel.ScaleMode = ...
  • vb常用代码大全

    2021-06-30 05:00:36
    i As Integer Dim x As Integer Dim WhDC As Long ' This object can be any VB standard obje ct with an hWnd property WhDC = GetDC(WindowObject.hwnd) For j = 0 To WindowObject.Height Step p. ScaleHeight ...
  • VB控件背景透明代码来自:新浪 “玄雨清风”的博客 感谢以上两位源代码作者 链接:http://pan.baidu.com/s/1hrAEXqG 密码:nfhc '-----------------------以下是转自博客的控件透明源代码(可透明至父窗体或...
  • VB二维码生成与解码的源代码工程和应用软件,特别支持中文的二维码编码译码 代码片 下面展示一些 内联代码片。 ////////////////////////////////////////////////////// Private Sub Command2_Click() Dim byt() As...
  • VERSION 5.00 Begin VB.Form GameMainFrm AutoRedraw = -1 'True BackColor = &H00FFFFFF& BorderStyle = 0 'None ClientHeight = 3075 ClientLeft = 1...
  • 1 Const WINDING = 2 Dim Graph As Long Dim Ecolor As Long Private Sub Form_Load() Me.AutoRedraw = True Me.ScaleMode = 3 '绘画一个四边形 Dim E(3) As POINTAPI '第一个点 E(0).X = 12 E(0).Y = 12 '第二个点 ...
  • VB使用API的简明教程

    2021-03-29 15:23:30
    让我们想想,VB里的CommandButton控件让我们可以做什么?按下、弹起,还有呢?请看看图3,这样的情况在你的程序运行时出现过吗?  Windows是以消息来传递信息的。当出现某个操作,比如按钮被按下,就产生按钮被...
  • Printer.ScaleMode = 6 Printer.FontBold = False Printer.ScaleLeft = -20 Printer.ScaleTop = -25 Printer.ScaleWidth = 210 Printer.ScaleHeight = 297 usewidth = Printer.ScaleWidth - 40 ...
  • ScaleMode = 3 xpos = Me .ScaleWidth / 2 ypos = Me .ScaleHeight / 2 If xpos > ypos Then lim = ypos Else lim = xpos End If For rad = 0 To lim Randomize r = 255 * Rnd...
  • vb 镜像处理 Dim c As Long, x As Integer, y As Integer Private Sub command1_Click() Picture2.Cls For i = 0 To Picture1.ScaleWidth - 1 For j = 0 To Picture1.ScaleHeight - 1 c = Picture1.Point(i, j) x = ...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 616
精华内容 246
关键字:

scalemodevb