Simple Launcher - простой лаунчер для запуска портативнх программ

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

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