Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > Прозрачный фон иконок на Рабочем Столе

Автор: JusTalionis 25.9.2006, 16:57

и как это сделать в VB?

ЗЫ: для Win9X разумеется; (XP сама по себе это умеет.)

Автор: amt 26.9.2006, 21:34

А ты где-нибудь искал?
Я где-то это видел. Кто-то выкладывал пример, вот только не помню - то ли ехе-ник, то ли код. Поищи на форуме и в инете.

Автор: JusTalionis 27.9.2006, 10:56

На Винграде искал, причем в первую очередь! Но по ключевому слову "прозрачный" не нашлось ничего. smile

Если ты знаешь где - кинь ссылочку, коль не внапряг.
В Нете искал - нашлось только куча самописных утилит, которые делают это. Размер примерно в 20К, т.е. чё-то небольшое - типа запуска API может быть?

Если код у кого есть - поделитесь, плизззз! А екзешник мне как-то никчему, - в лом его ломать smile

Автор: ~FoX~ 28.9.2006, 08:38

Идея такова:
Поверх картинки на рабочем столе лижит ListView на котором собственно иконки и держуться....
Получаем хэндл этого диста и шлем ему месагу о смене цвета на нейтральный

Код модуля:

Код


Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 'ищем окно
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String) As Long

Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _ 'ищем окно
        (ByVal hwndParent As Long, _
        ByVal hwndChildAfter As Long, _
        ByVal lpszClass As Any, _
        ByVal lpszWindow As Any) As Long


Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ 'шлем месаджь
        (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any) As Long

Код формы:

Код


Private Sub Command1_Click()
Dim SLV As Long ' хэндл SysListView32
Dim col As Long 'сюда будем складывать ошибку
Const CLR_NONE = &HFFFFFF 'прозрачный цвет фона иконок
Const LVM_SETTEXTBKCOLOR = 4134 'магическое число
Const LVM_UPDATE = 4138 'еще одно магическое число (взяты мз МСДН-а)

SLV = FindWindow("Progman", "Program Manager") 'ищем окно класса Progman
SLV = FindWindowEx(SLV, nil, "SHELLDLL_DefView", "") 'внутри него ищем SHELLDLL_DefView
SLV = FindWindowEx(SLV, nil, "SysListView32", "") 'И наконец получаем хэндл нашего SysListView32

col = SendMessage(SLV, LVM_SETTEXTBKCOLOR, 0, CLR_NONE) ' шлем месагу на замену цвета
col = SendMessage(SLV, LVM_UPDATE, 1, 0) 'не забываем про апдейт 

End Sub

Если чесно мне не удалось заставить правильно работать этот код, у меня цвет становился кислотно зеленым, но думаю это не большая проблема, просто гдето с константами напутал...Но общая идея верная, так что дерзай.....Удачи.

Хотя этот код перенесенный с рабочего кода делфи...

Автор: JusTalionis 28.9.2006, 13:51

Пасиб, попробую покрутить это дело; если получится, отпишу.

ЗЫ: Отдельное БОЛЬШОЕ СПАСИБО за комменты в коде!!!

Автор: JusTalionis 29.9.2006, 10:47

Вторая часть марлезонского балета.

Проверил: действительно, цвет фона устанавливается зеленым, и причем только на тех местах, которые были закрыты формой или чем-нибудь - то есть апдейт не происходит.
Однако то, что этот цвет вообще меняется, показывает, что доступ к ListView все-таки получен правильно.
Очевидно, "сообщение" на изменение цвета и апдейт посылается неверно. Попробовал поменять значение CLR_NONE и "магические числа" - но цвет все равно не менялся.
Где могла бы быть ошибка? Цвет посылается через lParam. Я предположил, что в Declare перед ним пропущено ByVal, и вставил его. Компилятор немедленно выдал ошибку "несовпадение типов". Учитывая, что через lParam передаются числа, я установил ему As Long (вместо As Any).
И вот тогда цвет начал меняться! smile

Поэкспериментировав с различными значениями, я нашел, что цвет прозрачности равен &HFFFF, а не &HFFFFFF (это же не хтмл!).
В конечном счете, код получился таким:

Код


Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long) As Long

Код


Const CLR_NONE = &HFFFF

Но апдейт все равно не делается!!!! Я не мог найти, почему.
Проверил значения col - оба равны единице. Не знаю что она означает, но в моем дилетантском понимании, отсутствие ошибки обычно индицируется нулем.
Друзья, помогайте, кто знает! До победного осталось чуть-чуть smile

Автор: ~FoX~ 29.9.2006, 17:15

Цитата(JusTalionis @ 29.9.2006, 11:47

)

не &HFFFFFF (это же не хтмл!).

Странно, мне казалось RGB оно и есть RGB...Тем более странно что &HFFFF уж точно никак не лонг smile

Цитата(JusTalionis @ 29.9.2006, 11:47

)

установил ему As Long (вместо As Any).

Дозволительно конечно, но тоже странно, наверное надо было явный тип описывать

Цитата(JusTalionis @ 29.9.2006, 11:47

)

Проверил значения col - оба равны единице. Не знаю что она означает, но в моем дилетантском понимании, отсутствие ошибки обычно индицируется нулем.

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

Вот что говорит МСДН про апдейт:

Цитата

This message updates a list-view item. If the list-view control has the LVS_AUTOARRANGE style, this macro causes the list-view control to be arranged. You can send this message explicitly or by using the ListView_Update macro.

Попробуй в первом параметре передать 0, или в цикле проапдейтить все элементы листа. Количество итемов тебе вернет LVM_GETITEMCOUNT

Автор: JusTalionis 29.9.2006, 18:27

Цитата(JusTalionis @ 29.9.2006, 11:47

)

не &HFFFFFF (это же не хтмл!).
Странно, мне казалось RGB оно и есть RGB...Тем более странно что &HFFFF уж точно никак не лонг smile

Я исходил не из типа числа, а из типа, который хочет функция (а они почти все требуют Long)

Цитата(JusTalionis @ 29.9.2006, 11:47

)

установил ему As Long (вместо As Any).
Дозволительно конечно, но тоже странно, наверное надо было явный тип описывать

А это какой такой?

Вот что говорит МСДН про апдейт:

Цитата

Буковок много! И все незнакомые! Еще раз и по-русски smile

Попробуй в первом параметре передать 0,

пробовал по-всякому, и нули, и единицы, - нифига.

или в цикле проапдейтить все элементы листа. Количество итемов тебе вернет LVM_GETITEMCOUNT smile

А его сам неужели проапдейтить нельзя?

Автор: ~FoX~ 30.9.2006, 11:51

Цитата(JusTalionis @ 29.9.2006, 19:27

)

This message updates a list-view item

Ну примерный перевод:
Это сообщение обнавляет элимент listview-а. Если контрол имеет вид список и стиль АВТОУПОРЯДОЧЕНИЯ, эта макрокоманда заставляет контрол переупорядочить списк. Вы можете посылать это сообщение явно или, используя макрос ListView_Update.

Под рукой нету компилятора поэтому проверить не могу:

Код


Const LVM_GETITEMCOUNT As Long = &H1004
Const LVM_REDRAWITEMS as Long = 4117
IconCount = SendMessage(SLV, LVM_GETITEMCOUNT, 0, 0) ' получаем количество итемов...
col = SendMessage(SLV, LVM_REDRAWITEMS, 0, IconCount-1) ' левый параметр первый итем для обнавления
'правый соответственно последний итем....

Цитата(JusTalionis @ 29.9.2006, 19:27

)

А это какой такой?

Примерно так:

Код


Const CLR_NONE as Long= &HFFFF

А в объявлении функции оставить as Any.....Ну вобщем то не морочься по этому поводу smile

Вот тут в голову пришло:
ListView не имеет собственного апдейта...но т.к. он является наследником TWinControl (или как там базовые классы обозначаются в ВБ) можно использовать месагу UpdateWindow....

Автор: JusTalionis 2.10.2006, 14:29

Ну не верится просто, чтоб собственного апдейта не было!.. Билл конечно Гейтс, но не настолько же!.. smile

Так что, я сосредоточился на поиске ошибок в строке апдейта. Ну что там могло быть?.. 1 и 0 я быстренько попробовал менять, как писал уже. Значит - только "магическое число" остается. Но какое именно оно должно быть - я не знал, и стал пробовать все подряд smile

Оказалось, есть какие-то, которые выстраивают значки то ли по алфавиту, то ли еще как, на других эксплорер "выполнил недопустимую операцию" короче, я чуть весь Рабочий Стол себе не порушил smile

но нужное нашел: 4161 делает апдейт.
Но почему-то не делает его под режимом "показывать стол как веб-страницу". В этом минус подобных шаманских методов: никогда не знаешь, где именно они перестанут работать smile

Кто знает: как правильно? - откликнитесь!!! smile

А вот про наследование - оч интересная мысль! Кто-нибудь может практический код написать? smile

Автор: cardinal 3.10.2006, 00:42

Модератор: Прикольные у вас тут дискуссии. Как добьетесь нужного результата напишите, пожалуйста, статейку для FAQ'a.

Автор: ~FoX~ 3.10.2006, 08:19

cardinal, Да без проблем smile

Автор: ~FoX~ 4.10.2006, 07:51

Цитата(JusTalionis @ 2.10.2006, 15:29

)

но нужное нашел: 4161 делает апдейт.

Гмм.....не хочиться тебя расстраивать, но это не является апдейтом.....

Цитата

LVM_FIRST = &H1000
1461 - &H1000 = 65
LVM_SETWORKAREAS = (LVM_FIRST + 65)

MSDN:
LVM_SETWORKAREAS
wParam = (WPARAM)(INT) nWorkAreas;
lParam = (LPARAM)(LPRECT) lprc;

Parameters
nWorkAreas
The number of structures in the array at lprc. The maximum number of working areas allowed is defined by the LV_MAX_WORKAREAS value.
lprc
Address of an array of RECT structures that contain the new working areas of the list-view control. Values in these structures are in client coordinates. If this parameter is NULL, the working area will be set to the client area of the control. nWorkAreas specifies the number of structures in this array.

Автор: ~FoX~ 4.10.2006, 10:37

Небольшие ковыряния привели меня к выводу, что в то время как в ключен актив дисктоп, поверх нашего SysList-a лежит еще одно полноэкранное приложение и манипулировать нужно уже им....
А как это делать я пока не знаю smile

Точнее я не знаю класс верзнего окна.....

Вот что вышло у меня при отключенном АД:
Модуль:

Код


Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
        (ByVal hwndParent As Long, _
        ByVal hwndChildAfter As Long, _
        ByVal lpszClass As Any, _
        ByVal lpszWindow As Any) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long) As Long

Public Declare Function UpdateWindow Lib "user32" _ 
        (ByVal hwnd As Long) As Boolean 'вот такой апдейт листа ИМХО красивше выглядит

Кнока

Код


Dim SLV As Long ' хэндл SysListView32
Dim col As Long 'сюда будем складывать ошибку
Dim u As Integer
Dim IconCount As Integer

Const CLR_NONE = &HFFFFFFFF 'прозрачный цвет фона иконок
Const LVM_SETTEXTBKCOLOR = 4134 'магическое число
Const LVM_UPDATE = 4138 'еще одно магическое число (взяты мз МСДН-а)

Const LVM_GETITEMCOUNT As Long = 4100 ' получаем количество иконок
Const LVM_REDRAWITEMS As Long = 4117 ' перерисовываем иконки

SLV = FindWindow("Progman", "Program Manager") 'ищем окно класса Progman
SLV = FindWindowEx(SLV, nil, "SHELLDLL_DefView", "") 'внутри него ищем SHELLDLL_DefView
SLV = FindWindowEx(SLV, nil, "SysListView32", "") 'И наконец получаем хэндл нашего SysListView32
col = SendMessage(SLV, LVM_SETTEXTBKCOLOR, 0, CLR_NONE) ' шлем месагу на замену цвета

IconCount = SendMessage(SLV, LVM_GETITEMCOUNT, 0, 0) ' получаем количество итемов...

col = SendMessage(SLV, LVM_REDRAWITEMS, 0, IconCount - 1) 'перерисовали
'col = SendMessage(SLV, LVM_UPDATE, 1, 0) 'Можно использовать такой апдейт
' или вот такой:
u = UpdateWindow(SLV) 'вернет не 0 если отработал правильно

Автор: JusTalionis 4.10.2006, 13:23

~FoX~:

Цитата

Гмм.....не хочиться тебя расстраивать, но это не является апдейтом.....

Чё-й-то мне расстраиваться: оно ж апдейтит! - "Хоть горшком назови..."(©народное).
Кста, попробовал твой вариант с перерисовкой всех итемов. Твой код без изменений, сработал сразу же! Но, к сожалению, в "режиме веб-страницы" так же точно - не апдейтит.
Твой сегодняшний код тож попробую; что наблюдается - отпишу.

cardinal:
По этой теме ФАК написать не могу, так как сам еще толком не понимаю, но даже и найденный вариант пока еще - "шаманство": то есть, как работает в деталях не ясно, поэтому не может быть рекомендовано другим, так как надежно не известно, заработает ли у них как надо.

Но могу предложить в ФАК два других своих поста:
http://forum.vingrad.ru/index.php?showtopic=106860 и
http://forum.vingrad.ru/index.php?showtopic=104868
Изложенное там проверено мною лично на различных машинах.

Автор: ~FoX~ 4.10.2006, 14:14

Цитата(JusTalionis @ 4.10.2006, 14:23

)

Он не совсем апдейтит, тоесть он сначала делает этот самы SETWORKAREAS, а уже он в свою очередь вызывает редрав и апдейт.

А вот с актив дисктопом надо разбираться, там все сложнее, точнее принцип то то т же, но вот чем там сверху накрывается этот лист я пока не разобрался...Просто пока времени нет, может на днях займусь.

З.Ы. За фак не боись, я уже накатал небольшую статейку, и Кардиналу отписал...Если хочешь могу скинуть тебе на почитать...Может ты чем ее дополнишь.

Автор: cardinal 4.10.2006, 23:28

~FoX~, я тебе отписал.
JusTalionis, посмотрю.

Пока напряг со временем, так что не торопитесь... smile

Автор: JusTalionis 6.10.2006, 11:00

~FoX~
Проверил твой код. Перерисовка значков (как уже писал) работает, а этот код, хотя и "выглядит красивше", но не действует:

Код

col = SendMessage(SLV, LVM_UPDATE, 1, 0) 'Можно использовать такой апдейт
' или вот такой:
u = UpdateWindow(SLV) 'вернет не 0 если отработал правильно

несмотря на то, что u=1

Цитата(cardinal @ 4.10.2006, 23:28)

JusTalionis, посмотрю.
Пока напряг со временем, так что не торопитесь... smile

А я и не тороплюсь: посты ведь никуда с форума не денутся smile

...без ведома модераторов smile

Автор: cardinal 6.10.2006, 22:20

~FoX~, в какой раздел FAQ'а лучше думаешь твою статью вставить?

Автор: ~FoX~ 7.10.2006, 10:01

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

Автор: cardinal 7.10.2006, 14:23

http://vingrad.ru/VB-ART-003067
Подредактирую потом...

Автор: JusTalionis 16.10.2006, 15:07

Всем добрый день, дорогие друзья! smile

Позвольте вас познакомить с моей прогой, о которой я так ломал здесь копья smile

http://igrocvet.ru/soft/A-Wallp.zip

(она же - из топика о временном файле http://www.forum.vingrad.ru/index.php?showtopic=103664&view=all )

Собственно, прога была готова уже давно, но я никак не мог найти, где ее выложить (наверное и там недолго задержится).

Дарю всем безвозмездно! smile

Кому не в лом, проверьте, нормально ли она у Вас будет работать; если что, отпишитесь, плиииииз!..

~FoX~:
На ActiveX - плюнул!.. ведь что-ж делать, нету идеального на свете!.. хотя, хотелось бы smile

Апдейт сделал не перерисовкой всех иконок, как ты, а через свое "неправильное" 4161. Вроде работает.

Еще раз, всем помогавшим - БОЛЬШОЕ СПАСИБО!