codelib.cod

用VB作的程序电子书

Call Gradient(Form1, 0, 50, 64, 0, 64, 255, True)
Call Gradient(Picture1, 200, 60, 255, 184, 255, 55, False)



鼢鼢鼢
Coded by Stephan Swervaegher
鼢鼢鼢
 5 
CountLinesInTextbox
Public Function CountLines(textBox As textBox) As Long
    Dim A%, B$
    A% = 1
    B$ = textBox.Text
    Do While InStr(B$, Chr$(13))
        A% = A% + 1
        B$ = Mid$(B$, InStr(B$, Chr$(13)) + 1)
    Loop
    CountLines = CStr(A%)
End Function
鼢鼢鼢
CountLinesInTextBox

Syntax: CountLines( TextBox)

Returns: The number of lines in a Multiline TextBox

Example:

Private Sub Text1_Change()
Label1.Caption = Countlines(Text1)
End Sub


鼢鼢鼢
See for the same function in the API-routines

鼢鼢鼢
0
PointBar
Public Sub PointBar(R%, G%, B%)
Dim Step%, NewStep%, NewR%, NewG%, NewB%
Label1.Width = Form1.ScaleWidth
Label1.Top = 5
Step = 12
NewR = R
NewG = G
NewB = B
For xx = 0 To 12
Form1.Line (0 + NewStep, xx)-(Form1.ScaleWidth - NewStep, xx), RGB(NewR, NewG, NewB)
Form1.Line (0 + NewStep, 25 - xx)-(Form1.ScaleWidth - NewStep, 25 - xx), RGB(NewR, NewG, NewB)
NewStep = NewStep + Step
NewR = NewR + 10
If NewR > 255 Then NewR = 255
NewG = NewG + 10
If NewG > 255 Then NewG = 255
NewB = NewB + 10
If NewB > 255 Then NewB = 255
Step = Step - 1
Next xx
End Sub
鼢鼢鼢
PointBar module

Draws a pointed bar on top of the screen with a fixed height of 25.

Syntax: PointBar(R%, G%, B%)

R, G and B are the RGB-colors of the pointbar

Examples:

Call PointBar(128, 40,255)
Call PointBar(0,0,192)
鼢鼢鼢
This gives a good effect with a form with no border and a
label on top of the pointbar.
The label must be transparent.

Coded by Stephan Swervaegher
鼢鼢鼢
 4 
T3D
Public Enum T3dFill
T3dF0
T3dF1
End Enum

Public Enum Borderstyle
T3dRaiseRaise
T3dRaiseInset
T3dInsetRaise
T3dInsetInset
T3dNone
End Enum

Public Function T3D(Obj0 As Object, Obj As Object, Bev%, Optional Style3D As Borderstyle, Optional T3dFilled As T3dFill)
Dim R1%, G1%, B1%, R2%, G2%, B2%, R3%, G3%, B3%, R4%, G4%, B4%
Dim T3Dxx%
On Error Resume Next

Obj.Borderstyle = 0 'no border

If IsMissing(Style3D) Then Style3D = 0

If Style3D > 4 Then Style3D = 3

If Style3D = 0 Then 'RaiseRaise
R1 = 240: R2 = 128: R3 = 240: R4 = 128
End If
If Style3D = 1 Then 'RaiseInset
R1 = 240: R2 = 128: R4 = 240: R3 = 128
End If
If Style3D = 2 Then 'InsetRaise
R2 = 240: R1 = 128: R3 = 240: R4 = 128
End If
If Style3D = 3 Then 'InsetInset
R2 = 240: R1 = 128: R4 = 240: R3 = 128
End If
If Style3D = 4 Then 'No Border
R1 = 192: R2 = 192: R3 = 192: R4 = 192
End If

G1 = R1: B1 = R1
G2 = R2: B2 = R2
G3 = R3: B3 = R3
G4 = R4: B4 = R4
Bev = Bev + 1
T3Dxx = Bev
'Outer
If IsMissing(T3dFilled) Or T3dFilled = 0 Then
    Obj0.Line (Obj.Left - Bev, Obj.Top - Bev)-(Obj.Left - Bev, Obj.Top + Obj.Height + Bev), RGB(R1, G1, B1)
    Obj0.Line (Obj.Left - Bev, Obj.Top - Bev)-(Obj.Left + Obj.Width + Bev, Obj.Top - Bev), RGB(R1, G1, B1)
    Obj0.Line (Obj.Left + Obj.Width + Bev, Obj.Top - Bev)-(Obj.Left + Obj.Width + Bev, Obj.Top + Obj.Height + Bev), RGB(R2, G2, B2)
    Obj0.Line (Obj.Left - Bev, Obj.Top + Obj.Height + Bev)-(Obj.Left + Obj.Width + Bev + 1, Obj.Top + Obj.Height + Bev), RGB(R2, G2, B2)
Else
For Bev = T3Dxx To 1 Step -1
    Obj0.Line (Obj.Left - Bev, Obj.Top - Bev)-(Obj.Left - Bev, Obj.Top + Obj.Height + Bev), RGB(R1, G1, B1)
    Obj0.Line (Obj.Left - Bev, Obj.Top - Bev)-(Obj.Left + Obj.Width + Bev, Obj.Top - Bev), RGB(R1, G1, B1)
    Obj0.Line (Obj.Left + Obj.Width + Bev, Obj.Top - Bev)-(Obj.Left + Obj.Width + Bev, Obj.Top + Obj.Height + Bev), RGB(R2, G2, B2)
    Obj0.Line (Obj.Left - Bev, Obj.Top + Obj.Height + Bev)-(Obj.Left + Obj.Width + Bev + 1, Obj.Top + Obj.Height + Bev), RGB(R2, G2, B2)
Next Bev
End If
'Inner
    Obj0.Line (Obj.Left - 1, Obj.Top - 1)-(Obj.Left - 1, Obj.Top + Obj.Height + 1), RGB(R3, G3, B3)
    Obj0.Line (Obj.Left - 1, Obj.Top - 1)-(Obj.Left + Obj.Width + 1, Obj.Top - 1), RGB(R3, G3, B3)
    Obj0.Line (Obj.Left + Obj.Width + 1, Obj.Top - 1)-(Obj.Left + Obj.Width + 1, Obj.Top + Obj.Height + 1), RGB(R4, G4, B4)
    Obj0.Line (Obj.Left - 1, Obj.Top + Obj.Height + 1)-(Obj.Left + Obj.Width + 2, Obj.Top + Obj.Height + 1), RGB(R4, G4, B4)
End Function
鼢鼢鼢
T3D function (Target 3D)

Puts a 3D-border arround any control. This border has 2 levels: outer border and inner border.
The border can be raised, inset or mixed, filled and not filled. It works only on a normal (standard)
forms, with the backcolor RGB(192, 192, 192)

Syntax: T3D Form, Control, Bevel, [Style], [Filled]

The T3D function syntax has these named arguments:

Form	The form where you want to have a 3D-control. The form must be in ScaleMode = 3 (Pixel)
	and AutoRedraw = True.

Control	The actual control to put in 3D. If you want a control in another form, you have
                to specify this. Example: Form2.Label1 

Bevel	The distance between the inner and outer border.

Style	(Optional)The style of 3D, as described in settings. If you omit Style, it will be set
                to 0 (RaiseRaise).

Filled	(Optional) Filled between the inner and outer border, as described in settings. If you omit
                Filled, it will be set to 0 (no fill).

Settings
The Style argument settings are:

Constant		Value			Description

T3dRaiseRaise	0			Inner raised and outer raised
T3dRaiseInset	1			Inner raised and outer inset
T3dInsetRaise	2			Inner inset and outer raised
T3dInsetInset	3			Inner inset and outer inset
T3dNone		4			No border at all
Note: These constants are specified in the Subroutine.  As a result, the names
can be used anywhere in your code in place of the actual values.

The Filled argument settings are:

Constant		Value			Description

T3dF0		0			Not filled	
T3dF1		1			Filled
Note: These constants are specified in the Subroutine.  As a result, the names
can be used anywhere in your code in place of the actual values.

Examples:

T3D Form1, Label1, 20, T3dRaiseRaise, T3dF0 
T3D Form1, Label2, 8, 0, T3dF1
T3D Form1, Text1, 3, T3dRaiseInset
T3D Form2, Form2.text1, 5, T3dInsetInset, T3dF1 

You can acces the routine with a variabele, but there will be no return-value.

Dim A%
A = T3D(Form1, Label1, 20, T3dRaiseRaise, T3dF0)

鼢鼢鼢
Between the controls (label, textbox, ...), there must be a minimum distance
of the Bevel-width you specified . 
Important: if you specify a control in another form, you must specify that control too !
Example: T3D Form2, Form2.label1, 5, T3dInsetInset, T3dF1
If you don't that, for example, the border in form2 will be set according to the label in
form1 !!!
鼢鼢鼢
 2 
PicInvert
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long

'The code:

For x = 0 To Picture1.ScaleWidth
For y = 0 To Picture1.ScaleHeight
SetPixel Picture1.hDC, x, y, 16777215 - GetPixel(Picture1.hDC, x, y)
Next y
Next x
Picture1.Refresh


鼢鼢鼢
鼢鼢鼢
Code from Planet Source
Provided by  Tanner Helland
鼢鼢鼢
 0 
RasGradient
Public Sub RasGradient(OBJ As Object, R As Integer, G As Integer, B As Integer, RStep As Integer, Gstep As Integer, Bstep As Integer, Position As Boolean)
Dim Count, xyz As Integer
If Position = False Then 'top to bottom
For Count = 0 To (OBJ.ScaleHeight / 2)
OBJ.Line (0, xyz)-(OBJ.ScaleWidth, xyz), RGB(R, G, B)
OBJ.Line (0, OBJ.ScaleHeight - xyz)-(OBJ.ScaleWidth, OBJ.ScaleHeight - xyz), RGB(R, G, B)
xyz = xyz + 1
R = R + RStep
If R < 0 Then R = 0
If R > 255 Then R = 255
G = G + Gstep
If G < 0 Then G = 0
If G > 255 Then G = 255
B = B + Bstep
If B < 0 Then B = 0
If B > 255 Then B = 255
Next Count

Else 'Position = True

For Count = 0 To (OBJ.ScaleWidth / 2)
OBJ.Line (xyz, 0)-(xyz, OBJ.ScaleHeight), RGB(R, G, B)
OBJ.Line (OBJ.ScaleWidth - xyz, 0)-(OBJ.ScaleWidth - xyz, OBJ.ScaleHeight), RGB(R, G, B)
xyz = xyz + 1
R = R + RStep
If R < 0 Then R = 0
If R > 255 Then R = 255
G = G + Gstep
If G < 0 Then G = 0
If G > 255 Then G = 255
B = B + Bstep
If B < 0 Then B = 0
If B > 255 Then B = 255
Next Count
End If
End Sub
鼢鼢鼢
RasGradient

If the position is False:
Fills the Form or PictureBox with a gradient from top to middle with
an increasing gradient, and from middle to bottom with a decreasing gradient.
If the position is True:
Fills the Form or PictureBox with a gradient from left to middle with
an increasing gradient, and from middle to right with a decreasing gradient.

Syntax: Call  RasGradient(Object, R, G, B, RStep, Gstep, Bstep, Position)

Object: Form or PictureBox (must support the line-method)
R: Red component of the starting color
G: Green component of the starting color
B: Blue component of the starting color
Rstep: Increasing/decreasing value of the Red component
Gstep: Increasing/decreasing value of the Green component
Bstep: Increasing/decreasing value of the Blue component
Position: True or False
                 True: Gradient from left to right
                 False: Gradient from top to bottom

Note:
* The Object must be in ScaleMode = 3 (Pixels) and AutoRedraw = true
* By setting the starting values of R, G, and B bigger than the
  ending values, you create a negative ColBar.
* The values of R, G, and B must not exceed 255.


Examples:

Call RasGradient(Form1, 0, 50, 64, 0, 2, 3, True)
Call RasGradient(Picture1, 200, 60, 255, 3, 2, 1, False)



鼢鼢鼢
Coded by Stephan Swervaegher
鼢鼢鼢
 0 
Rasters
Public Sub Rasters(OBJ As Object, R As Integer, G As Integer, B As Integer, StepR As Integer, StepG As Integer, StepB As Integer, Style As Integer, Start As Integer, StepStart As Integer)
Dim aa%, bb%, cc%, OriginR%, OriginG%, OriginB%
aa% = 1: cc% = Start
OriginR% = R: OriginG% = G: OriginB% = B
If StepR > 25 Then StepR = 25
If StepG > 25 Then StepG = 25
If StepB > 25 Then StepB = 25
If Style > 10 Then Style = 10
If Start > 25 Then Start = 25
If StepStart > 25 Then StepStart = 25
OBJ.BackColor = RGB(0, 0, 0)
OBJ.Cls
Rasters0:
    For bb% = 0 To cc%
    OBJ.Line (0, aa%)-(OBJ.ScaleWidth, aa%), RGB(R, G, B)
    OBJ.Line (0, OBJ.ScaleHeight - aa%)-(OBJ.ScaleWidth, OBJ.ScaleHeight - aa%), RGB(R, G, B)
    R = R + StepR
    If R > 255 Then R = 255
    If R < 0 Then R = 0
    G = G + StepG
    If G > 255 Then G = 255
    If G < 0 Then G = 0
    B = B + StepB
    If B > 255 Then B = 255
    If B < 0 Then B = 0
    If aa% = Int(OBJ.ScaleHeight / 2) Then
    Exit Sub
    Else
    aa% = aa% + 1
    End If
    Next bb%
    R = OriginR%
    G = OriginG%
    B = OriginB%
    cc% = cc% + StepStart
    If Style = 0 Then GoTo Rasters0
    For bb% = 1 To Style
        If aa% = Int(OBJ.ScaleHeight / 2) Then
        Exit Sub
        Else
        aa% = aa% + 1
        End If
    Next bb%
GoTo Rasters0
rasters1:
End Sub
鼢鼢鼢
Rasters

Syntax:  Rasters (Object, R, G, B, StepR, StepG, StepB, Style, Start, StepStart)
Notes:
Object must support the "Line"-method
Object in Scalemode "Pixel"
Object in "AutoRedraw = True"
Object in "BackColor = Black"

Returns: None
Side effects: none

Explanation:

   Obj       = Object, a Form or a PictureBox
   R         = Starting value of the red component (0 to 255)
   G         = Starting value of the green component (0 to 255)
   B         = Starting value of the blue component (0 to 255)
   StepR     = Increment of the red component (-25 to 25)
   StepG     = Increment of the green component (-25 to 25)
   StepB     = Increment of the blue component (-25 to 25)
   Style     = the number of lines to skip (0 to 10)
   Start     = the start value of the number of rasters (0 to 25)
   Stepstart = the increment of the number of rasters (0 to 25)

 Remarks: The StepR, StepG and StepB can be negative !

Example: 
Call Rasters (Picture1, 64, 96, 128, 3, 2, 1, 1, 10, 5)

鼢鼢鼢
Coded by Stephan Swervaegher
鼢鼢鼢
 2 
ExplodeForm
'Declarations for ExplodeForm
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long  'note error in declare
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Sub ExplodeForm(frm As Form, Steps As Long, Color As Long)
   Dim ThisRect As RECT, RectWidth As Integer, RectHeight As Integer, ScreenDevice As Long, NewBrush As Long, OldBrush As Long, I As Long, X As Integer, Y As Integer, XRect As Integer, YRect As Integer
   If Steps < 20 Then Steps = 20
   'Zooming speed will be different based on machine speed!
   If Color = 0 Then
      Color = frm.BackColor
   End If
   Steps = Steps * 10
   'Get current form window dimensions
   GetWindowRect frm.hwnd, ThisRect
   RectWidth = (ThisRect.Right - ThisRect.Left)
   RectHeight = ThisRect.Bottom - ThisRect.Top
   'Get a device handle for the screen
   ScreenDevice = GetDC(0)
   'Create a brush for drawing to the screen
   'and save the old brush
   NewBrush = CreateSolidBrush(Color)
   OldBrush = SelectObject(ScreenDevice, NewBrush)
   For I = 1 To Steps
      XRect = RectWidth * (I / Steps)
      YRect = RectHeight * (I / Steps)
      X = ThisRect.Left + (RectWidth - XRect) / 2
      Y = ThisRect.Top + (RectHeight - YRect) / 2
      'Incrementally draw rectangle
      Rectangle ScreenDevice, X, Y, X + XRect, Y + YRect
   Next I
   'Return old brush and delete screen device context handle
   'Then destroy brush that drew rectangles
   Call SelectObject(ScreenDevice, OldBrush)
   Call ReleaseDC(0, ScreenDevice)
   DeleteObject (NewBrush)
End Sub

鼢鼢鼢
ExplodeForm

Shows the form from nothing to full size according to the steps

Syntax: ExplodeForm FormName, Steps, Color

FormName: The name of the Form, as set in the properties
Steps: Zooming speed
Color: The color of the explosion

Remarks: 
* First of all, set the position of the form, before calling the ExplodeForm
* Zooming speed will be different based on machine speed!
* If Color = 0, then the Form BackColor will be applied
* The ExplodeForm-Sub is best stored in a module

Examples:

ExplodeForm Me, 50, 0
ExplodeForm Form1, 200, vbRed
ExplodeForm Me, 500, RGB(64, 192,128)

Example in the Form_Load Event:

Private Sub Form_Load()
'First, set the position of the form