Total Commander

Loopback писал(а):Проблему однострочности несложно обойти добавлением нескольких единиц одной колонки и их добавлением в штатную подсказку с \n.

Это определенно лучше, но все-таки не решает проблемы до конца: внутри единиц перевод строк все-равно убирается, превращая всё многострочное содержимое одной единицы в ту же самую одну строку.

Но хоть так... Спасибо за прикольный совет.)

Loopback писал(а):С другой стороны, если не писать - шансов-то еще меньше

https://www.youtube.com/watch?v=nBZT400Mwus

Вопросик: нельзя посадить двойной клик на кнопку командой ControlSetMouseAction? Т.е., например ControlSetMouseAction /L: D /B:7 17 AutorunStatus 1
Не работает (D отделил пробелом, иначе форум вставляет смайлик). В принципе, можно замутить через таймер:

Код: Выделить всё

 # второй вызов функции менее, 
    # чем за 300 млс. (второй клик)
    if t > 1 and (GetUptime() - t1) < 300 then
       t = 0
       ShowHint("Правый клик: Запуск AkelPad")
       Return
    endif

И даже получается, но мешают как-раз те самые Sleep-ы. Можно отказаться от них

Код: Выделить всё

e 
       ShowHint("Отладчик DebugView не запущен")
#       Sleep(500)
#       WinSetState(23)

и все работает. Но я хочу добится именно такого эффекта: первый клик по кнопке "Autorun" - переход к DebugView; если DebugView не запущен, то хинт "не запущен"; хинт висит полсекунды и скрывается; если я нажал еще раз до его скрытия, то запуск AkelPad. Сейчас Sleep мешает всей этой схеме, она работает, но с косяками

Если бы хинт сам скрывался и отпускал функцию, то, думаю, всё заработало бы. Т.ч. надеюсь!

Ладно, посмотрим, но не сейчас.

Это вообще не срочно, если что

Пара примеров на WMI Object!

[cut]

Код: Выделить всё

Pragma IncludeOnce

# вызов по Alt + "-"
SetHotkeyAction /K:A /V:189 WmiTcpip

# код для вызова из кнопки
RegisterCommand 70003 "PingThree"

Static Ping3_Thread = 0

Func WmiTcpip()
  Local Outstr
  Local wq = WMIQuery()  
 
  While 1  
    wq.Query('select * from Win32_PerfFormattedData_Tcpip_NetworkInterface')
    #wq.Query('select * from Win32_PerfRawData_Tcpip_NetworkInterface')
    
    wq.Next()
    Outstr = wq.GetValue("BytesReceivedPersec") & " / " & wq.GetValue("BytesSentPersec")
    If IsPressed (0x1B) Then Break    
    ShowHint(Outstr)
    sleep(500)
    WinSetState(23)
    If IsPressed (0x1B) Then
       Break
    Endif    
  Wend
 
  Free(wq)
EndFunc

# обертка для потока
# прямой вызов WmiPing по коду 70003 работать не будет
Func PingThree(lParam)

   if Ping3_Thread > 0 then
      Ping3_Thread = 0
   else
      Ping3_Thread = 1   
      RunThread WmiPing
   endif 
   
EndFunc

Func WmiPing()
  Local out
  Local wq = WMIQuery(), pa1, pa2, pa3, pq
  
  pa1 = "192.168.1.1"
  pa2 = "192.168.1.2"
  pa3 = "wincmd.ru"
  
   pq = 'SELECT Address, ResponseTime, ResponseTimeToLive, StatusCode FROM Win32_PingStatus _
         WHERE BufferSize = 32 AND Timeout = 1000 AND (Address = "' & pa1 & '" _
         OR Address = "' & pa2 & '" OR Address = "' & pa3 & '")'
         
   pq = "SELECT Address, ResponseTime, ResponseTimeToLive, StatusCode FROM Win32_PingStatus _
         WHERE BufferSize = 32 AND Timeout = 1000 AND (Address = '" & pa1 & "' _
         OR Address = '" & pa2 & "' OR Address = '" & pa3 & "')"
        
         OutputDebugString(pq)
         
   ShowPingHint("Pinging started")      

  While Ping3_Thread > 0
  
    out = ''
    wq.Query(pq)
    
    While wq.Next()
        out = out & "Ping " &  wq.GetValue("Address") & " " & GetPingStatus(wq.GetValue("StatusCode")) _  
                  & " ResponseTime " & wq.GetValue("ResponseTime") & " TTL " & wq.GetValue("ResponseTimeToLive") & auCRLF
        If IsPressed (0x1B) Then Break
    Wend
    
    If IsPressed (0x1B) Then Break
                 
    ShowPingHint(out)
    
    If IsPressed (0x1B) Then Break    
    
  Wend
  
   ShowPingHint("Pinging stoped")           
 
  Free(wq)
EndFunc

Func GetPingStatus(StatusCode)
   If StatusCode = 0 Then
      Return "OK"
   Else
      Return "Fail"
   Endif
EndFunc

Func ShowPingHint(PingHint)

   SetHintParam("ShowHint", "Font", 10, "Consolas")
   SetHintParam("ShowHint", "BackColor", 0x001C1C1C)
   SetHintParam("ShowHint", "Text", 0xFFFFFF)   
   SetHintParam("ShowHint", "Frame", 0xFFFFFF)   
   ShowHint(PingHint)
   Sleep(1000)
   WinSetState(23)
   
   SetHintParam("ShowHint", "Reload")
   
EndFunc

[/cut]
В первом примере жмите на ESC почаще, чтобы выйти - этот пример менее проработан - он чисто для демонстрации.) Пример рабочий, но для получения информации по скорости передачи по сети лучше использовать родную функцию Autorun - GetNetInterfaceInfo.

Второй пример - для кнопки. Запуск пинга сразу трёх адресов и показа статуса операции. С форматом вывода не заморачивался, но и так смотрится неплохо. Выход из цикла - ESC или повторное нажатие на кнопку.

Loopback
Спасибо за функционал - он просто шикарен!
Заметил только, что строка запроса ругается на двойные кавычки, пришлось брать запрос в одиночные, т.е. строка вида:

Код: Выделить всё

SELECT ResponseTime, ResponseTimeToLive, StatusCode FROM Win32_PingStatus WHERE BufferSize = 32 AND Timeout = 1000 AND (Address = "192.168.1.1" OR Address = "192.168.1.2" OR Address = "wincmd.ru")

Работает только:

Код: Выделить всё

SELECT ResponseTime, ResponseTimeToLive, StatusCode FROM Win32_PingStatus WHERE BufferSize = 32 AND Timeout = 1000 AND (Address = '192.168.1.1' OR Address = '192.168.1.2' OR Address = 'wincmd.ru')

Orion9
А возможно, когда размещаете пример кода, цеплять скрин результата этого кода для наглядности что получается?

Orion9 писал(а): нельзя посадить двойной клик на кнопку командой ControlSetMouseAction

Посадить-то можно, но у кнопки есть стандартное действие на один клик по отпусканию, которое тогда нужно либо просто "заглушить" ( ControlSetMouseAction /L:U /B:7 17 ""), если оно не нужно, либо заменить своей функцией. Как в этом случае отличать двойной клик от одинарного - задача пользователя. Обычно как раз с помощью таймера и делается.

Orion9 писал(а):Но я хочу добится именно такого эффекта

Cложные хотелки. Особенно этот момент с использованием разнородных действий на одинарный и двойной клик. Но раз хочется - кто ж запретит

Orion9 писал(а): строка запроса ругается на двойные кавычки, пришлось брать запрос в одиночные

А если весь первый запрос поместить в одинарные - разве не будет работать?

jentoso
Там больше половины - это просто наброски и фрагменты кода, содержашие в себе определенные идеи, которые еще надо развивать и развивать, чтобы они приобрели какой-то законченный, (реально) рабочий и практический вид. Т.ч. даже не знаю, что в таких случаях можно визуализировать.) А тот код, который работает, должен одинаково работать, что у меня, что у вас, если вы его запустите.

Добавлено спустя 3 минуты:

Loopback писал(а):А если весь первый запрос поместить в одинарные - разве не будет работать?

Не-а.

На счет хотелок - согласен. Но тот пример с 5 секундами вполне реален, если не считать, что 5 секунд это и правда много)

Orion9
Значение внутренней переменной в функции BackColorBar
Set /EV- tcfs2 "%COMMANDER_PATH%\Utilites\TCFS2\TCFS2.exe"
неожиданно оказывается (после выполнения функции) в одноимённой глобальной переменной, установленной ранее.
Не баг ли это?

sa
Надо посмотреть. А пока сброшу еще одну плюшку, учитывая последние веяния с MI

[cut]

Код: Выделить всё

# вызов по Alt + "["
SetHotkeyAction /K:A /V:219 GetMediaInfo 0
# + Ctrl
SetHotkeyAction /K:A /K:C /V:219 GetMediaInfo 0

# вызов по Alt + "]"
SetHotkeyAction /K:A /V:221 GetMediaInfo 1
# + Ctrl
SetHotkeyAction /K:A /K:C /V:219 GetMediaInfo 1

# код для вызова из кнопки
RegisterCommand 70004 "GetMediaInfo"

Func GetMediaInfo(lParam)
Local sPath, sName, sFile, sAkel, sMI, pMI, txt, sTemp

 # lParam = 0 - использовать временный файл > 1.txt
 # lParam = 1 - сохранить и вставить stdout из буфера

      sMI = %COMMANDER_PATH% & "\Plugins\arc\MediaInfo\MediaInfo.exe"
      pMI = %COMMANDER_PATH% & "\Plugins\arc\MediaInfo\"      
    sAkel = %COMMANDER_PATH% & "\Utilites\AkelPad\AkelPad.exe"
    sPath = RequestCopyDataInfo("SP")
    sName = RequestCopyDataInfo("SN")
    sFile = sPath & sName
    
    If Not FileExist(sFile) Then 
       ShowHint("Файл не существует " & sFile)
       Return 
    Endif
    
   If StrPos(FileGetAttr(sFile), "D") Then
       ShowHint("Каталог")
       Return 
    Endif
    
    sTemp = %TEMP% & "\" & StrFormat("07%d", Random(1, 100000, 1)) & ".txt" 
    OutputDebugString(sTemp)
    
   # Ctrl - русский язык 
   If IsPressed (0x11) Then
      If lParam = 1 Then
         ProcessExecGetOutput txt %sMI% ' --Language=file://ru.csv --Complete "%sFile%"' '%pMI%'       
      Else
         ProcessExecGetOutput txt %sMI% ' --Language=file://ru.csv --Complete --LogFile="%sTemp%" "%sFile%"' '%pMI%' 
      Endif   
   Else
      If lParam = 1 Then
         ProcessExecGetOutput txt %sMI% ' -f "%sFile%"'    
      Else
         ProcessExecGetOutput txt %sMI% ' -f --LogFile="%sTemp%" "%sFile%"'
      Endif    
   Endif   
      
   If lParam = 1 Then
      ClipPut(txt)
      h = WinFind(0, "AkelPad4")
      If h > 0 Then
         ShellExec /SW_SHOWNORMAL %sAkel% '/Command(4101) /Command(4155) /Call("Scripts::Main", 1, "GoHome.vbs")'
      Else 
         ShellExec /SW_SHOWNORMAL %sAkel% '/Command(4155) /Call("Scripts::Main", 1, "GoHome.vbs")'
      Endif
   Else 
      If txt = "" Then
         ShowHint("Пустой stdout")
      Else
         ShellExec /SW_SHOWNORMAL %sAkel% '%sTemp%'
      Endif
   Endif        
 
EndFunc

[/cut]
Эх, жаль ProcessExecGetOutput не возвращает корректно юникод: не пришлось бы заморачиваться с рамдомным временным файлом

Orion9 писал(а): жаль ProcessExecGetOutput не возвращает корректно юникод

Теперь может и возвращает: Process от 20,11.24

Новый переключатель в виде /C:nnnn, где nnnn - кодировка. Для UTF-8 - 65001, для UTF-16 - 1200. Ну и остальные варианты если нужны - 1251 и т.д.

Функцию пришлось почти полностью переписать, так что косяки возможны.

sa писал(а):Не баг ли это?

Баг. Но не Autorun, а моя ошибка

Лучше для этого объявить другую локальную переменную.

Loopback
Пока работает как и должно, спасибо. Но у меня действительно в последнее время Total стал падать иногда на ровном месте, причем будучи неактивным окном. Один раз возникла ошибка Runtime. Все это стало происходить с тех пор, как обновил плагин Autorun и WinAdvScript - примерно в одно время. Никто не замечал подобного?

А где можно обновленным хайлайтером обжиться? Что-то я на darkhost ничего не нашел

И еще один вопрос. При помощи WinSetText нельзя изменить содержимое контрола в ColorMania? Что-то не работает... А я, вот, расчитывал

Код: Выделить всё

WinSetText(ColorText, WinFind(h, "TEdit", 1))

Orion9 писал(а):Лучше для этого объявить другую локальную переменную.

Да я так и сделал. Иначе была проблема с переключением числа строк в панели инструментов.

Orion9 писал(а): Но у меня действительно в последнее время Total стал падать иногда на ровном месте, причем будучи неактивным окном.

При таком количестве (предполагаю) висящих наворотов неудивительно

Но на основе таких данных сказать ничего нельзя. Нужно определять код, вызывающий проблему (если это вообще Autorun).

Orion9 писал(а):А где можно обновленным хайлайтером обжиться? Что-то я на darkhost ничего не нашел

А там ничего и нет. Если речь про Akel, то я им не пользуюсь на постоянной основе, хайлайтер не делаю.

Если это поможет, вот список всех символов Autorun на данный момент для добавления в любой хайлайтер:

[cut]
### Keywords
Break
ByRef
Case
Const
Continue
Else
ElseIf
EndFunc
EndIf
EndSwitch
Exit
False
For
Func
Global
If
Local
Next
Pragma
Return
Static
Step
Switch
Then
To
True
Wend
While

### Pragmas, Fixed Dialogs
AutorunAllowWriteEnv
AutorunBlockUnload
AutorunFinalizeSection
AutorunLanguage
AutorunLoadInSubprocess
AutorunPluginFields
DIALOG_COPYMOVE
DIALOG_COPYMOVE_PINNED
DIALOG_COPYMOVE_POST
Include
IncludeOnce
LegacyExpressions

### Functions
Abs
AddCondition
AddControl
AddDialog
Args
Asc
BitAND
BitNOT
BitOR
BitShift
BitXOR
Call
Ceil
Chr
ClipGet
ClipPut
CommandExec
ControlSetHint
ControlSetMouseAction
Date
DisableMarkedMenuItems
Eval
FileExist
FileGetAttr
FileGetSize
FileGetTime
FileGetVersion
FileSetAttr
FileSetTime
Floor
Free
GetCoreTempInfo
GetCpuInfo
GetCPUUsage
GetCurrentItem
GetDriveSpace
GetEnv
GetKnownFolderPath
GetMemStats
GetNetInterface
GetNetInterfaceInfo
GetState
GetSysColor
GetSystemMetrics
GetUptime
GetWMIValue
Hex
IniDelete
IniRead
IniWrite
IsFloat
IsInt
IsNumber
IsPressed
ItemAtCursor
List
LngRead
LoadFont
LoadLibrary
Mod
ModifyDialogs
MouseClick
MouseGetPos
MouseSetPos
MsgBox
Now
OutputDebugString
Plugin
PostMessage
ProcessCount
ProcessExecGetOutput
ProcessExist
ProcessGetId
ProcessGetPath
ProcessTerminate
Random
RegDelete
RegisterCommand
RegRead
RegWrite
RequestCopyDataInfo
RequestInfo
RestartScript
Round
RunThread
SendCommand
SendMessage
Set
SetEnv
SetError
SetExtended
SetFieldsParam
SetHintParam
SetHotkeyAction
SetHotkeyAction
SetMessageAction
ShellExec
ShowHint
ShowPopupMenu
SizeFormat
Sleep
StrCompare
StrFormat
StrLeft
StrLen
StrLower
StrMid
StrPart
StrPos
StrReplace
StrRight
StrTrim
StrUpper
SystemParametersInfo
Time
ToDateTime
WinActivate
WinFind
WinFromPoint
WinGetClass
WinGetFocusedCtrl
WinGetPID
WinGetPos
WinGetState
WinGetStyle
WinGetText
WinHasStyle
WinRedraw
WinSetCtrlFocus
WinSetPos
WinSetState
WinSetStyle
WinSetText
WMIQuery

### Macro and constants
ACTIVE_WINDOW
auCR
auCR
auCRLF
auCRLF
auLF
auLF
auTAB
auTAB
AUTORUN_ISADMIN
AUTORUN_PATH
AUTORUN_RESTARTCOUNT
AUTORUN_TCARCH
AUTORUN_TCCMDLINE
AUTORUN_TCHANDLE
AUTORUN_TCLANG
AUTORUN_TCLANGFILE
AUTORUN_TCPID
COMMANDER_INI
COMMANDER_INI_PATH
COMMANDER_PATH
ERROR
EXTENDED
PROCESS_INTEGRITYLEVEL
PROCESS_ISELEVATED
PROCESS_RUNASADMIN
PROCESS_USERISADMIN
SYSINFO_DESKTOPDEPTH
SYSINFO_DESKTOPHEIGHT
SYSINFO_DESKTOPWIDTH
SYSINFO_OSARCH
SYSINFO_OSSERVICEPACK
SYSINFO_OSVERSION
SYSINFO_USERLANG

### Operators
And
Not
Or
[/cut]

Orion9 писал(а): При помощи WinSetText нельзя изменить содержимое контрола в ColorMania? Что-то не работает...

Похоже та же проблема, что и с WinGetText.

sa писал(а):Да я так и сделал. Иначе была проблема с переключением числа строк в панели инструментов.

Да, я там увлёкся и забыл обяъявить ее локально, хотя вроде помнил, что она с таким же именем, что и глобальная - а это всегда опасно

Я там заметил еще двойную косую черту, как оно с ней работало - не понятно. Но большое спасибо за подсказку, не всегда хватает времени все протестировать. Т.ч. очень на вас расчитываю вот с этой обновой!

[cut]

Код: Выделить всё

# Ctrl+Shift+"+" 	- 	Повышение тонов
# Ctrl+Shift+"-" 	- 	Понижение тонов
# Ctrl+"+" 		- 	Автоповышение тонов
# Ctrl+"-" 		- 	Автопонижение тонов
# ESC 			- 	Выход из автоперебора
# Alt+"+" 		- 	Показ текущих значений

Pragma IncludeOnce

Global Pulsar = 0, BACKDROP_THREAD = 0, BackColor1 = 0, BackColor2 = 0, Previous1 = 0, Previous2 = 0

Global CF_NAME = "", CF_VALUE = -1, CF_KEY = 0, CF_COLOR_KEY = 0, WRITE_COLOR_MODE = 0, CL_KEY = "", CL_VALUE = -1, CL_SNAP = ""

Global CL_BAR = %COMMANDER_PATH% & "\Bars\Backdrops.bar"
Global CL_AKEL4 = %COMMANDER_PATH% & "\Utilites\AkelPad\AkelPad.exe", CL_TCFS2 = ""

Set /EV- CL_TCFS2 "%COMMANDER_PATH%\Utilites\TCFS2\TCFS2.exe"

# повышение/понижение тонов
SetHotkeyAction /K:C /K:S /V:187 /R /DM SetBackGround 1
SetHotkeyAction /K:C /K:S /V:189 /R /DM SetBackGround 2

# авто
SetHotkeyAction /K:C /V:187 SetPulsar 1
SetHotkeyAction /K:C /V:189 SetPulsar 2

# показать текущие значения
SetHotkeyAction /K:A /V:187 ShowBackColor 1000

# 70000-70050

# первоначальные значения цветов
# 0 - запомнить 
# 1 - открыть в редакторе
RegisterCommand 70000 "InitialColors" 1

# регистрация команды для вызова из кнопки (пункта меню)
RegisterCommand 70001 "AutoBackdrop"

# запоминание текущего фона
RegisterCommand 70002 "BackColorBar"

RegisterCommand 70003 "ShowBackdropMenu"

RegisterCommand 70004 "ColorItem" "Backdrop"
RegisterCommand 70005 "ColorItem" "MarkColor"
RegisterCommand 70006 "ColorItem" "CursorColor"
RegisterCommand 70007 "ColorItem" "ForeColor"
RegisterCommand 70008 "ColorItem" "CursorText"
RegisterCommand 70009 "ColorItem" "BackColor"
RegisterCommand 70010 "ColorItem" "BackColor2"

RegisterCommand 70011 "ColorFilterItem" 1
RegisterCommand 70012 "ColorFilterItem" 2
RegisterCommand 70013 "ColorFilterItem" 3
RegisterCommand 70014 "ColorFilterItem" 4
RegisterCommand 70015 "ColorFilterItem" 5
RegisterCommand 70016 "ColorFilterItem" 6
RegisterCommand 70017 "ColorFilterItem" 7
RegisterCommand 70018 "ColorFilterItem" 8
RegisterCommand 70019 "ColorFilterItem" 9
RegisterCommand 70020 "ColorFilterItem" 10
RegisterCommand 70021 "ColorFilterItem" 11
RegisterCommand 70022 "ColorFilterItem" 12
RegisterCommand 70023 "ColorFilterItem" 13
RegisterCommand 70024 "ColorFilterItem" 14
RegisterCommand 70025 "ColorFilterItem" 15


# прием сообщения окну "установить значения фона"
SetMessageAction /P "BackColorsMessage" SetBackColors

# значения фона при старте ТС
if BackColor1 = 0 or BackColor2 = 0 then
   IniRead /R BackColor1 %COMMANDER_INI% "Colors" "BackColor" -1
   IniRead /R BackColor2 %COMMANDER_INI% "Colors" "BackColor2" -1
endif

Func InitialColors(lParam, lMode)
Local i = 0, cf, txt

   If lMode = 1 Then
   
      OpenInTextEditor(CL_SNAP)
      Return 
   Endif
   
   # снимок первоначальных значений 
   CL_SNAP = ";значения секции при запуске ТС" & auCRLF
   CL_SNAP = CL_SNAP & "[Colors]" & auCRLF
   
   IniRead /R txt %COMMANDER_INI% "Colors" "ForeColor" -1   
   CL_SNAP = CL_SNAP & "ForeColor=" & txt & auCRLF   
   
   IniRead /R txt %COMMANDER_INI% "Colors" "BackColor" -1
   CL_SNAP = CL_SNAP & "BackColor=" & txt & auCRLF
   
   IniRead /R txt %COMMANDER_INI% "Colors" "BackColor2" -1   
   CL_SNAP = CL_SNAP & "BackColor2=" & txt & auCRLF
   
   IniRead /R txt %COMMANDER_INI% "Colors" "MarkColor" -1   
   CL_SNAP = CL_SNAP & "MarkColor=" & txt & auCRLF
   
   IniRead /R txt %COMMANDER_INI% "Colors" "CursorColor" -1   
   CL_SNAP = CL_SNAP & "CursorColor=" & txt & auCRLF
  
   IniRead /R txt %COMMANDER_INI% "Colors" "CursorText" -1   
   CL_SNAP = CL_SNAP & "CursorText=" & txt & auCRLF            

   While i < 100
   
      i = i + 1
   
      IniRead /R cf %COMMANDER_INI% "Colors" %"'ColorFilter' & %i%" "stop"
      If cf="stop" Then Break
      
      IniRead /R txt %COMMANDER_INI% "Colors" %"'ColorFilter' & %i% & 'Color'"
      CL_SNAP = CL_SNAP & cf & "=" & txt & auCRLF            
               
   Wend
   
EndFunc
  
Func AutoBackdrop(lParam)
Static StartCount = 0

   # удержание Ctrl+Shift
   # повышение тона на одну единицу после нажатия
   # на кнопку, выбора пункта меню или вызова другим способом
   If IsPressed (0x10) And IsPressed (0x11) Then Return SetBackGround(1)
   
   # удержание Ctrl
   # понижние тона на одну единицу
   If IsPressed (0x11) Then Return SetBackGround(2)
   
   # удержание Alt+Win
   # вернуть предыдущий фон
   If IsPressed (0x12) And IsPressed (0x5B) Then
      if Previous1 > 0 or Previous2 > 0 then WriteBackground(Previous1, Previous2)
      Return 
   endif
   
   # удержание Alt+Shift
   # скопировать в буфер код кнопки текущего фона  
   If IsPressed (0x12) And IsPressed (0x10) Then
      IniRead /R bkg1 %COMMANDER_INI% "Colors" "BackColor" -1
      IniRead /R bkg2 %COMMANDER_INI% "Colors" "BackColor2" -1
      ClipPut("TOTALCMD#BAR#DATA" & auCRLF & CL_TCFS2 & auCRLF & _
              "/u- /ef ""msg(regmsg(BackColorsMessage), " & bkg1 & ", " & bkg2 & ")""" & auCRLF & "%COMMANDER_EXE%")
      ShowBackHint("Кнопка с фоном скопирована")
      Return
   Endif
   
   # удержание Alt
   # вернуть первоначальный фон TC
   If IsPressed (0x12) Then Return WriteBackground(BackColor1, BackColor2)
   
   # удержание Shift
   # показ текущих значений фона
   If IsPressed (0x10) Then Return ShowBackColor()
   
   # поток уже запущен
   if BACKDROP_THREAD > 0 then
      BACKDROP_THREAD = 0
   else
      If StartCount = 0 Then InitialColors(0, 0)
      BACKDROP_THREAD = 1
      # при старте парное значение по умолчанию
      ColorItem(0, "Backdrop")
      RunThread ThreadBackdrop
      StartCount = StartCount + 1
      SetHintParam("ShowHint", "Font", 10, "Tahoma")
      SetHintParam("ShowHint", "BackColor", 0x001C1C1C)
      SetHintParam("ShowHint", "Text", 0xFFFFFF)
      #SetHintParam("ShowHint", "Frame", 0xFFFFFF)       
      ShowHint("Отслеживание значений запущено." & auLF & "Значения в ColorMania / буфере будут применятся к фону панелей.")
      Sleep(2000)
      WinSetState(23)
      SetHintParam("ShowHint", "Reload")      
   endif
   		
EndFunc

Func SetBackColors(hWnd, uMsg, wParam, lParam)

     WriteBackground(wParam, lParam)
     
EndFunc

# запись значений, обновление панелей
Func WriteBackground(Color1, Color2)
     IniWrite /R %COMMANDER_INI% "Colors" "BackColor" %Color1%
     IniWrite /R %COMMANDER_INI% "Colors" "BackColor2" %Color2%
     SendCommand 2957
     SendCommand 2957
EndFunc

Func WriteSingleColor(KeyName, KeyValue)
     IniWrite /R %COMMANDER_INI% "Colors" %"%KeyName%" %KeyValue%

    # ShowBackHint("Запись " & KeyName & " = " & KeyValue)
     SendCommand 2957
     SendCommand 2957
EndFunc

Func ThreadBackdrop()
Local h = 0, max = 1*255 + 256*255 + 65536*255, clip, last = 0, w = 0, source

   # предыдущие значения фона
   IniRead /R Previous1 %COMMANDER_INI% "Colors" "BackColor" -1
   IniRead /R Previous2 %COMMANDER_INI% "Colors" "BackColor2" -1

   While BACKDROP_THREAD = 1
       
       h = WinFind(0, "TfrmColorPick")
       if h > 0 and IsPressed (0x11) then
          # текст из ColorMania 
          # при зажатом CTRL 
          clip = WinGetText(WinFind(h, "TEdit", 1))
          source = "ColorMania"
       else
          # первая строка в буфере 
          clip = StrPart(ClipGet(), auLF, 1)
          source = "Clipboard"            
       endif
          
       if IsInt(clip) then
          # новое число в диапазоне
          if clip >= 0 and clip <= max and not (clip = last) then
          
             WinSetText("Applying color value: " & clip)
             
             If WRITE_COLOR_MODE = 0 Then
                WriteBackground(clip, clip)
             Else
                WriteSingleColor(CL_KEY, clip)
             Endif
             w = w + 1
             last = clip
             Sleep(400)

          endif
       endif
       
       Sleep(250)
       WinSetText("Backdrop thread is watching for " & source & " values for " & CF_NAME & "")
       
   Wend
   BACKDROP_THREAD = 0
   WinSetText("")
   
   SetHintParam("ShowHint", "Font", 10, "Tahoma")
   SetHintParam("ShowHint", "BackColor", 0x001C1C1C)
   SetHintParam("ShowHint", "Text", 0xFFFFFF)   
   ShowHint("Отслеживание остановлено" & auLF & "Применений фона: " & w)
   Sleep(2000)
   WinSetState(23)
   SetHintParam("ShowHint", "Reload")   
EndFunc

Func SetBackGround(nParam)
Local bkg1, bkg2, max = 1*255 + 256*255 + 65536*255

   # при автоизменении потолок чуть меньше
   # попытка предотвратить переход в серые тона   
   if Pulsar = 1 then max = 1*245 + 256*245 + 65536*245
       
   IniRead /R bkg1 %COMMANDER_INI% "Colors" "BackColor" -1
   IniRead /R bkg2 %COMMANDER_INI% "Colors" "BackColor2" -1
   
   If Not IsInt(bkg1) Or Not IsInt(bkg2) Then
      MsgBox("Нечисловые значения цвета фона: " _ 
              & auLF & auLF & "BackColor=" & bkg1 & auLF & "BackColor2=" & bkg2 _
              & auLF & auLF & "ESC - Отмена операции")
      Return
   Endif
   
   if bkg1 = -1 then bkg1 = max
   if bkg2 = -1 then bkg2 = max
   
   if nParam = 1 then
      bkg1 = bkg1 + 1 + 256 + 65536
      bkg2 = bkg2 + 1 + 256 + 65536      
   else
      bkg1 = bkg1 - 1 - 256 - 65536
      bkg2 = bkg2 - 1 - 256 - 65536      
   endif
   
   if bkg1 > max then bkg1 = bkg1 - 1 - 256 - 65536
   if bkg2 > max then bkg2 = bkg2 - 1 - 256 - 65536
   
   if bkg1 < -1 then bkg1 = max 
   if bkg2 < -1 then bkg2 = max
   
   WriteBackground(bkg1, bkg2)

EndFunc

Func SetPulsar(nParam)
local a, b, s, l
static t = 0
   
   if Pulsar = 1 then 
      Pulsar = 0
      Return
   endif
   
    Pulsar = 1
   
   if nParam = 1 then 
      a = 1
      b = 2
      s = 1
   else
      a = 2
      b = 1
      s = -1
   endif
   
   IniRead /R Previous1 %COMMANDER_INI% "Colors" "BackColor" -1
   IniRead /R Previous2 %COMMANDER_INI% "Colors" "BackColor2" -1
  
   While Pulsar = 1
   
      For j = a To b step s
      
         For i = 1 To 75
             
             SetBackGround(j)
             Sleep(25)
             l = l + 1
             t = t + 1
             
             if Pulsar = 0 then Break
             
             If IsPressed (0x1B) Then
                Pulsar = 0
                Break
             Endif
             
         Next
         
         if Pulsar = 0 then Break
      Next
      
   Wend
   # показать статистику, если выход по ESC
   If IsPressed (0x1B) Then
      ShowHint("Изменений тонов: " & l & auCRLF & "Всего изменений: " & t)
   Endif    
EndFunc 

Func ShowBackColor(lDelay = 300)
Local txt, bkg1, bkg2, max = 1*255 + 256*255 + 65536*255
       
   IniRead /R bkg1 %COMMANDER_INI% "Colors" "BackColor" -1
   IniRead /R bkg2 %COMMANDER_INI% "Colors" "BackColor2" -1
   
   if bkg1 = -1 then bkg1 = max
   if bkg2 = -1 then bkg2 = max

   # обратный расчет
   blue = floor(bkg1/65536)
   green = bkg1 - (blue * 65536)
   green = floor(green/256)
   red = bkg1 - (blue * 65536) - (green * 256)
   
   txt = "Фон 1" & auLF & "Красный: " & red & auLF & "Зелёный: " & green & auLF & "Синий: " & blue & auLF & "Значение: " & bkg1
   txt = txt & auLF & "" & auLF
   
   blue = floor(bkg2/65536)
   green = bkg2 - (blue * 65536)
   green = floor(green/256)
   red = bkg2 - (blue * 65536) - (green * 256)
   
   txt = txt & "Фон 2" & auLF & "Красный: " & red & auLF & "Зелёный: " & green & auLF & "Синий: " & blue & auLF & "Значение: " & bkg2
   ShowHint(txt)
EndFunc

Func BackColorBar(lParam)
Local i, bkg1, bkg2, bar = CL_BAR
       
   If Not FileExist(bar) Then   
      MsgBox("Файл не существует " & bar, "Backdrop")
      Return
   Endif
   
   IniRead i %bar% "Buttonbar" "Buttoncount" 0
   
   If Not IsInt(i) or i < 1 Then
      MsgBox("Ошибка Buttoncount < 1 " & auCRLF & bar, "Backdrop")
      Return
   Endif
   
   IniRead /R bkg1 %COMMANDER_INI% "Colors" "BackColor" -1
   IniRead /R bkg2 %COMMANDER_INI% "Colors" "BackColor2" -1   
   
   i = i + 1
  
   IniWrite /EV- %bar% "Buttonbar" %"'Button' & %i%" "%COMMANDER_EXE%"
   IniWrite %bar% "Buttonbar" %"'Cmd' & %i%"    "%CL_TCFS2%"
   IniWrite %bar% "Buttonbar" %"'Param' & %i%"  '"/u- /ef "msg(regmsg(BackColorsMessage), %bkg1%, %bkg2%)"'      
   IniWrite %bar% "Buttonbar" %"'Menu' & %i%"   "Фон %bkg1%, %bkg2%"   
          
   IniWrite %bar% "Buttonbar" "Buttoncount" %i%
   
   ShowBackHint("Фон панелей сохранен")
   
EndFunc

Func ShowBackHint(BackHint)

   SetHintParam("ShowHint", "Font", 10, "Arial")
   SetHintParam("ShowHint", "BackColor", 0x001C1C1C)
   SetHintParam("ShowHint", "Text", 0xFFFFFF)   
  
   ShowHint(BackHint)
   Sleep(1000)
   WinSetState(23)
   
   SetHintParam("ShowHint", "Reload")
   
EndFunc

Func CreateBackdropMenu()
Local i = 0, cf, txt

   txt = txt & 'MENUITEM "Фон\tBackdrop", 70004' & auCRLF
   txt = txt & 'MENUITEM SEPARATOR' & auCRLF
   txt = txt & 'MENUITEM "Выделение\tMarkColor", 70005' & auCRLF
   txt = txt & 'MENUITEM "Курсор\tCursorColor", 70006' & auCRLF
   txt = txt & 'MENUITEM "Текст\tForeColor", 70007' & auCRLF
   txt = txt & 'MENUITEM "Текст под курсором\tCursorText", 70008' & auCRLF
   txt = txt & 'MENUITEM "Фон 1\tBackColor", 70009' & auCRLF
   txt = txt & 'MENUITEM "Фон 2\tBackColor2", 70010' & auCRLF
   txt = txt & 'MENUITEM SEPARATOR' & auCRLF   

   While i < 100
   
      i = i + 1
   
      IniRead /R cf %COMMANDER_INI% "Colors" %"'ColorFilter' & %i%" "stop"
      If cf="stop" Then Break
                 
      #OutputDebugString("Autorun: i=" & i & " cf=" & cf)   
      
      txt = txt & 'MENUITEM "' & cf & '", 700' & 10+i & auCRLF
      
   Wend
   txt = txt & 'MENUITEM SEPARATOR' & auCRLF   
   txt = txt & 'MENUITEM "Первоначальные значения секции [Colors]", 70000'
   #OutputDebugString(txt)
   Return txt
EndFunc

Func ShowBackdropMenu(lParam)
    ShowPopupMenu /D /F "CreateBackdropMenu"
EndFunc

Func ColorFilterItem(lParam, wItem)

    Local key1, key2, val1, val2
    
    If BACKDROP_THREAD = 0 Then
       ShowHint("Функция не доступна когда" & auCR & "Отслеживание цвета не запущено")
       Return
    Endif

    key1 = "ColorFilter" & wItem
    key2 = key1 & "Color"
    
    IniRead /R val1 %COMMANDER_INI% "Colors" %"%key1%" ""
    IniRead /R val2 %COMMANDER_INI% "Colors" %"%key2%" ""
    
    CF_KEY = key1
    CF_COLOR_KEY = key2
    
    CF_NAME = val1
    CF_VALUE = val2
    
    CL_KEY = CF_COLOR_KEY
    CL_VALUE = CF_VALUE
      
    WRITE_COLOR_MODE = 1

    ColorItemChange(CL_VALUE)    
    ShowBackHint("Цвет типа выбран" & auCR & "Значения будут применятся к " & CF_NAME)
#    OutputDebugString(GetState("vars"))
EndFunc

Func ColorItem(lParam, sItem)
Local key, val

    If BACKDROP_THREAD = 0 Then
       ShowHint("Функция не доступна когда" & auCR & "Отслеживание цвета не запущено")
       Return
    Endif
    
    # парный однотонный фон BackColor = BackColor2
    If sItem = "Backdrop" Then
       WRITE_COLOR_MODE = 0
       ShowBackHint("Цвет типа выбран" & auCR & "Значения будут применятся к Backdrop") 
       CF_NAME = "Backdrop"
       ClipPut(CF_NAME) 
       Return      
    Endif
    
    key = sItem
    IniRead /R val %COMMANDER_INI% "Colors" %"%key%" ""
    
    CL_KEY = key
    CL_VALUE = val
    CF_NAME = key
    WRITE_COLOR_MODE = 1

    ColorItemChange(CL_VALUE)
    ShowBackHint("Цвет типа выбран" & auCR & "Значения будут применятся к " & key)
#    OutputDebugString(GetState("vars"))
EndFunc

# не применять изменения цвета при смене элемента
Func ColorItemChange(ColorText)
Local h
    # очистка буфера при смене элемента
    ClipPut("") 
    h = WinFind(0, "TfrmColorPick")
    if h > 0 then
       # синхронизация текста       
       WinSetText(ColorText, WinFind(h, "TEdit", 1))         
    endif
EndFunc

Func OpenInTextEditor(Text)
Local h = 0

    ClipPut(Text)
    
    h = WinFind(0, "AkelPad4")
    If h > 0 Then
       ShellExec /SW_SHOWNORMAL %CL_AKEL4% '/Command(4101) /Command(4155)'
       Return
    Endif
    
    If Not FileExist(CL_AKEL4) Then 
       ShowHint("AkelPad не найден " & CL_AKEL4 & "Текст значений скопирован в буфер.")
    Else
       ShellExec /SW_SHOWNORMAL %CL_AKEL4% ' /Command(4155)'       
    Endif 
    
EndFunc

[/cut]
Для вызова меню код 70003. Я наконец зарезервировал коды до 70050, а то путаница уже с ними была. Теперь можно менять цвет для любого элемента

Чтобы избежать неожиданостей, сделал применения цвета только из буфера, но можно менять и в реальном времени, удерживая CTRL, когда открыта ColorMania. Есть очень приятный эффект от такого удерживания, когда фон возвращается к своему значению, если отпустить CTRL, не скопировав значение в буфер. В общем, уже лучше.) Ваш код с копированием кода кнопки я тоже добавил по Alt+Shift

Добавлено спустя 3 минуты:

Loopback
Я чуть позже отвечу.)

Orion9 писал(а):Я там заметил еще двойную косую черту

Тоже заметил и убрал на всякий случай.

Orion9 писал(а):Теперь можно менять цвет для любого элемента

Я ожидал чего-то подобного

Orion9 писал(а):Ваш код с копированием кода кнопки я тоже добавил по Alt+Shift

Поздно! У меня уже ваша панель для кнопок.

Orion9 писал(а):очень на вас расчитываю

Будет время, попробую. Вообще-то, у меня даже ColorMania отсутствовала...

sa
Когда вы писали про "TC_ColorMania", я подумал, что вы пробовали именно через ColorMania менять фон

В любом случае, в коде есть несколько неплохих наработок, которые можно использовать для реализации своих идей, хотя он еще сыроват и плохо протестирован. Но некоторые моменты получились лучше, чем я ожидал.)

И да, код копирования кнопки на Autorun (в данном случае - фона) тоже нужен, и это очень хороший пример идеи и ее реализации, который тоже можно впоследствии использовать как наработку

Loopback
Свалился сегодня пока один раз сам тихо в фоне. Но в этот раз даже с двумя MsgBox-и:

Код: Выделить всё

---------------------------
Error
---------------------------
Runtime error 216 at 076BFD0A
---------------------------
ОК   
---------------------------

Очень похоже, что сообщение от плагина какого-то идет, а не самого ТС. Пока отключил WinScriptAdv, потому как началось примерно с тех времен. Но мне кажется, что проблема может быть и с Autorun. Буду пока наблюдать, чего еще остается делать?

Я, по-моему, хайлайтер с вашего сайта скачивал, но по ссылке с форума. Думал, что это вы его делали. Но был еще хайлайтер от yozhic. В любом случае оба устарели

Orion9 писал(а):я подумал, что вы пробовали именно через ColorMania менять фон

Именно так: для экспериментов с предыдущим вашим кодом и установил ColorMania.

Orion9 писал(а):пример идеи и ее реализации

Как обычно, лень (не записывать же карандашом 8 цифр) - двигатель прогресса!