ctrcommand.ctl

this code helps u to understand the basic thing to connect visual basic with sqlserver. this ll be v

Sub_CalculateAlignment
Sub_PrintCaption
PropertyChanged "CaptionYOffset"


End Property

Public Property Get CaptionYOffset() As Long

CaptionYOffset = plngCaptionYOffset

End Property


Public Property Let FontBoldOnHover(New_FontBoldOnHover As Boolean)

pboolFontBoldOnHover = New_FontBoldOnHover
PropertyChanged "FontBoldOnHover"

End Property

Public Property Get FontBoldOnHover() As Boolean

FontBoldOnHover = pboolFontBoldOnHover

End Property

Public Property Let FontColorOnHover(New_FontColorOnHover As OLE_COLOR)

plngFontColorOnHover = New_FontColorOnHover
PropertyChanged "FontColorOnHover"

End Property

Public Property Get FontColorOnHover() As OLE_COLOR

FontColorOnHover = plngFontColorOnHover

End Property


Public Property Let ForeColor(New_ForeColor As OLE_COLOR)

UserControl.ForeColor() = New_ForeColor
''''' ' Za da se opravi buga pri smiana na Font.Bold i .ForeColor
'''''Sub_CalculateAlignment
Sub_PrintCaption
Sub_DrawBorder enumBorderState
PropertyChanged "ForeColor"

End Property

Public Property Get ForeColor() As OLE_COLOR

ForeColor = UserControl.ForeColor

End Property

Public Property Let PictureAlignment(New_PictureAlignment As enum_ggcmd_Alignment)

penumPictureAlignment = New_PictureAlignment
Sub_CalculateAlignment
Sub_PrintCaption
PropertyChanged "PictureAlignment"

End Property

Public Property Get PictureAlignment() As enum_ggcmd_Alignment

PictureAlignment = penumPictureAlignment

End Property

'Public Property Let PictureTiled(New_PictureTiled As Boolean)
'
'pboolPictureTiled = New_PictureTiled
'Call Sub_PrintCaption
'
'PropertyChanged "PictureTiled"
'
'End Property

'Public Property Get PictureTiled() As Boolean
'
'PictureTiled = pboolPictureTiled
'
'End Property
'
Public Property Let PictureXOffset(New_PictureXOffset As Long)

plngPictureXOffset = New_PictureXOffset
Sub_CalculateAlignment
Sub_PrintCaption
PropertyChanged "PictureXOffset"

End Property

Public Property Get PictureXOffset() As Long

PictureXOffset = plngPictureXOffset

End Property

Public Property Let PictureYOffset(New_PictureYOffset As Long)

plngPictureYOffset = New_PictureYOffset
Sub_CalculateAlignment
Sub_PrintCaption
PropertyChanged "PictureYOffset"

End Property

Public Property Get PictureYOffset() As Long

PictureYOffset = plngPictureYOffset

End Property


Private Sub Sub_CalculateAlignment(Optional byteCalculateFor As Byte = 0)

On Error Resume Next

Dim sngTextWidth As Single
Dim sngTextHeight As Single

Dim sngPictureWidth As Single
Dim sngPictureHeight As Single

Dim sngUCWidth As Single
Dim sngUCHeight As Single

Dim sngCenter As Single
Dim sngRight As Single
Dim sngMiddle As Single
Dim sngBottom As Single

Call Sub_SetBorder3DStyle(plngBorder3DStyle)

sngUCHeight = UserControl.ScaleHeight
sngUCWidth = UserControl.ScaleWidth

sngTextWidth = UserControl.TextWidth(pstrCaption)
sngTextHeight = UserControl.TextHeight(pstrCaption)

 ' Izchisliavane na poziciite po horizontalata za caption
sngCenter = (sngUCWidth - sngTextWidth) / 2
sngRight = sngUCWidth - sngTextWidth
 ' Izchisliavane na poziciite po vertikalata za caption
sngMiddle = (sngUCHeight - sngTextHeight) / 2
sngBottom = sngUCHeight - sngTextHeight

 ' Izchisliavane poziciata na Caption
Select Case penumCaptionAlignment
 Case [Left_Top]
  sngCaptionXPos = 1
  sngCaptionYPos = 1
 
 Case [Left_Middle]
  sngCaptionXPos = 1
  sngCaptionYPos = sngMiddle
 
 Case [Left_Bottom]
  sngCaptionXPos = 1
  sngCaptionYPos = sngBottom - 1
 
 Case [Center_Top]
  sngCaptionXPos = sngCenter
  sngCaptionYPos = 1
  
 Case [Center_Middle]
  sngCaptionXPos = sngCenter
  sngCaptionYPos = sngMiddle
 
 Case [Center_Bottom]
  sngCaptionXPos = sngCenter
  sngCaptionYPos = sngBottom - 1
 
 Case [Right_Top]
  sngCaptionXPos = sngRight - 2
  sngCaptionYPos = 1
  
 Case [Right_Middle]
  sngCaptionXPos = sngRight - 2
  sngCaptionYPos = sngMiddle
 
 Case [Right_Bottom]
  sngCaptionXPos = sngRight - 2
  sngCaptionYPos = sngBottom - 1
End Select

sngCaptionXPos = Int(sngCaptionXPos + plngCaptionXOffset)
sngCaptionYPos = Int(sngCaptionYPos + plngCaptionYOffset)


sngPictureWidth = ppicPicture.Width / Screen.TwipsPerPixelX / 1.75
sngPictureHeight = ppicPicture.Height / Screen.TwipsPerPixelY / 1.75

 ' Izchisliavane na poziciite po horizontalata za Picture
sngCenter = (sngUCWidth - sngPictureWidth) / 2
sngRight = sngUCWidth - sngPictureWidth
 ' Izchisliavane na poziciite po vertikalata za Picture
sngMiddle = (sngUCHeight - sngPictureHeight) / 2
sngBottom = sngUCHeight - sngPictureHeight

 ' Izchisliavane poziciata na Picture
Select Case penumPictureAlignment
 Case [Left_Top]
  sngPictureXPos = 1
  sngPictureYPos = 1
 
 Case [Left_Middle]
  sngPictureXPos = 1
  sngPictureYPos = sngMiddle
 
 Case [Left_Bottom]
  sngPictureXPos = 1
  sngPictureYPos = sngBottom - 1
 
 Case [Center_Top]
  sngPictureXPos = sngCenter
  sngPictureYPos = 1
  
 Case [Center_Middle]
  sngPictureXPos = sngCenter
  sngPictureYPos = sngMiddle
 
 Case [Center_Bottom]
  sngPictureXPos = sngCenter
  sngPictureYPos = sngBottom - 1
 
 Case [Right_Top]
  sngPictureXPos = sngRight - 1
  sngPictureYPos = 1
  
 Case [Right_Middle]
  sngPictureXPos = sngRight - 1
  sngPictureYPos = sngMiddle
 
 Case [Right_Bottom]
  sngPictureXPos = sngRight - 1
  sngPictureYPos = sngBottom - 1
End Select

sngPictureXPos = Int(sngPictureXPos + plngPictureXOffset)
sngPictureYPos = Int(sngPictureYPos + plngPictureYOffset)

End Sub



Public Property Get Caption() As String

Caption = pstrCaption

End Property


Public Property Get hWnd() As Long

hWnd = UserControl.hWnd

End Property


Private Sub Sub_DrawBorder(lngState As enum_ggcmd_BorderState, Optional boolDrawFocus As Boolean = False)

Dim sngUCSH As Single
Dim sngUCSW As Single
Dim lngLeftUpColor As Long
Dim lngRightDownColor As Long

 ' Opredeliane na cvetovete za liniite
 ' V zavisimost ot "State" na bordera
Select Case lngState
 Case 0 ' None - Liniite sa s cveta na .BackColor
  lngLeftUpColor = UserControl.BackColor
  lngRightDownColor = lngLeftUpColor
 Case 1 ' Raised - Liavata i gornata - beli - Diasnata i dolnata - tamno sivi
  lngLeftUpColor = vbWhite
  lngRightDownColor = vb3DShadow
 Case 2 ' Inset - Liavata i gornata - tamno sivi - Diasnata i dolnata - beli
  lngLeftUpColor = vb3DShadow
  lngRightDownColor = vbWhite
End Select

If pboolAlwaysShowBorder = True And lngState = None Then
 lngLeftUpColor = vbWhite
 lngRightDownColor = vb3DShadow
End If

sngUCSH = UserControl.ScaleHeight - 1
sngUCSW = UserControl.ScaleWidth - 1
 
'''If boolDrawFocus = True Then
''' UserControl.DrawStyle = vbDot
''' UserControl.Line (3, 3)-(sngUCSW - 3, sngUCSH - 3), , B
''' UserControl.DrawStyle = 0
'''End If
 
 ' Red na chertane - Liavo-Gore
UserControl.Line (0, sngUCSH)-(0, 0), lngLeftUpColor
UserControl.Line -(sngUCSW, 0), lngLeftUpColor
 ' Posle - Diasno-Doly
UserControl.Line (sngUCSW, -1)-(sngUCSW, sngUCSH), lngRightDownColor
UserControl.Line -(-1, sngUCSH), lngRightDownColor

enumBorderState = lngState


End Sub

Private Sub Sub_PrintCaption(Optional byteCaptionOffset As Byte = 0, _
                             Optional boolInverseGradient As Boolean = False)

On Error Resume Next
'Dim intI As Integer
'Dim intJ As Integer

UserControl.Cls

Sub_DrawGradient proplngGradientFromColor, proplngGradientToColor, boolInverseGradient

If TypeName(ppicPicture) = "Picture" Then
   If imgPicture.Left <> sngPictureXPos + byteCaptionOffset Or imgPicture.Top <> sngPictureYPos + byteCaptionOffset Then
      imgPicture.Move sngPictureXPos + byteCaptionOffset, sngPictureYPos + byteCaptionOffset
   End If
   If imgPicture.Picture <> ppicPicture Then
      Set imgPicture.Picture = ppicPicture
   End If
 'UserControl.PaintPicture ppicPicture, sngPictureXPos + byteCaptionOffset, sngPictureYPos + byteCaptionOffset
End If

UserControl.CurrentX = sngCaptionXPos + byteCaptionOffset
UserControl.CurrentY = sngCaptionYPos + byteCaptionOffset
UserControl.Print pstrCaption
byteOffset = byteCaptionOffset

If pboolAlwaysShowBorder = True Then
 Sub_DrawBorder [Raised]
End If


End Sub

Public Property Let ToolTip(New_ToolTip As String)

tpToolInfo.lpStr = New_ToolTip

If plngToolTipHwnd <> 0 Then
 SendMessage plngToolTipHwnd, TTM_UPDATETIPTEXTA, 0&, tpToolInfo
End If

pstrToolTip = New_ToolTip

PropertyChanged "ToolTip"

End Property

Public Property Get ToolTip() As String

ToolTip = pstrToolTip

End Property

Private Sub ToolTipDestroy()

DestroyWindow plngToolTipHwnd

End Sub

Public Property Let ToolTipIcon(New_ToolTipIcon As enum_ggcmd_ToolTipIcon)

plngToolTipIcon = New_ToolTipIcon

PropertyChanged "ToolTipIcon"

End Property

Public Property Get ToolTipIcon() As enum_ggcmd_ToolTipIcon

ToolTipIcon = plngToolTipIcon

End Property

Public Property Let ToolTipStyle(New_ToolTipStyle As enum_ggcmd_ToolTipStyle)

plngToolTipStyle = New_ToolTipStyle

PropertyChanged "ToolTipStyle"

End Property

Public Property Get ToolTipStyle() As enum_ggcmd_ToolTipStyle

ToolTipStyle = plngToolTipStyle

End Property

Public Property Get ToolTipTitle() As String

ToolTipTitle = pstrToolTipTitle

End Property



Public Property Let ToolTipTitle(New_ToolTipTitle As String)

pstrToolTipTitle = New_ToolTipTitle

PropertyChanged "ToolTipTitle"

End Property

Public Property Let UseGradientFill(boolNewUseGradientFill As Boolean)

If propboolUseGradientFill <> boolNewUseGradientFill Then
   propboolUseGradientFill = boolNewUseGradientFill
   UseGradientFill = propboolUseGradientFill
   Sub_CalculateAlignment
   Sub_PrintCaption
   PropertyChanged "UseGradientFill"
End If

End Property

Public Property Get UseGradientFill() As Boolean

UseGradientFill = propboolUseGradientFill

End Property

Public Property Let UseHoverProperties(New_UseHoverProperties As Boolean)

pboolUseHoverProperties = New_UseHoverProperties
PropertyChanged "UseHoverProperties"

End Property

Public Property Get UseHoverProperties() As Boolean

UseHoverProperties = pboolUseHoverProperties

End Property




Public Property Let Value(New_Value As Boolean)

If New_Value = True Then
 RaiseEvent Click
End If

End Property



Private Sub imgPicture_DblClick()

Call UserControl_DblClick

End Sub

Private Sub imgPicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Call UserControl_MouseDown(Button, Shift, X / 15, Y / 15)

End Sub


Private Sub imgPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Call UserControl_MouseMove(Button, Shift, X / 15, Y / 15)

End Sub


Private Sub imgPicture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Call UserControl_MouseUp(Button, Shift, X / 15, Y / 15)

End Sub


Private Sub UserControl_DblClick()

RaiseEvent DblClick

End Sub

Private Sub UserControl_GotFocus()

 ' Ako fokysa e vzet sled natiskane s mishkata
 ' da ne se pokazva bordera "Raised"

If boolMouseFocus = True Then
 boolMouseFocus = False