[RESOLVED] using Addin: how can i change a form property?

[joaquim]

i'm trying creating an AddIn just for change:
1 - when a form it's created the property AutoRedraw must be true and the ScaleMode must be pixel;
2 - can i add a classe and some functions?

[gilman]

Here is an Addin that chage the default font of a form:
https://www.vbforums.com/showthread....rms&highlight=
You can use it for change other properties of a form

[joaquim]

thank you so much.. the problem was on 1 'if' before 'set' a variable!!!!
now works fine.. thanks...

Option Explicit

Private Declare Function ShowWindow Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal nCmdShow As Long) As Long
Private Const SW_MAXIMIZE As Long = 3

Private GUIvisible              As Boolean

Dim mcbMenuCommandBar         As Office.CommandBarControl
Dim mcbLineNumbersAdd         As Office.CommandBarControl
Dim mcbLineNumbersRemove      As Office.CommandBarControl
Private WithEvents MenuHandler         As CommandBarEvents
Private WithEvents LineNumAddHandler   As CommandBarEvents
Private WithEvents LineNumRemoveHandler As CommandBarEvents

' CORREÇÃO: Variáveis de eventos globais declaradas corretamente
Private WithEvents VBProjEvents As VBIDE.VBProjectsEvents
Private WithEvents VBCompEvents As VBIDE.VBComponentsEvents

Private Sub Hide()
   On Error Resume Next
   GUIvisible = False
End Sub

Private Sub Show()
   On Error GoTo Show_Error

   If GUIvisible Then Exit Sub
   
   If gOptionsForm Is Nothing Then Set gOptionsForm = New frmTabStripOptions
   Load gOptionsForm
   If gLogging Then Log "Addin-In Started with the IDE?: " & gLaunchedAtIDEStartup
   
   CreateToolbar
   InitGlobalIDEVariables
   
   If gGuiForm Is Nothing Then Set gGuiForm = New frmTabStrip
   Load gGuiForm
   gGuiForm.Init
   
   GUIvisible = True
   
   If gLogging Then Log "UI is now visible - " & IIf(gIsSDI, "SDI", "MDI") & " mode"

   Exit Sub

Show_Error:
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Show of Connect"
End Sub

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
   On Error GoTo error_handler

   ' Instanciar a variável de controlo global do IDE
   Set gVBInstance = Application
   
   ' Ativar os eventos globais estáveis de Projetos
   Set VBProjEvents = gVBInstance.Events.VBProjectsEvents
   
   ' Chamar a rotina de mapeamento seguro do projeto ativo
   HookComponentEvents
   
   gIsSDI = (gVBInstance.DisplayModel = vbext_dm_SDI)
   
   If ConnectMode = ext_cm_External Then
      Show
   Else
      Set mcbMenuCommandBar = AddToAddInCommandBar("Tab-Strip Options...")
      Set mcbLineNumbersAdd = AddToAddInCommandBar("Add Line Numbers")
      Set mcbLineNumbersRemove = AddToAddInCommandBar("Remove Line Numbers")
      Set MenuHandler = gVBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
      Set LineNumAddHandler = gVBInstance.Events.CommandBarEvents(mcbLineNumbersAdd)
      Set LineNumRemoveHandler = gVBInstance.Events.CommandBarEvents(mcbLineNumbersRemove)
   End If
  
   If ConnectMode = ext_cm_AfterStartup Then
      Show
   Else
      gLaunchedAtIDEStartup = True
   End If
  
   Exit Sub
    
error_handler:
   MsgBox "AddinInstance_OnConnection: " & Err.Description
End Sub

Private Sub AddinInstance_OnStartupComplete(custom() As Variant)
   Show
   ' Re-ligar eventos dinâmicos após conclusão de carregamento do IDE
   HookComponentEvents
End Sub

' ====================================================================
' ROTINA AUXILIAR PARA RECONECTAR OS EVENTOS DOS COMPONENTES
' ====================================================================
Private Sub HookComponentEvents()
    On Error Resume Next
    Set VBCompEvents = Nothing
    If Not gVBInstance Is Nothing Then
        If Not gVBInstance.ActiveVBProject Is Nothing Then
            Set VBCompEvents = gVBInstance.Events.VBComponentsEvents(gVBInstance.ActiveVBProject)
        End If
    End If
End Sub

Private Sub VBProjEvents_ItemActivated(ByVal VBProject As VBIDE.VBProject)
    HookComponentEvents
End Sub

Private Sub VBProjEvents_ItemAdded(ByVal VBProject As VBIDE.VBProject)
    HookComponentEvents
End Sub

' ====================================================================
' clean\delete the setted objects
' ====================================================================
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
   On Error GoTo AddinInstance_OnDisconnection_Error

   If GUIvisible Then
       SaveSetting App.Title, "Settings", "DisplayOnConnect", "1"
       GUIvisible = False
   Else
       SaveSetting App.Title, "Settings", "DisplayOnConnect", "1"
   End If
    
   ' 1. Destruir referências de Eventos com o IDE
   Set VBCompEvents = Nothing
   Set VBProjEvents = Nothing
   Set MenuHandler = Nothing
   Set LineNumAddHandler = Nothing
   Set LineNumRemoveHandler = Nothing
   
   ' 2. Remover controlos físicos criados na barra do menu Add-Ins
   mcbMenuCommandBar.Delete
   mcbLineNumbersAdd.Delete
   mcbLineNumbersRemove.Delete
   
   ' 3. Aniquilar os objetos dos botões em si
   Set mcbMenuCommandBar = Nothing
   Set mcbLineNumbersAdd = Nothing
   Set mcbLineNumbersRemove = Nothing
    
   ' 4. CORREÇÃO CRÍTICA: Descarregar e aniquilar INSTÂNCIAS DE FORMS criados com Set
   Unload gGuiForm
   Set gGuiForm = Nothing
   
   Unload gOptionsForm
   Set gOptionsForm = Nothing
   
   ' 5. Eliminar a barra de ferramentas personalizada
   DeleteToolBar
   
   ' 6. Libertar o ponteiro raiz do VB6 IDE
   Set gVBInstance = Nothing

   Exit Sub

AddinInstance_OnDisconnection_Error:
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in AddinInstance_OnDisconnection"
End Sub

Private Sub MenuHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
   If GUIvisible Then gOptionsForm.Show
End Sub

' with a new form we change the AutoRedraw to true and ScaleMode to Pixels:
Private Sub VBCompEvents_ItemAdded(ByVal VBComponent As VBIDE.VBComponent)
   On Error Resume Next
        
   If VBComponent.Type = vbext_ct_VBForm Then
       Dim oDesigner As Object
       Set oDesigner = VBComponent.Designer
       
       Dim oProp As VBIDE.Property
       
       Set oProp = VBComponent.Properties("AutoRedraw")
       If Not oProp Is Nothing Then oProp.Value = True
       
       Set oProp = VBComponent.Properties("ScaleMode")
       If Not oProp Is Nothing Then oProp.Value = CInt(3) ' 3 = vbPixels
   End If
End Sub

'Adding Tabs with a toolbar and maximize the Window:
Private Function AddToAddInCommandBar(sCaption As String) As Office.CommandBarControl
Dim cbMenuCommandBar As Office.CommandBarControl
Dim cbMenu As Office.CommandBar
  
   On Error GoTo ErrHandler
   
   Set cbMenu = gVBInstance.CommandBars("Add-Ins")
   If cbMenu Is Nothing Then Exit Function
   
   Set cbMenuCommandBar = cbMenu.Controls.Add(1)
   cbMenuCommandBar.Caption = sCaption
   
   Set AddToAddInCommandBar = cbMenuCommandBar
   
   Exit Function
    
ErrHandler:
End Function

Private Sub CreateToolbar()
Dim i As Long

   On Error GoTo CreateToolbar_Error

   DeleteToolBar
   gVBInstance.CommandBars.Add TOOLBARNAME, msoBarTop, , True

   For i = 0 To Screen.Width / Screen.TwipsPerPixelX / 550
      AddButton
   Next i

   With gVBInstance.CommandBars(TOOLBARNAME)
      .Visible = True
      .Protection = msoBarNoMove
      .Height = TOOLBAR_HEIGHT
   End With

   On Error GoTo 0
   Exit Sub

CreateToolbar_Error:
   If Err.Number = -2147467259 And InStr(Err.Description, "'~'") > 0 Then
      Resume Next
   Else
      MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateToolbar of Designer Connect"
   End If
End Sub

Private Sub AddButton()
   On Error GoTo ErrHandler
   With gVBInstance.CommandBars(TOOLBARNAME).Controls.Add
      .Height = TOOLBAR_HEIGHT - 2
      .Style = msoButtonCaption
      .Width = 550
      .Enabled = False
   End With
   MaximizeCodeAndDesignWindows
   
   If Not gVBInstance.ActiveCodePane Is Nothing Then
       NumberCodePane gVBInstance.ActiveCodePane.CodeModule
   End If

ErrHandler:
End Sub

Private Sub DeleteToolBar()
   On Error Resume Next
   gVBInstance.CommandBars(TOOLBARNAME).Delete
End Sub

Private Sub MaximizeCodeAndDesignWindows()
   On Error Resume Next

   Dim CP As VBIDE.CodePane
   For Each CP In gVBInstance.CodePanes
       If Not CP Is Nothing Then
           If CP.Window.Visible Then
               CP.Window.WindowState = vbext_ws_Maximize
           End If
           
           If Not CP.CodeModule Is Nothing Then
               NumberCodePane CP.CodeModule
           End If
       End If
   Next CP

   Dim VBComp As VBIDE.VBComponent
   For Each VBComp In gVBInstance.ActiveVBProject.VBComponents
       If VBComp.Type = vbext_ct_VBForm Then
           If VBComp.HasOpenDesigner Then
               VBComp.DesignerWindow.WindowState = vbext_ws_Maximize
           End If
       End If
   Next VBComp
End Sub

' ================================================
' Adding Lines Numbers on VB6 IDE
' ================================================

Private Sub LineNumAddHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
   AddLineNumbers
End Sub

Private Sub LineNumRemoveHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
   RemoveLineNumbers
End Sub

Private Sub NumberCodePane(oModule As VBIDE.CodeModule)
   Dim i          As Long
   Dim sLine      As String
   Dim sTrim      As String
   Dim bContinues As Boolean
   Dim bInBlock   As Boolean
   Dim bInProc    As Boolean
   Dim bIsLabel   As Boolean
   Dim bIsCase    As Boolean

   On Error Resume Next
   If oModule Is Nothing Then Exit Sub

   bContinues = False
   bInBlock = False
   bInProc = False

   For i = 1 To oModule.CountOfLines
       sLine = oModule.Lines(i, 1)
       
       If LineHasNumber(sLine) Then
           Dim posCol As Integer
           posCol = InStr(sLine, ":")
           sTrim = Trim$(Mid$(sLine, posCol + 1))
       Else
           sTrim = Trim$(sLine)
       End If

       bIsCase = (Left$(UCase$(sTrim), 5) = "CASE ")

       If Right$(sTrim, 1) = ":" _
          And Not bIsCase _
          And InStr(Replace(sTrim, " ", ""), ":") = Len(Replace(sTrim, " ", "")) Then
           bIsLabel = True
       Else
           bIsLabel = False
       End If

       If Left$(sTrim, 5) = "Type " Or Left$(sTrim, 13) = "Private Type " Or _
          Left$(sTrim, 12) = "Public Type " Or Left$(sTrim, 5) = "Enum " Or _
          Left$(sTrim, 13) = "Private Enum " Or Left$(sTrim, 12) = "Public Enum " Then
           bInBlock = True
       End If

       If (InStr(sTrim, "Sub ") > 0 Or InStr(sTrim, "Function ") > 0 Or InStr(sTrim, "Property ") > 0) _
          And InStr(sTrim, "Declare ") = 0 _
          And Left$(sTrim, 1) <> "'" And Left$(UCase$(sTrim), 4) <> "REM " Then
           bInProc = True
       End If

       If bInProc And Not bInBlock And Not bContinues And Not bIsLabel And Not bIsCase Then
           If Not IsDeclarationLine(sTrim) Then
               If Not LineHasNumber(sLine) Then
                   oModule.ReplaceLine i, CStr(i) & ": " & sLine
               End If
           End If
       End If

       bContinues = (Right$(sTrim, 1) = "_")

       If sTrim = "End Type" Or sTrim = "End Enum" Then bInBlock = False
       If sTrim = "End Sub" Or sTrim = "End Function" Or sTrim = "End Property" Then bInProc = False
   Next i
End Sub

Private Sub AddLineNumbers()
   Dim oPane   As VBIDE.CodePane
   Dim oModule As VBIDE.CodeModule

   On Error GoTo ErrHandler

   Set oPane = gVBInstance.ActiveCodePane
   If oPane Is Nothing Then
       MsgBox "Abre um Code Window primeiro!", vbInformation
       Exit Sub
   End If

   Set oModule = oPane.CodeModule
   NumberCodePane oModule

   Exit Sub

ErrHandler:
   MsgBox "Erro: " & Err.Description
End Sub

Private Sub RemoveLineNumbers()
   Dim oPane   As VBIDE.CodePane
   Dim oModule As VBIDE.CodeModule
   Dim i       As Long
   Dim sLine   As String
   Dim Pos     As Integer

   On Error GoTo ErrHandler

   Set oPane = gVBInstance.ActiveCodePane
   If oPane Is Nothing Then Exit Sub

   Set oModule = oPane.CodeModule

   For i = 1 To oModule.CountOfLines
       sLine = oModule.Lines(i, 1)
       If LineHasNumber(sLine) Then
           Pos = InStr(sLine, ":")
           oModule.ReplaceLine i, Mid$(sLine, Pos + 2)
       End If
   Next i

   Exit Sub

ErrHandler:
   MsgBox "Erro: " & Err.Description
End Sub

Private Function IsDeclarationLine(sLine As String) As Boolean
   Dim s As String
   s = Trim$(sLine)

   If Len(s) = 0 Then IsDeclarationLine = True: Exit Function
   If Right$(s, 1) = "_" Then IsDeclarationLine = True: Exit Function
   If Left$(s, 1) = "," Then IsDeclarationLine = True: Exit Function
   If Left$(s, 1) = ")" Then IsDeclarationLine = True: Exit Function
   If Left$(s, 1) = "(" Then IsDeclarationLine = True: Exit Function
   If Left$(s, 1) = "'" Then IsDeclarationLine = True: Exit Function
   If Left$(UCase$(s), 4) = "REM " Then IsDeclarationLine = True: Exit Function

   Dim keywords() As String
   keywords = Split( _
       "Sub ,Function ,Property ,End Sub,End Function,End Property," & _
       "Private Sub,Public Sub,Friend Sub," & _
       "Private Function,Public Function,Friend Function," & _
       "Private Property,Public Property,Friend Property," & _
       "Dim ,Private ,Public ,Friend ,Static ," & _
       "Option ,Const ,Type ,End Type," & _
       "Implements ,Event ,Event ,Enum ,End Enum," & _
       "Attribute ,#If,#Else,#ElseIf,#End,#Const," & _
       "Declare ,ReDim ", ",")

   Dim i As Integer
   For i = 0 To UBound(keywords)
       If Left$(s, Len(keywords(i))) = keywords(i) Then
           IsDeclarationLine = True
           Exit Function
       End If
   Next i
End Function

Private Function LineHasNumber(sLine As String) As Boolean
   Dim s   As String
   Dim Pos As Integer
   s = Trim$(sLine)
   Pos = InStr(s, ":")
   If Pos > 1 Then
       LineHasNumber = IsNumeric(Left$(s, Pos - 1))
   End If
End Function

tab addin on projects: https://www.vbforums.com/showthread....ssing-hooking)
i edited for maxmize it
i'm sharing some code