Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi

Дата: 11.02.02 16:43


Доступ к иконкам


Всё перетянуто из CommCtrl.pas

uses CommCtrl;
var i, k:Integer;
XYold,  XY : Array[1..100] of TPoint;
CurPos:TPoint;

Сначала получаем Handle DeskTop'a:

function GetHandle: THandle;
var
 S: String;
begin
 Result := FindWindow('ProgMan', nil);
 Result := GetWindow(Result, GW_CHILD);
 Result := GetWindow(Result, GW_CHILD);
 SetLength(S, 40);
 GetClassName(Result, PChar(S), 39);
 if PChar(S) <> 'SysListView32' then Result := 0;
end;

Считаем количество иконок на столе:

...
i:=SendMessage(GetHandle,LVM_GETITEMCOUNT,0,0);
...

Получаем координаты иконок на столе. Как оказывается, это самое трудное.
Если посмотреть код GETITEMPOSITION в CommCtrl.pas, то его повтор в Delphi почему-то не работает. Т.е. он работает, но непонятно как:))
Поэтому делаем так:

function GetXY(hwndLV: HWND; i: Integer; var ppt:
TPoint): Bool;
var PointBuf : ^TPoint;
begin
try
PointBuf := VirtualAlloc(NIL,Sizeof(TPoint),
$8000000 or MEM_COMMIT, PAGE_READWRITE);
Result := Bool( SendMessage(hWndLV,
LVM_GETITEMPOSITION, i, Longint(PointBuf)));
if Result then begin
ppt.x := PointBuf^.x;
ppt.y := PointBuf^.y;
              end;
finally
VirtualFree(PointBuf,0,MEM_RELEASE);
end;
end;
...

Сохраняем координаты иконок в XYold:

for k:=1 to i do GetXY(GetHandle,k-1,XYold[k]);

Иконка с индексом 0 - всегда "Мой компьютер",
остальные - у кого как:))
...
А вот, как по таймеру двигать иконки туда-сюда, если
подвести к ним курсор:

procedure TForm1.Timer1Timer(Sender: TObject);
var k:Integer;
begin
GetCursorPos(CurPos);
for k:=1 to i do begin
GetXY(GetHandle,k-1,XY[k]);
if (CurPos.x>XY[k].x+4) and (CurPos.xand (CurPos.y>XY[k].y+4) and (CurPos.ythen begin
SendMessage(GetHandle,LVM_SETITEMPOSITION,k-1,MakeLong(XY[k].x+Random(64)-Random(64),
XY[k].y+Random(64)-Random(64)));
end;
end;
end;
...


И, наконец, возвращаем все иконки на место перед
завершением программы:

procedure TForm1.FormDestroy(Sender: TObject);
var k:Integer;
begin
for k:=1 to i do
SendMessage(GetHandle,LVM_SETITEMPOSITION,k-1,MakeLong(XYold[k].x,XYold[k].y));
end;

Может быть эти фрагменты кому-нибудь помогут:)))
А моя программка до сих пор валяется на
http://freesoft.kulichki.net/katalog/ufen/5003.html

Yurik Yura (copyr25@yahoo.com)

Чтобы вернуться оцените этот вопрос/ответ:
   

Прислать свои комментарии


Новое на сайте

Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо