увеличение размеров выпадающих списков Опции

[Егор]

Код

Option Explicit

Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" ( _
        ByVal hWndParent As Long, _
        ByVal hWndChildAfter As Long, _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String)

Private Declare Function MoveWindow Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, _
        ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long
        
Private Declare Function GetClientRect& Lib "user32" ( _
        ByVal hwnd As Long, _
        lpRect As RECT)
        
Private Type RECT   '  16  Bytes
     left As Long
     top As Long
     right As Long
     bottom As Long
End Type

Sub ComboBoxResize() 'изменение размера выпадающего списка слоев, цветов, типов линий
    Dim MyH As Long
    MyH = AcadApplication.HWND32
  
    Dim HW As Long
    HW = 0
    Dim col_AfxControlBar As New Collection
    Do
        HW = FindWindowEx(MyH, HW, "AfxControlBar", vbNullString)
        If HW > 0 Then col_AfxControlBar.Add HW
    Loop While HW > 0

    Dim it As Variant
    Dim col_AfxWnd As New Collection
    For Each it In col_AfxControlBar
        HW = 0
        Do
'            HW = FindWindowEx(it, HW, "AfxWnd70", vbNullString)' для 2007
            HW = FindWindowEx(it, HW, "AfxWnd100u", vbNullString)' для 2013
            If HW > 0 Then col_AfxWnd.Add HW
        Loop While HW > 0
    Next it

    Dim col_Toolbar As New Collection
    For Each it In col_AfxWnd
        HW = 0
        Do
            HW = FindWindowEx(it, HW, "ToolbarWindow32", vbNullString)
            If HW > 0 Then col_Toolbar.Add HW
        Loop While HW > 0
    Next it

    Dim re As Long
    For Each it In col_Toolbar
        HW = 0
        Do
            HW = FindWindowEx(it, HW, "ComboBox", vbNullString)
            If HW > 0 Then
                Dim r As RECT
                re = GetClientRect(HW, r)
                If re <> 0 Then
                    Dim res As Long
                    res = MoveWindow(HW, 0, 0, r.right, 900, 1)
                End If
            End If
        Loop While HW > 0
    Next it

End Sub

Сообщение отредактировал Егор - 7.6.2013, 14:33

Прикрепленные файлы

 _________.png ( 11,71 килобайт ) Кол-во скачиваний: 2

 

[Егор]

Код

Option Explicit

Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" ( _
        ByVal hWndParent As Long, _
        ByVal hWndChildAfter As Long, _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String)

Private Declare Function MoveWindow Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, _
        ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long
        
Private Declare Function GetClientRect& Lib "user32" ( _
        ByVal hwnd As Long, _
        lpRect As RECT)
        
Private Type RECT   '  16  Bytes
     left As Long
     top As Long
     right As Long
     bottom As Long
End Type

Sub ComboBoxResize() 'изменение размера выпадающего списка слоев, цветов, типов линий
    Dim MyH As Long
    MyH = AcadApplication.HWND32
  
    Dim HW As Long
    HW = 0
    Dim col_AfxControlBar As New Collection
    Do
        HW = FindWindowEx(MyH, HW, "AfxControlBar", vbNullString)
        If HW > 0 Then col_AfxControlBar.Add HW
    Loop While HW > 0

    Dim it As Variant
    Dim col_AfxWnd As New Collection
    For Each it In col_AfxControlBar
        HW = 0
        Do
'            HW = FindWindowEx(it, HW, "AfxWnd70", vbNullString)' для 2007
            HW = FindWindowEx(it, HW, "AfxWnd100u", vbNullString)' для 2013
            If HW > 0 Then col_AfxWnd.Add HW
        Loop While HW > 0
    Next it

    Dim col_Toolbar As New Collection
    For Each it In col_AfxWnd
        HW = 0
        Do
            HW = FindWindowEx(it, HW, "ToolbarWindow32", vbNullString)
            If HW > 0 Then col_Toolbar.Add HW
        Loop While HW > 0
    Next it

    Dim re As Long
    For Each it In col_Toolbar
        HW = 0
        Do
            HW = FindWindowEx(it, HW, "ComboBox", vbNullString)
            If HW > 0 Then
                Dim r As RECT
                re = GetClientRect(HW, r)
                If re <> 0 Then
                    Dim res As Long
                    res = MoveWindow(HW, 0, 0, r.right, 900, 1)
                End If
            End If
        Loop While HW > 0
    Next it

End Sub

Сообщение отредактировал Егор - 7.6.2013, 14:33

Прикрепленные файлы

 _________.png ( 11,71 килобайт ) Кол-во скачиваний: 2

 

[Sotochnik]

Уж написал бы как этим пользоваться.
Я попытался запустить и no function definition: _

[Егор]

1. в акаде открываем редактор VB (в классическом интерфейсе меню "Сервис-Макросы-Редактор VB, в интерфейсе "рисование и аннотации" вкладка "Управление-Редактор VB" или ALT+F11)

2. меню "Insert - Module"

3. копи-паста в этот модуль(рис.3)

4.сохраняем проект (в редакторе VB меню "File-Save") и добавляем его в автозагрузку (в акаде меню "Сервис(Управление)-Приложения, в разделе "автозагрузка" кнопка "Приложения-Добавить")

5. на панели инструментов создаем кнопку и присваем макрос "^C^C_vbarun ComboBoxResize"

видеоинструкция на youtube
скачать видеоинструкцию (размер 10 метров)

Сообщение отредактировал Егор - 25.6.2013, 20:37