[Цитировать]

    motorboy
  • 41869
  • Стаж: 8 дней
  • Сообщений: 9
  • Репутация:1

    [+] [-]
Простой лаунчер для запуска портативных программ.
Поддерживает Drag&Drop. Позволяет запускать программы от имени Администратора и от имени Системы с правами TrustedInstaller.
Если запускать программу удерживая клавишу Shift она запустится от имени Администратора если удерживать CTRL+Shift запустится от имени Системы.
Для скрытия и показа окна лаунчера используйте комбинацию клавиш CTRL+пробел.
Позволяет добавлять программы перетаскиванием из проводника Windows. Если вы перетащите файл на правую панель, программа добавится в текущую выделенную категорию.
Если перетащите на левую панель, программа добавится в ту категорию на которую вы её бросите.
Также чтобы сменить категорию перетащите программы из правой панели на категорию в левую панель.
Категории можно сортировать перетаскиванием. Программы сортируется автоматически по алфавиту.
Также вы можете добавлять системные утилиты Windows. Но это можно делать только вручную. Выберите "Добавить программу" и для например "Панели управления" впишите "Control". Утилита сама найдёт нужный файл и запустит его.
Если есть идеи что можно добавить в лаунчер - пишите в комментариях. Постараюсь сделать все на что хватит знаний.
Ссылка для скачивания https://drive.google.com/file/d/19wA_Ie3hNti85DUuSM...w?usp=drive_link
Скриншоты


Последний раз редактировалось: motorboy (2026-03-08 02:55), всего редактировалось 6 раз(а)

[Цитировать]

    Stranger13
  • 31966
  • Стаж: 3 года 1 месяц
  • Сообщений: 17
  • Репутация:0

    [+] [-]
motorboy поюзал лаунчер,начало хорошее! внесу немного своих предложений к уже озвученным другими форумчанами:
-расширить выбор в настройки "после запуска программы" (свернуть в трей, спрятать слева или справа за границы экрана для примера как TBLauncher);
-сделать запуск программ по одиночному щелчку мышки а не по двойному а описание программ перенести в всплывающее окно при наведении курсора на нужную прогу на ули в контекстное меню проги добавить пункт "описание". все таки это лаунчер портативок а не WPI;
-раз уж есть в редакторе/добавлении программы "параметры командной строки", не плохо было б тогда и в контекстное меню внести пункт запуск без ключей, для гибкости запуска приложений;
-присоединюсь к предложениям форумчан сделать в лаунчере последовательный запуск программ группы с такими предложениями:
1. добавить в контекстное меню группы пункт "запустить программы поочередно" - удобно использовать на живой системе для авто установки нужного набора софта т.д.
2. ну а для установки софта при использовании лаунчера в заливках или автоустановки добавить возможность запуска лаунчера с ключем, к примеру -auto "название группы";
-в настройки редактирования программы добавить функционал выбора отображения программы при запуске лаунчера (отображать в PE системах,на живой системе, отображение по разрядностям систем) для гибкой настройки софта чтоб лишние проги не отображались в списках при запуске на различных системах.
Такие вот предложения!

[Цитировать]

    motorboy
  • 41869
  • Стаж: 8 дней
  • Сообщений: 9
  • Репутация:1

    [+] [-]
106598motorboy поюзал лаунчер,начало хорошее! внесу немного своих предложений к уже озвученным другими форумчанами:
-расширить выбор в настройки "после запуска программы" (свернуть в трей, спрятать слева или справа за границы экрана для примера как TBLauncher);
-сделать запуск программ по одиночному щелчку мышки а не по двойному а описание программ перенести в всплывающее окно при наведении курсора на нужную прогу на ули в контекстное меню проги добавить пункт "описание". все таки это лаунчер портативок а не WPI;
-раз уж есть в редакторе/добавлении программы "параметры командной строки", не плохо было б тогда и в контекстное меню внести пункт запуск без ключей, для гибкости запуска приложений;
-присоединюсь к предложениям форумчан сделать в лаунчере последовательный запуск программ группы с такими предложениями:
1. добавить в контекстное меню группы пункт "запустить программы поочередно" - удобно использовать на живой системе для авто установки нужного набора софта т.д.
2. ну а для установки софта при использовании лаунчера в заливках или автоустановки добавить возможность запуска лаунчера с ключем, к примеру -auto "название группы";
-в настройки редактирования программы добавить функционал выбора отображения программы при запуске лаунчера (отображать в PE системах,на живой системе, отображение по разрядностям систем) для гибкой настройки софта чтоб лишние проги не отображались в списках при запуске на различных системах.
Такие вот предложения!
Свертывание в трей - сделаю.
Запуск без ключей - сделаю.
Запуск программ по одиночному щелчку - сделаю.
Описание. Если вам не нужно видеть описание - просто уменьшите поле описания вниз до упора и оно не будет отображаться. Сделать всплывающее описание по наведении мыши на прогу сделать не получится. Хотя возможно я что то придумаю. Через Winapi например.
Отображать в PE системах, на живой системе, отображение по разрядностям систем - немного сложнее, но думаю что смогу добавить такой функционал.
Прятать за границы экрана - Вы имеете в виду показ окна лаунчера при наведение мыши к правому\левому краю экрана?
Последовательный запуск программ из группы - могу сделать. Но это же лаунчер а не WPI ab . Может лучше сделать отдельную утилиту для установки софта? Но если нужен такой фунционал в лаунчере то сделаю.

[Цитировать]

    AZJIO
  • 17953
  • Стаж: 8 лет
  • Сообщений: 1355
  • Репутация:127

    [+] [-]
106599Свертывание в трей - сделаю.
При такой фиче удобно будет иметь горячую клавишу для показа окна.

[Цитировать]

    Ander_73
  • 15549
  • Стаж: 9 лет 1 месяц
  • Сообщений: 4195
  • Репутация:127

    [+] [-]
106599Но это же лаунчер а не WPI
Да, у нас смешались понятия bw

[Цитировать]

    Stranger13
  • 31966
  • Стаж: 3 года 1 месяц
  • Сообщений: 17
  • Репутация:0

    [+] [-]
Прятать за границы экрана - Вы имеете в виду показ окна лаунчера при наведение мыши к правому\левому краю экрана?
как вариант можно и так но в TBLauncher он при свертывание остается торчать сбоку полоска с названием, и при нажатии на нее открывается лаунчер, своего рода закладка торчит.
И конечно же как пердложил
При такой фиче удобно будет иметь горячую клавишу для показа окна.
И если возможно при возможности сделать шрифт увеличивать с ярлыками в панелях, не критично но для удобства не помешало бы.

[Цитировать]

    motorboy
  • 41869
  • Стаж: 8 дней
  • Сообщений: 9
  • Репутация:1

    [+] [-]
Свертывание за границы экрана сделать не получится... Не знаю как это реализовать.
Сделать шрифт в панелях больше - без проблем. А вот с иконками сложнее. Они ограничены размером 16х16. Разве что AZJIO подскажет как это сделать в Pure Basic.

[Цитировать]

    xnik
  • 19473
  • Стаж: 7 лет 4 месяца
  • Сообщений: 509
  • Репутация:12

    [+] [-]
  • Откуда: СССР
Свертывание в трей
Возможно ли реализовать меню с Hover? как у PStart

[Цитировать]

    AZJIO
  • 17953
  • Стаж: 8 лет
  • Сообщений: 1355
  • Репутация:127

    [+] [-]
Они ограничены размером 16х16. Разве что AZJIO подскажет как это сделать в Pure Basic.
If LargeIcon ; 32
  ExtractIconEx_(path, IconIndex, @hIcon, 0, 1) ; 32
Else
  ExtractIconEx_(path, IconIndex, 0, @hIcon, 1) ; 16
EndIf
При закрытии программы обязательно очистить память от иконок. То есть их дескрипторы надо хранить до конца работы программы.
Не помню с какой версии Windows можно указать любой размер, но он будет выполняться масштабированием.
Разве что AZJIO подскажет как это сделать в Pure Basic
Стало интересно проверить есть ли слово "PureBasic" в исполняемых файлах скомпилированных на PureBasic. Открыл HxD, кинул туда бинарник, поиск в режиме юникода, показал вхождение, аналогично и в моих файлах (только PureWeb). Как я понимаю там ещё есть классы и слово "Pure" ещё встречается PureWeb и PureSysTray, PureSplitter, ну и если в "О программе" указано, то в бинарнике точно будет. В старых версиях PureBasic ещё и путь компиляции попадал в бинарник. Обилие констант затесалось, поиск по префиксам "PB_".

[Цитировать]

    motorboy
  • 41869
  • Стаж: 8 дней
  • Сообщений: 9
  • Репутация:1

    [+] [-]
AZJIO Я имел ввиду что при добавлении элемента в ListIconGadget иконки любого размера уменьшаются до размера 16х16 пикселей. Это указано в описании гаджета. Я загружаю иконки в размере 32х32. Мне так и не удалось сделать их больше в гаджете ac.
xnik Думаю что смогу реализовать меню с Hover.

[Цитировать]

    AZJIO
  • 17953
  • Стаж: 8 лет
  • Сообщений: 1355
  • Репутация:127

    [+] [-]
106607ListIconGadget
В справке
SetGadgetAttribute(): Со следующим атрибутом:
#PB_ListIcon_DisplayMode : Изменяет режим отображения Гаджета. Может быть одной из следующих констант (только для Windows):
#PB_ListIcon_LargeIcon: Режим больших иконок
#PB_ListIcon_SmallIcon: Режим малых иконок
#PB_ListIcon_List : Режим списка
#PB_ListIcon_Report : Режим таблицы (столбцы, режим по умолчанию)
Но вот только тут не список, а горизонтальный вид плиток.
Define hIcon
; Define NewList hIcons()
If OpenWindow(0, 100, 100, 800, 600, "Пример Гаджета Список со значками", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(0, 5, 5, 790, 590, "Name", 100, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
  AddGadgetColumn(0, 1, "Address", 250)
  ExtractIconEx_("Shell32.dll", 3, @hIcon, 0, 1)        ; 32
  SetGadgetAttribute(0, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
  For i = 0 To 11
    AddGadgetItem(0, -1, "ага " + Str(i), hIcon)
  Next
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
  DestroyIcon_(hIcon)
EndIf
Открыл тему с вопросом на офиц. сайте.

[Цитировать]

    motorboy
  • 41869
  • Стаж: 8 дней
  • Сообщений: 9
  • Репутация:1

    [+] [-]
Спасибо за пример. Но для лаунчера нужен вид не плиткой а списком. Что ж возможно я что то придумаю. Через Winapi.

[Цитировать]

    AZJIO
  • 17953
  • Стаж: 8 лет
  • Сообщений: 1355
  • Репутация:127

    [+] [-]
motorboy
Вот пример рисование пункта, но чтобы высота пукнта увеличилась нужно увеличить шрифт, а уж рисовать пункт можно любы другим шрифтом.
Global hIcon = 0
Global hIcon2 = 0
ExtractIconEx_("Shell32.dll", 131, @hIcon, 0, 1)
ExtractIconEx_("Shell32.dll", 3, @hIcon2, 0, 1)
; ExtractIconEx_("C:\ProgramData\PureBasic\Examples\Sources\Data\CdPlayer.ico", 0, 0, @hIcon, 1)
; Debug hIcon
Global g_tRect.RECT
With g_tRect
  \left = 0
  \top = 0
  \right = 16
  \bottom = 16
EndWith
Global hDC, MemDC
Global hOldBMP
Procedure CreateBMP()
  Protected hBrush, MemBMP, Rect.RECT
  MemBMP = CreateCompatibleBitmap_(hDC, 16, 16)
  hOldBMP = SelectObject_(MemDC, MemBMP)
  hBrush = CreateSolidBrush_($0088FF)
  SelectObject_(MemDC, hBrush)
  With Rect
    \left = 0
    \right = 16
    \top = 0
    \bottom = 16
  EndWith
  FillRect_(MemDC, Rect, hBrush)
  DeleteObject_(hBrush)
  DeleteObject_(MemBMP)
EndProcedure
Procedure LB_CreateSolidBitmap(hWnd, iColor, iWidth, iHeight, bRGB = 1)
;   Protected Error_FillRect = 0
  Protected hBrush
  Protected hDC = GetDC_(hWnd)
  Protected hDestDC = CreateCompatibleDC_(hDC)
  Protected hBitmap = CreateCompatibleBitmap_(hDC, iWidth, iHeight)
  Protected hOld = SelectObject_(hDestDC, hBitmap)
  Protected tRect.RECT
  With tRect
    \left = 0
    \top = 0
    \right = iWidth
    \bottom = iHeight
  EndWith
  If bRGB
    iColor = ((iColor & $00FF00) | ((iColor & $0000FF) << 16) | ((iColor & $FF0000) >> 16))
  EndIf
  hBrush = CreateSolidBrush_(iColor)
  FillRect_(hDestDC, tRect, hBrush)
;   If Error_FillRect
;     DeleteObject_(hBitmap)
;     hBitmap = 0
;   EndIf
  DeleteObject_(hBrush)
  ReleaseDC_(hWnd, hDC)
  SelectObject_(hDestDC, hOld)
  DeleteDC_(hDestDC)
  If Not hBitmap
    ProcedureReturn 0
  EndIf
  ProcedureReturn hBitmap
EndProcedure
#LV0 = 0
Global BackColor = $00FF00
Global ForeColor = $FF0000
Global BackColorHeader = $eeffee
Global ForeColorHeader = $2277ff
Global BorderColor = $0
Global HightLightBrush = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
; Global HightLightBrush = CreateSolidBrush_($ff3926)
Global BackColorBrush = CreateSolidBrush_(BackColor)
Global BackColorBrushHeader = CreateSolidBrush_(BackColorHeader)
Global frmMain_References, hHeader
Global Dim Colors(1)
Colors(0) = $8080FF
Colors(1) = ForeColor
; ---------------------------------------------------------------------------------------------------------------------
Procedure GetCharWidth(gad, c$)
  ProcedureReturn SendMessage_(gad, #LVM_GETSTRINGWIDTH, 0, @c$)
EndProcedure
; это подкрашивает части пункта в ListView
Procedure Callback_Win(hwnd, msg, wParam, lParam)
  Protected Result, *nmhdr.NMHDR, *lvCD.NMLVCUSTOMDRAW, subItemRect.RECT, *DrawItem.DRAWITEMSTRUCT, Buffer.s
  Protected *pnmcd.NMCUSTOMDRAW, hdi.hd_item
  Protected thisRow, thisCol, idx
  Protected t$, text$
  Protected nNotifyCode
  Protected *NMITEM.NMITEMACTIVATE
  Protected SelectedLine
  Result = #PB_ProcessPureBasicEvents
  ;;Dim LVColor(0)
  Select msg
    Case #WM_NCDESTROY ; удаление кистей, после закрытия программы
      DeleteObject_(HightLightBrush)
      DeleteObject_(BackColorBrush)
      DeleteObject_(BackColorBrushHeader)
    Case #WM_NOTIFY
      ; стандартные структуры ListView для перерисовки
      *nmhdr.NMHDR = lParam
      *lvCD.NMLVCUSTOMDRAW = lParam
      *NMITEM.NMITEMACTIVATE = lParam
;       если гаджет #LV0 и он пользовательская рисовка, то
      If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#LV0) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
        Select *lvCD\nmcd\dwDrawStage
          Case #CDDS_PREPAINT
            Result = #CDRF_NOTIFYITEMDRAW
          Case #CDDS_ITEMPREPAINT
            Result = #CDRF_NOTIFYSUBITEMDRAW;
          Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM ; перерисовка пункта
            thisRow = *lvCD\nmcd\dwItemSpec ; строку
            thisCol = *lvCD\iSubItem ; колонка
            If thisCol =0 ; если колонка 0, то
              ; Определяет прямоугольник для текста
              subItemRect.RECT\left = #LVIR_BOUNDS ; #LVIR_ICON, #LVIR_LABEL
              subItemRect.RECT\top = *lvCD\iSubItem ; iSubItem
              ; Определяет прямоугольник подпункт
              SendMessage_(GadgetID(#LV0), #LVM_GETSUBITEMRECT, thisRow, @subItemRect) ; в итоге переписываем структуру прямоугольника
;               subItemRect.RECT\left = #LVIR_ICON
;               SendMessage_(GadgetID(#LV0), #LVM_GETSUBITEMRECT, thisRow, @subItemRect) ; в итоге переписываем структуру прямоугольника
;               subItemRect.RECT\left + 160
              text$ = GetGadgetItemText(#LV0, thisRow, thisCol) ; получаем текст пункта по строке и колонке
              If GetGadgetState(#LV0) = thisRow ; если индекс выделенного элемента равен пункту, то
                ; выделенный пункт, перекрашиваем его фон
                FillRect_(*lvCD\nmcd\hdc, subItemRect, HightLightBrush)
                SetTextColor_(*lvCD\nmcd\hdc, $00FFFF) ;
              Else
                ; не выделенный пункт, перекрашиваем его другим фоном
                FillRect_(*lvCD\nmcd\hdc, subItemRect, BackColorBrushHeader)
                SetTextColor_(*lvCD\nmcd\hdc, ForeColor) ;
              EndIf
              CopyStructure(@subItemRect, @g_tRect, RECT)
;               Debug subItemRect\left
;               Debug subItemRect\right
;               Debug subItemRect\top
;               Debug subItemRect\bottom
;               With g_tRect
;                 \bottom = \top + 16
;               EndWith
              InflateRect_(subItemRect, -46, 0) ; изменяет левую границу прямоугольника на 8 пиксел
;               SetBkColor_(*lvCD\nmcd\hdc, BackColor)  ; фон всегда одинаковый, он вообще не нужен
              DrawText_(*lvCD\nmcd\hdc, text$, -1, subItemRect, #DT_END_ELLIPSIS | #DT_VCENTER | #DT_SINGLELINE) ; рисуем текст
;               DrawIcon_(*lvCD\nmcd\hdc, g_tRect\left, g_tRect\top, hIcon)
                  ;LB_CreateSolidBitmap(hWnd, iColor, iWidth, iHeight, bRGB = 1)
              With g_tRect
                \left + 0
                \right = \left + 12
                \top + 6
                \bottom = \top + 12
              EndWith
;               DrawEdge_(*lvCD\nmcd\hdc, @g_tRect, #EDGE_SUNKEN, #BF_RECT)
;               FillRect_(*lvCD\nmcd\hdc, g_tRect, BackColorBrush)
;               DrawIcon_(*lvCD\nmcd\hdc, subItemRect\left, subItemRect\top, hIcon)
              If thisRow % 2
                DrawIconEx_(*lvCD\nmcd\hdc, g_tRect\left, g_tRect\top, hIcon, 32, 32, 0, 0, #DI_NORMAL)
              Else
                DrawIconEx_(*lvCD\nmcd\hdc, g_tRect\left, g_tRect\top, hIcon2, 32, 32, 0, 0, #DI_NORMAL)
              EndIf
;               With g_tRect
;                 BitBlt_(*lvCD\nmcd\hdc, \left, \top, \right - \left, \bottom - \top, MemDC, 0, 0, #SRCCOPY)
;               EndWith
              Result = #CDRF_SKIPDEFAULT
            Else
              Result = #CDRF_DODEFAULT
            EndIf
        EndSelect
      EndIf
  EndSelect
  ProcedureReturn Result
EndProcedure
; это подкрашивает заголовок ListView
Procedure Callback_Header(hWnd, Message, wParam, lParam)
  Protected *Header.HD_NOTIFY, SelectedLine, *lvCD.NMLVCUSTOMDRAW
  Protected *nmhdr.NMHDR, text$, *pnmcd.NMCUSTOMDRAW, hdi.hd_item
  Protected rc2.RECT, hDC
  Protected Result = CallWindowProc_(frmMain_References, hWnd, Message, wParam, lParam)
  *Header = lParam
  *nmhdr = lParam
  *lvCD = lParam
  Select Message
    Case #WM_NOTIFY
      Select *Header\hdr\code
        Case #NM_CUSTOMDRAW
          If *nmhdr\hwndFrom = hHeader
            *pnmcd.NMCUSTOMDRAW = lParam
            Select *pnmcd\dwDrawStage
              Case #CDDS_PREPAINT
                result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                text$ = GetGadgetItemText(GetDlgCtrlID_(hWnd), -1, *pnmcd\dwItemSpec)
                hdi\mask = #HDI_TEXT
                hdi\psztext = @text$
                hdi\cchtextmax = Len(text$)
                SetBkMode_(*pnmcd\hdc, #TRANSPARENT)
                FillRect_(*pnmcd\hdc, *pnmcd\rc, BackColorBrushHeader)
                ;                 сдвигаем текст после закрашивания прямоуголников
                If *lvCD\nmcd\dwItemSpec
                  InflateRect_(*pnmcd\rc, -8, 0)
;                   text$ = LTrimChar(text$, " " + #TAB$)
                Else
                  InflateRect_(*pnmcd\rc, -4, 0)
                EndIf
                SetTextColor_(*pnmcd\hdc, ForeColorHeader)
                DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_VCENTER | #DT_END_ELLIPSIS)
                result = #CDRF_SKIPDEFAULT
            EndSelect
          EndIf
      EndSelect
  EndSelect
  ProcedureReturn Result
EndProcedure
;- ╔═ GUI ═╗
If OpenWindow(0, 0, 0, 420, 400, "Пример...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;   for BitBlt
  hDC = GetDC_(WindowID(0))
  MemDC = CreateCompatibleDC_(hDC)
  CreateBMP()
  If LoadFont(0, "Arial", 26)
    SetGadgetFont(#PB_Default, FontID(0)) ; Установить загруженный шрифт Arial 16 как новый стандарт
  EndIf
  ListIconGadget(#LV0, 10, 10, 400, 380, "Col0", 170, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
  ;   SetGadgetAttribute(#LV0 , #PB_ListIcon_DisplayMode , #PB_ListIcon_Report)
  For a = 0 To 4
    AddGadgetItem(#LV0, a, "item" + #LF$ + "item" + #LF$ + "item" + #LF$ + "item")
  Next
;   SetGadgetColor(#LV0, #PB_Gadget_BackColor, BackColorHeader)
  ;     ListViewGadget(0, 10, 10, 400, 380)
  ;     For a = 1 To 12
  ;       AddGadgetItem(0, -1, "Элемент  " + Str(a) + "  Списка") ; Определить содержимое списка.
  ;     Next
  SetWindowCallback(@Callback_Win())
;   hHeader = SendMessage_(GadgetID(#LV0), #LVM_GETHEADER, 0, 0)
;   frmMain_References = SetWindowLongPtr_(GadgetID(#LV0), #GWL_WNDPROC, @Callback_Header())
;   SetBkColor_(hHeader, BackColor)
  ;- Loop
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
;         for ExtractIconEx
        DestroyIcon_(hIcon)
        DestroyIcon_(hIcon2)
;         for BitBlt
        ReleaseDC_(WindowID(0), hDC)
        SelectObject_(MemDC, hOldBMP)
        DeleteDC_(MemDC)
        CloseWindow(0)
        End
    EndSelect
  ForEver
EndIf

[Цитировать]

    motorboy
  • 41869
  • Стаж: 8 дней
  • Сообщений: 9
  • Репутация:1

    [+] [-]
Нашел пример попроще. Надо подумать как его прикрутить к лаунчеру.
Global ListIcon_ID, hImgList, Splitter_ID
Procedure CreateMyList(Size)
  ; 1. Если гаджет уже есть — удаляем его и старый список иконок
  If IsGadget(ListIcon_ID)
    FreeGadget(ListIcon_ID)
    If hImgList : ImageList_Destroy_(hImgList) : EndIf
  EndIf
  ; 2. Создаем новый гаджет (с тем же номером или через #PB_Any)
  ListIcon_ID = ListIconGadget(#PB_Any, 0, 0, 0, 0, "Файлы", 200, #PB_ListIcon_FullRowSelect | #LVS_NOCOLUMNHEADER)
  ; 3. Создаем ImageList НОВОГО размера
  hImgList = ImageList_Create_(Size, Size, #ILC_COLOR32 | #ILC_MASK, 1, 1)
  ; Подготовим тестовую иконку (квадрат) нужного размера
  img = CreateImage(#PB_Any, Size, Size)
  StartDrawing(ImageOutput(img)) : Box(0, 0, Size, Size, $00FF00) : StopDrawing()
  ImageList_Add_(hImgList, ImageID(img), 0)
  SendMessage_(GadgetID(ListIcon_ID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImgList)
  FreeImage(img) ; Картинка уже в ImageList, оригинал можно удалить
  ; 4. Добавляем данные
  AddGadgetItem(ListIcon_ID, -1, "Размер иконок: " + Str(Size), 0)
  AddGadgetItem(ListIcon_ID, -1, "Размер иконок: " + Str(Size), 0)
  AddGadgetItem(ListIcon_ID, -1, "Размер иконок: " + Str(Size), 0)
  ; 5. КЛЮЧЕВОЙ МОМЕНТ: Обновляем Сплиттер
  ; #PB_Splitter_FirstGadget - заменяет первый (верхний/левый) гаджет на наш новый
  If IsGadget(Splitter_ID)
    SetGadgetAttribute(Splitter_ID, #PB_Splitter_FirstGadget, ListIcon_ID)
  EndIf
EndProcedure
; --- Основное окно ---
If OpenWindow(0, 0, 0, 400, 350, "Смена размера на лету", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  btn16 = ButtonGadget(#PB_Any, 10, 310, 80, 30, "16x16")
  btn48 = ButtonGadget(#PB_Any, 100, 310, 80, 30, "48x48")
  ; Создаем пустой контейнер снизу для сплиттера
  txt = TextGadget(#PB_Any, 0, 0, 0, 0, "Нижняя часть", #PB_Text_Center)
  ; Первый запуск (создаем список и сплиттер)
  CreateMyList(16)
  Splitter_ID = SplitterGadget(#PB_Any, 10, 10, 380, 290, ListIcon_ID, txt)
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case btn16 : CreateMyList(16) ; Пересоздаем с мелким размером
        Case btn48 : CreateMyList(48) ; Пересоздаем с крупным размером
      EndSelect
    EndIf
  Until Event = #PB_Event_CloseWindow
EndIf

[Цитировать]

    AZJIO
  • 17953
  • Стаж: 8 лет
  • Сообщений: 1355
  • Репутация:127

    [+] [-]
Ну вообще-то да, в твоём найденном не нужно вручную рисовать, только значки увеличил и всё.
Я ещё упростил
Global hIcon = 0
Global hIcon2 = 0
ExtractIconEx_("Shell32.dll", 161, @hIcon, 0, 1)
ExtractIconEx_("Shell32.dll", 0, @hIcon2, 0, 1)
; ExtractIconEx_("C:\ProgramData\PureBasic\Examples\Sources\Data\CdPlayer.ico", 0, 0, @hIcon, 1)
; Debug hIcon
Global g_tRect.RECT
With g_tRect
  \left = 0
  \top = 0
  \right = 32
  \bottom = 32
EndWith
Global hDC
#LV0 = 0
Global BackColor = $00FF00
Global ForeColor = $FF0000
Global BackColorHeader = $eeffee
Global ForeColorHeader = $2277ff
Global BorderColor = $0
Global HightLightBrush = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
; Global HightLightBrush = CreateSolidBrush_($ff3926)
Global BackColorBrush = CreateSolidBrush_(BackColor)
Global BackColorBrushHeader = CreateSolidBrush_(BackColorHeader)
; ---------------------------------------------------------------------------------------------------------------------
Procedure GetCharWidth(gad, c$)
  ProcedureReturn SendMessage_(gad, #LVM_GETSTRINGWIDTH, 0, @c$)
EndProcedure
; это подкрашивает пункты в ListView
Procedure Callback_Win(hwnd, msg, wParam, lParam)
  Protected Result, *nmhdr.NMHDR, *lvCD.NMLVCUSTOMDRAW, subItemRect.RECT
  Protected thisRow, thisCol
  Protected text$
  Protected *NMITEM.NMITEMACTIVATE
;   Protected nNotifyCode
  Result = #PB_ProcessPureBasicEvents
  ;;Dim LVColor(0)
  Select msg
    Case #WM_NCDESTROY ; удаление кистей, после закрытия программы
      DeleteObject_(HightLightBrush)
      DeleteObject_(BackColorBrush)
      DeleteObject_(BackColorBrushHeader)
    Case #WM_NOTIFY
      ; стандартные структуры ListView для перерисовки
      *nmhdr.NMHDR = lParam
      *lvCD.NMLVCUSTOMDRAW = lParam
      *NMITEM.NMITEMACTIVATE = lParam
;       если гаджет #LV0 и он пользовательская рисовка, то
      If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#LV0) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
        Select *lvCD\nmcd\dwDrawStage
          Case #CDDS_PREPAINT
            Result = #CDRF_NOTIFYITEMDRAW
          Case #CDDS_ITEMPREPAINT
            Result = #CDRF_NOTIFYSUBITEMDRAW;
          Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM ; перерисовка пункта
            thisRow = *lvCD\nmcd\dwItemSpec ; строку
            thisCol = *lvCD\iSubItem ; колонка
            If thisCol =0 ; если колонка 0, то
              ; Определяет прямоугольник для текста
              subItemRect.RECT\left = #LVIR_BOUNDS ; #LVIR_ICON, #LVIR_LABEL
              subItemRect.RECT\top = *lvCD\iSubItem ; iSubItem
              ; Определяет прямоугольник подпункт
              SendMessage_(GadgetID(#LV0), #LVM_GETSUBITEMRECT, thisRow, @subItemRect) ; в итоге переписываем структуру прямоугольника
;               subItemRect.RECT\left + 160
              text$ = GetGadgetItemText(#LV0, thisRow, thisCol) ; получаем текст пункта по строке и колонке
              If GetGadgetState(#LV0) = thisRow ; если индекс выделенного элемента равен пункту, то
                ; выделенный пункт, перекрашиваем его фон
                FillRect_(*lvCD\nmcd\hdc, subItemRect, HightLightBrush)
                SetTextColor_(*lvCD\nmcd\hdc, $00FFFF) ;
              Else
                ; не выделенный пункт, перекрашиваем его другим фоном
                FillRect_(*lvCD\nmcd\hdc, subItemRect, BackColorBrushHeader)
                SetTextColor_(*lvCD\nmcd\hdc, ForeColor) ;
              EndIf
              CopyStructure(@subItemRect, @g_tRect, RECT)
              InflateRect_(subItemRect, -46, 0) ; изменяет левую границу прямоугольника на 8 пиксел (уже другое)
              SetBkColor_(*lvCD\nmcd\hdc, BackColorHeader)  ; фон всегда одинаковый, он вообще не нужен
              DrawText_(*lvCD\nmcd\hdc, text$, -1, subItemRect, #DT_END_ELLIPSIS | #DT_VCENTER | #DT_SINGLELINE) ; рисуем текст
              With g_tRect
                \left + 0
                \right = \left + 12
                \top + 1
                \bottom = \top + 12
              EndWith
              If thisRow % 2
                DrawIconEx_(*lvCD\nmcd\hdc, g_tRect\left, g_tRect\top, hIcon, 32, 32, 0, 0, #DI_NORMAL)
              Else
                DrawIconEx_(*lvCD\nmcd\hdc, g_tRect\left, g_tRect\top, hIcon2, 32, 32, 0, 0, #DI_NORMAL)
              EndIf
              Result = #CDRF_SKIPDEFAULT
            Else
              Result = #CDRF_DODEFAULT
            EndIf
        EndSelect
      EndIf
  EndSelect
  ProcedureReturn Result
EndProcedure
;- ╔═ GUI ═╗
If OpenWindow(0, 0, 0, 420, 400, "Пример...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If LoadFont(0, "Segoe UI", 15)
    SetGadgetFont(#PB_Default, FontID(0)) ; Установить загруженный шрифт Arial 16 как новый стандарт
  EndIf
  ListIconGadget(#LV0, 10, 10, 400, 380, "Col0", 250, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect | #PB_ListIcon_NoHeaders)
  For a = 1 To 6
    AddGadgetItem(#LV0, -1, "Программа " + Str(a) )
  Next
  SetGadgetColor(#LV0, #PB_Gadget_BackColor, BackColorHeader)
  SetWindowCallback(@Callback_Win())
  ;- Loop
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
;         for ExtractIconEx
        DestroyIcon_(hIcon)
        DestroyIcon_(hIcon2)
        CloseWindow(0)
        End
    EndSelect
  ForEver
EndIf

Добавлено через 8 минут 10 секунд:
Использование ImageList_Create_ не так уж и сложно, наоборот даже лучше, удобней удалять значки когда прога закрыта. Надо только связать индекс изображения с именем программы, чтобы перестраивая список выбирая группы просто брать индекс по имени. Возможно даже лучше использовать карту где для имени присваивается индекс, и получать индекс иконки без поиска по списку или массиву.
Добавлено через 1 час 16 минут 27 секунд:
Как-то так
Global ListIcon_ID, hImgList
Define hIcon1, hIcon2, hIcon3
Define Size = 32
; Добавляем иконки прог
ExtractIconEx_("Shell32.dll", 161, @hIcon1, 0, 1)
ExtractIconEx_("Shell32.dll", 0, @hIcon2, 0, 1)
ExtractIconEx_("Shell32.dll", 3, @hIcon3, 0, 1)
Procedure AddItem(idxLV, idxImage, text$, pos = -1)
  Protected item.LVITEM
  item\mask = #LVIF_TEXT | #LVIF_PARAM | #LVIF_IMAGE
  item\iItem = idxLV
  item\iImage = idxImage
  item\pszText = @text$
  SendMessage_(GadgetID(ListIcon_ID), #LVM_INSERTITEMW, pos, @item)
  ProcedureReturn 0
EndProcedure
If OpenWindow(0, 0, 0, 400, 350, "Пример", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIcon_ID = ListIconGadget(#PB_Any, 5, 5, 300, 300, "Файлы", 200, #PB_ListIcon_FullRowSelect | #LVS_NOCOLUMNHEADER)
  hImgList = ImageList_Create_(Size, Size, #ILC_COLOR32 | #ILC_MASK, 1, 1)
  ; Подготовим тестовую иконку (квадрат) нужного размера
  ImageList_AddIcon_(hImgList, hIcon1)
  ImageList_AddIcon_(hImgList, hIcon2)
  ImageList_AddIcon_(hImgList, hIcon3)
  ; Иконки уже в ImageList, оригинал можно удалить
  DestroyIcon_(hIcon1)
  DestroyIcon_(hIcon2)
  DestroyIcon_(hIcon3)
  SendMessage_(GadgetID(ListIcon_ID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImgList)
  ; 4. Добавляем данные
  For i = 0 To 2
    AddItem(i, i, "Программа: " + Str(i))
  Next
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Страница 2 из 2


Показать сообщения:    

Текущее время: 10-Мар 02:44

Часовой пояс: UTC + 3


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
Вы не можете прикреплять файлы к сообщениям
Вы можете скачивать файлы