-
Доброе время суток.
Как получить имена выделенных файлов? На рабочем столе есть "куча" созданных файлов одного типа. Выделяем курсом чтобы в дальнейшем объединить их в один файл.
-
Имеется ввиду не drag and drop. А именно Выделение и нажатие клавиши. "Остальное дело техники".
-
И формы тоже нет только applet. Эх никого нет чтоб толковый дать совет.:(
-
Доброе время суток. По порядку. Чтобы получать файлы используют функцию DragQueryFile модуля ShellAPI. получилось следующие: 1. копируем файлы *.txt в буфер обмена 2. переходим в applet 3. жмем клавишу "O" и получаем общий файл tst.txt вот код:
program Project1;
uses
windows,messages,
kol,shellapi;
var SL: PStrList;S:String;
function file2str(filename:string):string;
var f2: textfile;
s2:string;
begin
result := '';
if fileexists(filename) then
begin
S2:='';
assignfile(f2,filename);
reset(f2);
while not eof(f2) do
begin
readln(f2,s2);
result := result + s2+#13#10;
end;
closefile(f2);
end;
End;
procedure unitetextfiles(Dummy : Pointer; Sender: PControl; var Key: Integer;
Shift: Cardinal);
var
f: THandle;
buffer: array [0..MAX_PATH] of Char;
i, numFiles: Integer;
begin
if key=27 then applet.Close;
if key=79 then begin
SL := NewStrList;
if not OpenClipboard( Applet.GetWindowHandle ) then Exit;
OpenClipboard(0);
try
if IsClipboardFormatAvailable( CF_HDROP )then
f := GetClipboardData(CF_HDROP);
if f <> 0 then
begin
numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);
S:='';
for i :=numfiles - 1 downto 0 do
begin
buffer[0] := #0;
DragQueryFile(f, i, buffer, SizeOf(buffer));
S:=s + file2str(buffer);
end;
end;
SL.Text := S;
SL.SaveToFile( 'tst.txt' );
SL.Free;
finally
CloseClipboard;
end;
end
end;
Begin
Applet := NewApplet( 'Unite text'+#39+'s ' );
applet.OnKeyDown := TOnKey( MakeMethod( nil, @unitetextfiles ) );
Run(Applet);
end.
Два не больших вопроса. Можно ли отправлять выделенные файлы на рабочем столе из программы в буфер обмена программно? Второй вопрос: Хотел сделать горячую клавишу вместо кеydown взял пример в мск он работает, а в кол почему-то нет. Как поправить? пример:
program Project1;
uses
windows,messages,
kol;
type TOnEvent = procedure( Sender: PObj )of object;
var
form:PControl;
function FormMessage(Dummy : Pointer;var Msg: tagMSG; var Rslt: Integer): Boolean;
begin
case Msg.message of
WM_HOTKEY:
begin
case Msg.wParam of
1:Form.Visible:=false;
2:Form.Visible:=true;
end;
end;
end;
Result := False;
end;
procedure FormClose(Dummy : Pointer; Sender: PControl; var Accept: Boolean);
begin
UnRegisterHotkey(form.Handle, 1);
UnRegisterHotkey(form.Handle, 2);
end;
Begin
form:=NewForm(Applet,'hot key').SetSize(300,200).setposition(330,300);
form.OnMessage:=TOnMessage(MakeMethod(nil,@FormMessage));
form.OnClose:=TOnEventAccept(MakeMethod(nil,@FormClose));
RegisterHotkey(form.Handle, 1, MOD_ALT or MOD_SHIFT, VK_F4);
RegisterHotkey(form.Handle, 2, MOD_ALT or MOD_SHIFT, VK_F5);
applet:=form;
Run(applet);
end.
-
Можно ли отправлять выделенные файлы на рабочем столе из программы в буфер обмена программно?
----------------------------------
Ответ: можно. Добраться до окна SHELLDLL_DefView - это окно - родитель листвью рабочего стола, ЕМНИП. В общем, погуглите. Много примеров на бэйсике попадается, разобраться можно. Ну, с листвью как работать, надеюсь, объяснять не надо.
Второй вопрос: Хотел сделать горячую клавишу вместо кеydown
взял пример в мск он работает, а в кол почему-то нет. Как поправить?
===========================
Список параметров неполный у обработчика. Dummy, затем Sender, потом все остальное.
-
Доброе время суток. function FormMessage(Dummy : Pointer;Sender: PControl;var Msg: tagMSG; var Rslt: Integer): Boolean; Вызывает "access violation at ... : read of address ... . " Спасибо, погуглим.
-
Уточняю: Kol_ASM.inc
function TControl.WndProc( var Msg: TMsg ): Integer;
...
RET строка 8347 +F7
"access violation at ... : read of address ... . "
-
Доброе время суток. Нашел почему не работает. Кстати Sender: PControl; оказался не причём вот без этого не работает уж не знаю почему:) -> .centeronparent то есть form:=NewForm(Applet,'hot key').SetSize(300,200).centeronparent;
-
CenterOnParent вызывает создание окна для формы, т.к. центрировать он может только окно с хэндлом. Намек ясен?
-
Доброе время суток. Вот такой вопрос. нашел как передавать названия файлов выделенных на рабочем столе на примере с memo. вариант vcl: http://slil.ru/29356827и кол: program Project1;
uses
windows,
kol;
var
form,Button,Memo:PControl;
function GetDesktopListViewHandle: 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;
function ListView_GetItemCount(hWnd: HWND): Integer;
begin
Result := SendMessage(hWnd, LVM_GETITEMCOUNT, 0, 0);
end;
function ListView_GetSelectedCount(hwndLV: HWND): UINT;
begin
Result := SendMessage(hwndLV, LVM_GETSELECTEDCOUNT, 0, 0);
end;
procedure clickbutton(Sender:PControl; var mouse:TMouseEventData);
var
process: Cardinal;
r : TRect;
hWnd : THandle;
Count, selcount : Integer;
I: Integer;
txt : String;
_Item: PKOL_Char;
lvi: TLVITEM;
_lvi: PLVITEM;
pid: longint;
Written: dword;
begin
Memo.Clear;
hWnd := GetDesktopWindow();
GetWindowRect(hWnd,r);
Memo.Add('Bottom: ' + Int2Str(r.Bottom)+#13#10);
Memo.Add('Right: ' + Int2Str(r.Right)+#13#10);
hWnd := GetDesktopListViewHandle;
Count := ListView_GetItemCount(hWnd);
selCount:=ListView_GetSelectedCount(hwnd);
Memo.Add('Total icons: ' + Int2Str(Count)+#13#10);
Memo.Add(''+#13#10);
if selCount=0 then Memo.Add('NoSelected icons: '+#13#10) else
Memo.Add('Selected icons: ' + Int2Str(selCount)+#13#10);
GetWindowThreadProcessId(hwnd, @pid);
process:=OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION, FALSE, pid);
_lvi:=VirtualAllocEx(process, nil, sizeof(TLVITEM),MEM_COMMIT, PAGE_READWRITE);
_item:=VirtualAllocEx(process, nil, 255, MEM_COMMIT,PAGE_READWRITE);
SetLength(txt, 255);
lvi.cchTextMax:=255;
for i:=0 to count-1 do
if BOOL(SendMessage(hWnd, LVM_GETITEMSTATE, i, LVIS_SELECTED)) then
begin
lvi.iSubItem:=0;
lvi.pszText:=_item;
WriteProcessMemory(process, _lvi, addr(lvi), sizeof(TLVITEM), Written);
SendMessage(hwnd, LVM_GETITEMTEXT, wParam(i), lParam(_lvi));
ReadProcessMemory(process, _item, PChar(txt), 255, Written);
memo.Add(txt)
end;
end;
Begin
form:=NewForm(Applet,'Dectop to memo').SetClientSize( 406, 252 ).centeronparent;
Button := NewButton( form, 'Список' ).SetPosition( 230,6 );
Memo := NewEditBox( form, [ eoMultiline, eoNoHScroll ] ).SetPosition( 8,38 ).SetClientSize( 377, 200);
Memo.Color := clWindow;
Memo.Text := '';
Button.OnClick:=TonEvent(MakeMethod(nil,@clickbutton));
Run(form);
end.
код одинаковый, но в кол почему то после нахождения 1 выделенного добавление в memo прекращается :) Чего не хватает чтобы работало нормально?
-
Отслеживай переменные. Правка: memo.Add(Trim(txt) + #13#10)
-
Теперь нормально, работает:)
2MTsv DN Спасибо!
-
Доброе время суток. Вот такой вопрос. Пытаюсь в примере используя пути к файлам объединить их в один. Вот через буфер обмена всё работает, а вот через пути без буфера не хочет не пойму в чём загвоздка? вот код: program Project1;
uses
windows,messages,
kol,shellapi;
var SL: PStrList;S,s3:String;
function GetDesktopListViewHandle: 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;
function ListView_GetItemCount(hWnd: HWND): Integer;
begin
Result := SendMessage(hWnd, LVM_GETITEMCOUNT, 0, 0);
end;
function ListView_GetSelectedCount(hwndLV: HWND): UINT;
begin
Result := SendMessage(hwndLV, LVM_GETSELECTEDCOUNT, 0, 0);
end;
function file2str(filename:string):string;
var f2: textfile;
s2:string;
begin
result := '';
if fileexists(filename) then
begin
S2:='';
assignfile(f2,filename);
reset(f2);
while not eof(f2) do
begin
readln(f2,s2);
result := result + s2+#13#10;
end;
closefile(f2);
end;
End;
function FormMessage(Dummy : Pointer;var Msg: tagMSG; var Rslt: Integer): Boolean;
begin
case Msg.message of
WM_HOTKEY:
begin
case Msg.wParam of
1:Applet.Visible:=false;
2:Applet.Visible:=true;
end;
end;
end;
Result := False;
end;
function sysvar_2_folder(sysvar :String) :String;
var buf : array[0..$FF]
of char; Size : integer;
begin
Size := ExpandEnvironmentStrings(PChar(sysvar), buf, sizeof(buf));
Result := copy(buf, 1, Size);
end;
procedure unitetextfiles(Dummy : Pointer; Sender: PControl; var Key: Integer;
Shift: Cardinal);
var
process: Cardinal;
hWnd : THandle;
Count, selcount : Integer;
I: Integer;
txt : String;
_Item: PKOL_Char;
lvi: TLVITEM;
_lvi: PLVITEM;
pid: longint;
Written: dword;
begin
if key=27 then applet.Close;
if key=79 then begin
s:='';
hWnd := GetDesktopListViewHandle;
Count := ListView_GetItemCount(hWnd);
selCount:=ListView_GetSelectedCount(hwnd);
if selCount=0 then s3:=s3+' NoSelected icons: '+#13#10 else
s3:=s3+' Selected icons: ' + Int2Str(selCount)+#13#10;
SL := NewStrList;
GetWindowThreadProcessId(hwnd, @pid);
process:=OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION, FALSE, pid);
_lvi:=VirtualAllocEx(process, nil, sizeof(TLVITEM),MEM_COMMIT, PAGE_READWRITE);
_item:=VirtualAllocEx(process, nil, 255, MEM_COMMIT,PAGE_READWRITE);
SetLength(txt, 255);
lvi.cchTextMax:=255;
for i:=0 to count-1 do
if BOOL(SendMessage(hWnd, LVM_GETITEMSTATE, i, LVIS_SELECTED)) then
begin
lvi.iSubItem:=0;
lvi.pszText:=_item;
WriteProcessMemory(process, _lvi, addr(lvi), sizeof(TLVITEM), Written);
SendMessage(hwnd, LVM_GETITEMTEXT, wParam(i), lParam(_lvi));
ReadProcessMemory(process, _item, PChar(txt), 255, Written);
SL.Text:=SL.Text+file2str(sysvar_2_folder('%USERPROFILE%\Рабочий стол\'+Trim(txt)+'.txt'#13#10));
end;
SL.SaveToFile( 'tst.txt' );
SL.Free;
end;
end;
procedure FormClose(Dummy : Pointer;Sender: PControl; var Accept: Boolean);
begin
UnRegisterHotkey(Applet.Handle, 1);
UnRegisterHotkey(Applet.Handle, 2);
end;
Begin
Applet := NewApplet( 'Unite text'+#39+'s ' ).centeronparent;
applet.OnKeyDown := TOnKey( MakeMethod( nil, @unitetextfiles ) );
Applet.OnMessage:=TOnMessage(MakeMethod(nil,@FormMessage));
Applet.OnClose:=TOnEventAccept(MakeMethod(nil,@FormClose));
RegisterHotkey(Applet.Handle, 1, MOD_ALT or MOD_SHIFT, VK_F4);
RegisterHotkey(Applet.Handle, 2, MOD_ALT or MOD_SHIFT, VK_F5);
Run(Applet);
end.
и в tst.txt в итоге 0. Хотя должен быть текст.
-
В sysvar_2_folder фигню передаете.
-
> Дмитрий К © (29.06.10 00:38) [13]
>
> В sysvar_2_folder фигню передаете.
Путь в sysvar_2_folder получается, но дальше ничего не идёт.
то бишь
sysvar_2_folder('%USERPROFILE%\Рабочий стол\'+Trim(txt)+'.txt'#13#10)
даёт пути к файлам с именами и расширением.
C:\Documents and Settings\Семья.D179777B4E904BC\Рабочий стол\файл1.txt
C:\Documents and Settings\Семья.D179777B4E904BC\Рабочий стол\файл2.txt
...
C:\Documents and Settings\Семья.D179777B4E904BC\Рабочий стол\27.txt
пытаюсь передать путь file2str(filename:string):string и 0
-
Пошаговая отладка с остановкой на проблемной строчке и просмотром содержимого переменных спасет.
-
Спасибо, с чуток покапавшись получил следующее:
sysvar_2_folder('%USERPROFILE%') + '\Рабочий стол\' + Trim(txt);
Правда на моем компе почему-то не кактит такой вариант, нужен
sysvar_2_folder('%USERPROFILE%')+'\Рабочий стол\'+Trim(txt)+'.txt'
#13#10 это почему-то ему не нравится? Всем Спасибо.
-
+'.txt'
- вот это не знаю, для чего нужно у вас, но у меня приводит к тому, что далее проверка на FileExists всегда возвращает false, и то, что написано внутри if, никогда не отрабатывает.
-
На компьютере дома Trim(txt) даёт только название без расширения. Поэтому и приходится добавлять +'.txt'.
На работе Trim(txt) работает также как и у Вас (файл сразу с расширением).
Как учесть эту разницу?
-
Во-1, если программа компилируется (а не запускается только exeшник) на обеих машинах, то убедиться, что на обоих компьютерах версии kol.pas + kol_asm.inc совпадают. Во-2, убедиться, что значение переменной txt одинаковое. А вы, случайно, не .lnk-файлы выделяете? Когда выделен ярлык, то возвращается путь на файл ярлыка, но без расширения .lnk, тогда понятно, почему приходится добавлять левое расширение. Но вот еще ш ютка, не знаю, то ли в семерке такая, то ли всегда: FileExists не работает, даже после исправления кода на SL.Text:=SL.Text+file2str(
sysvar_2_folder('%USERPROFILE%\Рабочий стол\'+Trim(txt)))+#13#10;
Мне это показалось странным, я создал текстовой документ, и посмотрел, что получается. Получается 'C:\Users\Vlad\Рабочий стол\Новый текстовый документ.txt' Открываю проводник, начинаю идти по дереву с корня, он мне рисует C:\Users\Vlad\Desktop\... А если по дереву идти, то Локальный диск (C:) - Пользователи - Vlad - Рабочий стол ... Выделяю путь в адресной строке, он мне опять рисует с Desktop, вот такие пироги. Т.е. приплюсовывать надо на Рабочий стол, а Desktop. С Desktop работает, по крайней мере текст в tst.txt сбрасывается.
|
Есть новые 
Нет новых [134430 +2][b:0][p:0.007]