Sign up to create your own snipts, or login.

Public snipts » beccoblu's snipts The latest snipts from beccoblu.

showing 1-9 of 9 snipts
  • ∞ VB6: Always On Top forms 
    Private Declare Function SetWindowPos Lib "user32" _
  (ByVal hwnd As Long, _
  ByVal hWndInsertAfter As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal cx As Long, _
  ByVal cy As Long, _
  ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

'--------------------

Public Sub SetAlwaysOnTop(hwnd As Long, AOT As Boolean)

  If AOT Then
    SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
  Else
    SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
  End If

End Sub

    copy | embed

    0 comments - tagged in  posted by beccoblu on Feb 15, 2010 at 5:28 a.m. EST
  • ∞ VB6: Connect via ADO to Access 2007 database 
    'Needs Microsoft ActiveX Data Objects Library

ConnectionString = "PROVIDER=Microsoft.ACE.OLEDB.12.0;" & _
  "Data Source=" & FileName & ";"

    copy | embed

    0 comments - tagged in  posted by beccoblu on Feb 15, 2010 at 5:24 a.m. EST
  • ∞ VB6: Write a message in a daily log 
    Public Sub WriteLog(Message As String)

  Dim fso, fileName As String, logString As String, f as Integer
  
  fileName = App.path & "\Log_" & Format(Now, "yyyymmdd") & ".txt"
  logString = Format(Now, "hh:mm:ss") & " - " & Message
  f = Freefile
  Open fileName For Append As #f
  Print #f, logString
  Close #f

End Sub

    copy | embed

    0 comments - tagged in  posted by beccoblu on Feb 14, 2010 at 10:04 a.m. EST
  • ∞ VB6: Darken background when opening a modal form 
    '##### frmGray.frm

Option Explicit

Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_EX_RIGHT As Long = &H1000
Private Const WS_EX_LEFTSCROLLBAR As Long = &H4000
Private Const WS_EX_LAYERED As Long = &H80000
Private Const WS_EX_TRANSPARENT = &H20&
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_ALPHA As Long = &H2

Private Declare Function GetWindowLong Lib "User32" _
  Alias "GetWindowLongA" _
  (ByVal hwnd As Long, _
  ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "User32" _
  Alias "SetWindowLongA" _
  (ByVal hwnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "User32" _
  (ByVal hwnd As Long, _
  ByVal crKey As Long, _
  ByVal bAlpha As Long, _
  ByVal dwFlags As Long) As Long
  
Dim formOpening As Boolean

'--------------------

Private Sub Form_Activate()
  
  If formOpening Then
    Me.WindowState = vbMaximized
    frmModalForm.Show vbModal
    Unload Me
    formOpening = False
  End If

End Sub

'--------------------

Private Sub Form_Load()

  formOpening = True
  Me.BackColor = vbBlack
  Call AlphaForm

End Sub

'--------------------

Private Function AlphaForm()

  Dim style As Long
  Dim alpha As Integer

  alpha = 120    'set alpha transparency (0-255)
  style = GetWindowLong(Me.hwnd, GWL_EXSTYLE)

  If Not (style And WS_EX_LAYERED = WS_EX_LAYERED) Then

    style = style Or WS_EX_LAYERED
    SetWindowLong Me.hwnd, GWL_EXSTYLE, style
    SetLayeredWindowAttributes Me.hwnd, 0&, alpha, LWA_ALPHA

  End If

End Function



'##### frmCaller.frm

Private Sub Command1_Click()

  frmGray.Show vbModal    'instead of frmModalForm.Show vbModal

End Sub

    copy | embed

    0 comments - tagged in  posted by beccoblu on Feb 12, 2010 at 12:07 p.m. EST
  • ∞ VB6: Operations involving controls at startup time 
    Dim StartUp As Boolean

'--------------------

Private Sub Form_Load()

  StartUp = True

End Sub

'--------------------

Private Sub Form_Activate()

  If StartUp Then
    Text1.SetFocus    ' Or any other operation involving controls, to run only at startup
    StartUp = False
  End If

End Sub

    copy | embed

    0 comments - tagged in  posted by beccoblu on Feb 10, 2010 at 11:34 a.m. EST
  • ∞ C#: Application Path (= VB6 App.Path) in Compact Framework 2.0 
    string appPath;

appPath = System.Reflection.Assembly.GetExecutingAssembly().GetName().CodeBase;
appPath = System.IO.Path.GetDirectoryName(appPath);

    copy | embed

    0 comments - tagged in  posted by beccoblu on Jan 28, 2010 at 8:37 a.m. EST
  • ∞ C#: Check whether string s is an Int32 number 
    public static bool IsInt(string s)
  {
    try
    { Int32.Parse(s); }
    catch
    { return false; }
    return true;
  }

    copy | embed

    0 comments - tagged in  posted by beccoblu on Jan 28, 2010 at 8:34 a.m. EST
  • ∞ VB6: Move a form by dragging it with mouse 
    Dim StartX As Single, StartY As Single, Moving As Boolean
 
'--------------------
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Button <> 1 Then Exit Sub
  StartX = X
  StartY = Y
  Moving = True

End Sub
 
'--------------------
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Moving then Move Left + (X - StartX), Top + (Y - StartY)

End Sub
 
'--------------------
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

  Moving = False

End Sub

    copy | embed

    0 comments - tagged in  posted by beccoblu on Jan 27, 2010 at 5:15 p.m. EST
  • ∞ VB6: Compact Access DB with ADO 
    Public Function DbCompact(oldDb As String, Optional bakDb As String = "") As Integer

  'Needs Microsoft Jet and Replication Objects Library
  'Needs Microsoft ActiveX Data Objects Library
  'Needs Microsoft Scripting Runtime

  'Returns 0 if OK, -1 if FAIL

  DbCompact = -1

  On Error GoTo noDbOk

  Dim j As JetEngine
  Dim fso As FileSystemObject
  Dim jStr As String, newDb As String

  Set fso = New FileSystemObject
  If Not fso.FileExists(oldDb) Then Exit Sub

  Set j = New JetEngine

  jStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
  newDb = App.Path & "\tmpDb.mdb"

  j.CompactDatabase jStr & oldDb, jStr & newDb

  If Trim(bakDb) <> "" Then
    If fso.FileExists(bakDb) Then fso.DeleteFile bakDb
    fso.MoveFile oldDb, bakDb
  Else
    fso.DeleteFile oldDb
  End If
  fso.MoveFile newDb, oldDb

  DbCompact = 0

noDbOk:

  Set fso = Nothing
  Set j = Nothing

End Sub

    copy | embed

    0 comments - tagged in  posted by beccoblu on Jan 27, 2010 at 11:16 a.m. EST
Sign up to create your own snipts, or login.