|
-
Oct 22nd, 2000, 06:31 PM
#4
I know it's a lot of code, but only the extfloodfillpart is where the problem is... Put this code in a class, and try for yourself: (Code for a form is below the classcode...)
Also note that the coordinates (20,20) are just for test purposes, I've tried lots of other possibilities...(Oh, and the comments are in Dutch...sorry fot that)
Code:
Option Explicit
' Api Constanten/Functies
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
Private Const FLOODFILLBORDER = 0
Private Const FLOODFILLSURFACE = 1
Private br3D_Top As Long
Private br3D_Left As Long
Private br3D_Width As Long
Private br3D_Height As Long
Private br3D_Angle As Byte
Private br3D_EmptyDarkColor As Long
Private br3D_EmptyLightColor As Long
Private br3D_FillDarkColor As Long
Private br3D_FillLightColor As Long
Private br3D_FillTopColor As Long
Private br3D_FillBottomColor As Long
Private br3D_LineColor As Long
Private br3D_TextColor As Long
Private br3D_Min As Long
Private br3D_Max As Long
Private br3D_ShowText As Boolean
Private br3D_Value As Long
Private br3D_OwnFrm As Form
Private OwnerSet As Boolean
' Default Kleuren
Private Const Def_EmptyDarkColor = 14706792
Private Const Def_EmptyLightColor = 16744576
Private Const Def_FillDarkColor = 8535190
Private Const Def_FillLightColor = 9192128
Private Const Def_FillTopColor = 10510496
Private Const Def_FillBottomColor = 8011916
Private Const Def_LineColor = 16769248
Private Const Def_TextColor = 8388700
' Default Uiterlijk en Gedrag
Private Const Def_Angle = 5
Private Const Def_Min = 0
Private Const Def_Max = 100
Private Const Def_ShowText = True
Private Const Def_MinHeight = 500
Private Const Def_MinWidth = 250
Private Sub DrawBar(Percentage As Byte)
Dim br3DOffset As Long
Dim br3DMid As Long
Dim br3DBarPos As Long
Dim TPPX As Long
Dim TPPY As Long
' "Backup" variabelen
Dim tmpFontBold As Boolean
Dim tmpForeColor As Long
Dim tmpAutoRedraw As Boolean
Dim tmpScalemode As Integer
' Ongeldige waardes afvangen...
If Percentage > 100 Then Exit Sub ' Kleiner als 0 kan niet, want type is byte.
With br3D_OwnFrm
' Oude waarde opslaan, dan autoredraw op True zetten
tmpAutoRedraw = .AutoRedraw
.AutoRedraw = True
' Stuk schoonmaken waar we gaan tekenen
br3D_OwnFrm.Line (br3D_Left, br3D_Top)-(br3D_Left + br3D_Width, br3D_Top + br3D_Height), .BackColor, BF
' Algemene berekeningen
br3DOffset = br3D_Width / br3D_Angle
br3DMid = (br3D_Width / 2) + br3D_Left
br3DBarPos = ((br3D_Height + br3D_Top) - br3DOffset) - ((((br3D_Top + (br3D_Height - br3DOffset)) - (br3D_Top + br3DOffset)) / 100) * Percentage)
TPPX = Screen.TwipsPerPixelX
TPPY = Screen.TwipsPerPixelY
' 2 Buitenste Lijnen (Links, Rechts)
br3D_OwnFrm.Line (br3D_Left, br3D_Top + br3DOffset)-(br3D_Left, br3D_Top + (br3D_Height - br3DOffset)), br3D_LineColor
br3D_OwnFrm.Line (br3D_Left + br3D_Width, br3D_Top + br3DOffset)-(br3D_Left + br3D_Width, br3D_Top + (br3D_Height - br3DOffset)), br3D_LineColor
' Middelste Lijn
br3D_OwnFrm.Line (br3DMid, br3D_Top + (br3DOffset * 2))-(br3DMid, br3D_Top + br3D_Height), br3D_LineColor
' Bovenste Vierkant (LinksOnder,RechtsOnder,LinksBoven,RechtsBoven)
br3D_OwnFrm.Line (br3D_Left, br3D_Top + br3DOffset)-(br3DMid, br3D_Top + (br3DOffset * 2)), br3D_LineColor
br3D_OwnFrm.Line (br3DMid, br3D_Top + (br3DOffset * 2))-(br3D_Left + br3D_Width, br3D_Top + br3DOffset), br3D_LineColor
br3D_OwnFrm.Line (br3D_Left, br3D_Top + br3DOffset)-(br3DMid + (TPPX), br3D_Top), br3D_LineColor
br3D_OwnFrm.Line (br3D_Left + br3D_Width, br3D_Top + br3DOffset)-(br3DMid, br3D_Top), br3D_LineColor
' Onderste 3 lijnen (LinksOnder,RechtsOnder,Rechtsboven)
br3D_OwnFrm.Line (br3D_Left, br3D_Top + (br3D_Height - br3DOffset))-(br3DMid, br3D_Top + br3D_Height), br3D_LineColor
br3D_OwnFrm.Line (br3DMid, br3D_Top + br3D_Height)-(br3D_Left + br3D_Width, br3D_Top + (br3D_Height - br3DOffset)), br3D_LineColor
br3D_OwnFrm.Line (br3D_Left + br3D_Width - TPPX, br3D_Top + (br3D_Height - br3DOffset) - TPPY)-(br3DMid, br3D_Top + br3D_Height - (br3DOffset * 2)), br3D_FillTopColor
' FillBar TopVierkant (LinksOnder,RechtsOnder,LinksBoven,RechtsBoven)
br3D_OwnFrm.Line (br3D_Left + TPPX, br3DBarPos)-(br3DMid, br3DBarPos + br3DOffset), br3D_FillTopColor
br3D_OwnFrm.Line (br3DMid + TPPX, br3DBarPos + br3DOffset)-(br3D_Left + br3D_Width, br3DBarPos), br3D_FillTopColor
br3D_OwnFrm.Line (br3D_Left + TPPX, br3DBarPos)-(br3DMid, br3DBarPos - br3DOffset), br3D_FillTopColor
br3D_OwnFrm.Line (br3DMid + TPPX, br3DBarPos - br3DOffset)-(br3D_Left + br3D_Width, br3DBarPos), br3D_FillTopColor
' Oude waarden behouden
tmpForeColor = .ForeColor
tmpFontBold = .FontBold
tmpScalemode = .ScaleMode
.ScaleMode = vbPixels
.FillColor = vbBlue
ExtFloodFill .hdc, 20, 20, .BackColor, FLOODFILLSURFACE
.ScaleMode = tmpScalemode
' Percentage neerzetten?
If br3D_ShowText Then
.FontBold = True
.ForeColor = br3D_TextColor
.CurrentX = br3DMid - (.TextWidth(Percentage & "%") / 2) ' X Berekenen (Gecentreerd)
.CurrentY = br3D_Top + br3DOffset + (br3D_Height / 2) ' Y Berekenen (Gecentreerd)
br3D_OwnFrm.Print Percentage & "%"
End If
' Oude waarden terugzetten
.ForeColor = tmpForeColor
.FontBold = tmpFontBold
.AutoRedraw = tmpAutoRedraw
DoEvents ' Altijd zorgen dat de progressbar wordt bijgewerkt. Wel zo netjes...
End With
End Sub
Private Sub Class_Initialize()
' Owner al gezet?
OwnerSet = False
' Default kleuren
br3D_EmptyDarkColor = Def_EmptyDarkColor
br3D_EmptyLightColor = Def_EmptyLightColor
br3D_FillDarkColor = Def_FillDarkColor
br3D_FillLightColor = Def_FillLightColor
br3D_FillTopColor = Def_FillTopColor
br3D_FillBottomColor = Def_FillBottomColor
br3D_LineColor = Def_LineColor
br3D_TextColor = Def_TextColor
' Default Positie & Percentage
br3D_Top = 120
br3D_Left = 120
br3D_Width = 800
br3D_Height = 6000
br3D_Min = 0
br3D_Max = 100
br3D_Angle = Def_Angle
br3D_ShowText = Def_ShowText
End Sub
' =======================================================================================
' =======================================================================================
' Hieronder alle properties
' =======================================================================================
' =======================================================================================
Public Property Let Owner(ByVal frmOwnerHwnd As Form)
Set br3D_OwnFrm = frmOwnerHwnd
OwnerSet = True
End Property
Public Property Let Value(ByVal Value As Long)
' Binnen de geldige range?
If Value <= br3D_Max Then
' Oppassen voor delen door 0 en kijken of we wel een Owner hebben
If ((br3D_Max - br3D_Min) > 0) And OwnerSet Then
DrawBar CByte((100 / (br3D_Max - br3D_Min)) * Value)
Else
If Not OwnerSet Then Err.Raise 1, "3D ProgressBar", "Owner niet gezet! Gebruik het Owner property om dit in te stellen (b.v. 'pb.owner=me')"
End If
br3D_Value = Value
End If
End Property
Public Property Get Value() As Long
Value = br3D_Value
End Property
Public Property Let Max(ByVal Value As Long)
br3D_Max = Value
End Property
Public Property Get Max() As Long
Max = br3D_Max
End Property
Public Property Get Min() As Long
Min = br3D_Min
End Property
Public Property Let Min(ByVal Value As Long)
br3D_Min = Value
End Property
Public Property Let Angle(ByVal Value As Byte)
If (Value > 0) And (Value < 30) Then br3D_Angle = Value
End Property
Public Property Get Angle() As Byte
Angle = br3D_Angle
End Property
Public Property Get ShowText() As Boolean
ShowText = br3D_ShowText
End Property
Public Property Let ShowText(ByVal Value As Boolean)
br3D_ShowText = Value
End Property
Public Property Get Top() As Long
Top = br3D_Top
End Property
Public Property Let Top(ByVal Value As Long)
If Value >= 0 Then br3D_Top = Value
End Property
Public Property Get Left() As Long
Left = br3D_Left
End Property
Public Property Let Left(ByVal Value As Long)
If Value >= 0 Then br3D_Left = Value
End Property
Public Property Get Width() As Long
Width = br3D_Width
End Property
Public Property Let Width(ByVal Value As Long)
If Value >= Def_MinWidth Then br3D_Width = Value Else br3D_Width = Def_MinWidth
End Property
Public Property Get Height() As Long
Height = br3D_Height
End Property
Public Property Let Height(ByVal Value As Long)
If Value >= Def_MinHeight Then br3D_Height = Value Else br3D_Height = Def_MinHeight
End Property
This code should be pasted in a form with a (vertical)scollbar on it:
Code:
Option Explicit
Dim pb As New cls3D_Bar
Private Sub Form_Load()
With pb
.Owner = Me
.Min = VScroll1.Min
.Max = VScroll1.Max
End With
pb.Value = 0
End Sub
Private Sub VScroll1_Change()
pb.Value = VScroll1.Value
End Sub
Private Sub VScroll1_Scroll()
pb.Value = VScroll1.Value
End Sub
[Edited by RobIII on 10-22-2000 at 07:33 PM]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|