主页
Top.Mail.Ru Yandeks.Metrika
论坛:“WinAPI”;
当前存档:2002.07.25;
下载:[xml.tar.bz2];

向下

拖放。 试。 找到类似的分支


artgamer   (2002-05-19 15:41) [0]

Послушайте, Мастера. Я уже задавал этот вопрос, но так и не получил на него вразумительного ответа. Поэтому спрашиваю ещё раз - как мне сделать Drag&Drop на какой-нибудь элемент формы - например на Panel или SpeedButton. Я тут рылся по FAQ на разных сайтах и нашёл такой-же вопрос на "Королевстве Delphi". Ответ следующий:"проседуру
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
нужно писать не в форме, а в наследнике TPanel для панели и т.д."
Или вот ещё Anatoly Podgoretsky пишет: " 这应该在表单级别完成,如果有必要确定光标在某个元素上,那么获取鼠标的坐标" А как это сделать?
Я понимаю, возможно мой вопрос (да и я сам) кажется тупым, но поверьте - я никогда не стал-бы отвлекать людей от дела, если-бы мог разобраться сам.
С уважением, Artgamer.



Song   (2002-05-19 17:09) [1]

Дак Вы хотите сказать что WM_DROPFILES не срабатывает когда переносите файлы на форму приложения?



~Sergius   (2002-05-19 17:36) [2]

Лови компонент. Разберешься как сделан. Не обессудь, полчаса ушло на все дело - но работает.
Хотя, вообще-то, ФАКов на эту тему уже столько есть, что можно было бы и так разобраться (тем более сам принцип очень прост) :-)


unit smDropFile;

interface

uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs;

type
TOnFileDrop = procedure (var filename: string) of object;

TSmDropFile = class (TComponent)
private
FOldOnAppMessage: TMessageEvent;
FAcceptExtensions: TStrings;
FParent: TWinControl;
FAcceptAll: boolean;
FOnFileDrop: TOnFileDrop;
FOnWrongFileDrop: TOnFileDrop;

procedure SetAcceptExtensions (const Value: TStrings) ;
procedure OnAppMessage (var Msg: TMsg; var Handled: Boolean) ;
procedure SetAcceptAll (const Value: boolean) ;
procedure SetOnFileDrop (const Value: TOnFileDrop) ;
procedure SetOnWrongFileDrop (const Value: TOnFileDrop) ;

{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create (AOwner: TComponent) ; override;
destructor Destroy;
published
{ Published declarations }
property AcceptExtensions: TStrings read FAcceptExtensions write SetAcceptExtensions;
property AcceptAll: boolean read FAcceptAll write SetAcceptAll;
property OnFileDrop: TOnFileDrop read FOnFileDrop write SetOnFileDrop;
property OnWrongFileDrop: TOnFileDrop read FOnWrongFileDrop write SetOnWrongFileDrop;

end;

procedure Register;

implementation
{$R SMDROPFILE.RES}

uses ShellAPI;

procedure Register;
begin
RegisterComponents ("skaminski", [TSmDropFile] ) ;
end;

{ TSmDropFile }

constructor TSmDropFile.Create (AOwner: TComponent) ;
begin
inherited Create (AOwner) ;
FAcceptExtensions := TStringList.Create;
FParent := nil;
if AOwner is TForm then
FParent := AOwner as TForm;
if csDesigning in ComponentState then
FAcceptAll := True;

DragAcceptFiles (FParent.Handle, True) ; // Разрешаем родительской форме принимать файлы
FOldOnAppMessage := Application.OnMessage; // Запомним старый обработчик!
Application.OnMessage := OnAppMessage; // принимаем на себя все сообщения Windows
end;

destructor TSmDropFile.Destroy;
begin
Application.OnMessage := FOldOnAppMessage;
FAcceptExtensions.Free;
inherited Destroy;
end;

procedure TSmDropFile.OnAppMessage (var Msg: TMsg; var Handled: Boolean) ;
var acfilename: array[0..255] of char;
s: string;
i: integer;
begin
if (Msg.message = WM_DROPFILES) and (Msg.hwnd = FParent.Handle) then
begin
Handled := True;
dragqueryfile (msg.wParam, 0, acfilename, 255) ;

if (FAcceptAll) or
(FAcceptExtensions.IndexOf (UpperCase (ExtractfileExt (acfilename) ) ) <> -1) then
begin
if Assigned (FOnFileDrop) then
begin
s := acfilename;
FOnFileDrop (s) ;
end;
end
else
if Assigned (FOnWrongFileDrop) then
begin
s := acfilename;
FOnWrongFileDrop (s) ;
end;

dragfinish (msg.wParam) ;
end
else
Handled := False; // пускай себе летит дальше...
end;


procedure TSmDropFile.SetAcceptAll (const Value: boolean) ;
begin
FAcceptAll := Value;
end;

procedure TSmDropFile.SetAcceptExtensions (const Value: TStrings) ;
var i: integer;
begin
for i := 0 to Value.Count do
begin
Value[i] := UpperCase (Value[i] ) ;
end;
FAcceptExtensions.Assign (Value) ;
end;


procedure TSmDropFile.SetOnFileDrop (const Value: TOnFileDrop) ;
begin
FOnFileDrop := Value;
end;

procedure TSmDropFile.SetOnWrongFileDrop (const Value: TOnFileDrop) ;
begin
FOnWrongFileDrop := Value;
end;

end.





Lady BadnBadn   (2002-05-19 18:02) [3]

Пишите наследник и не забивайте себе голову



artgamer   (2002-05-19 18:16) [4]

>宋
Дак Вы хотите сказать что WM_DROPFILES не срабатывает когда переносите файлы на форму приложения?
Нет, этого я не говорю. Когда я переношу файлы на форму приложения WM_DROPFILES работает, но когда я переношу файлы на панель, которая лежит на форме приложения - НИЧЕГО не происходит!
>Lady BadnBadn
Пишите наследник и не забивайте себе голову
怎么样?



Song   (2002-05-19 18:23) [5]

В обработчике WM_DROPFILES считываете координаты мыши и сраниваете их с координатами SpeedButton (разброс на высоту и ширину кнопки оставьте). Если сравнение истинно значит перенос идёт на TSpeedButton. Вот это и имел ввиду Анатолий Подгорецкий.



artgamer   (2002-05-19 21:02) [6]

>宋
Я, может, чего-то не понимаю, но как мне считывать координаты мыши с обработчика WM_DROPFILES, если этот WM_DROPFILES не вызывается?



Song   (2002-05-19 21:05) [7]

Да с сообщения надо считать, а когда оно произойдёт. Считать координаты мыши - GetCursorPos()



Song   (2002-05-19 21:52) [8]

Забыл "не" добавить между "Да" и "с" :))



~Sergius   (2002-05-20 03:53) [9]

Казалось бы тему уже закрыли.
WM_DROPFILES отлавливает ФОРМА. В обработчике этого события определяем, как уже скзано координаты мышки. И по этим координатам определяем, над каким контролом курсор. ВСЕ!



artgamer   (2002-05-20 22:05) [10]

Ох! Умучался я! "В обработчике события, в обработчике события". А я, может, не знаю, что это вообще такое. И как мне считать, когда произойдёт сообщение, если сообщение не приходит совсем? Ну ладно буду лазить по FMDrop из LMD tools и по примеру ~Sergius`а - авось разберусь, как эта шняга работает.
Но всё равно спасибо, что пытались помочь. Код ~Sergius`а мне подходит, но уж больно здоровый - у проги лимит в 9000 строк, а у меня уже 8700 и всё растёт :). В общем, тему действительно можно считать закрытой, и я ТОРЖЕСТВЕННО ОБЯЗУЮСЬ ЭТОТ ВОПРОС БОЛЬШЕ НЕ ПОДНИМАТЬ! Ещё раз спасибо - и спокойной ночи.



Anatoly Podgoretsky   (2002-05-20 22:17) [11]

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



artgamer   (2002-05-20 23:03) [12]

>阿纳托利Podgoretsky
谢谢大家!



Страницы: 1 整个分支

论坛:“WinAPI”;
当前存档:2002.07.25;
下载:[xml.tar.bz2];

楼上









内存:0.6 MB
时间:0.044 c
14-81412
GydruS
2002-06-20 12:07
2002.07.25
在阴雨天气下,你能和女孩做些什么?


7-81487
- =基因绿= -
2002-05-01 11:56
2002.07.25
Оборудование


7-81505
e_Dimon
2002-05-05 12:20
2002.07.25
节能功能.....


3-81169
的LexA-m的
2002-07-04 08:42
2002.07.25
SW。 大师,最后解释


14-81468
亚历山大
2002-06-26 22:55
2002.07.25
Опрос





南非荷兰语 阿尔巴尼亚人 阿拉伯语 亚美尼亚 阿塞拜疆 巴斯克 白俄罗斯 保加利亚语 加泰罗尼亚 简体中文 中国(繁体) 克罗地亚 捷克 丹麦语 荷兰人 英语 爱沙尼亚语 菲律宾人 芬兰 法文
加利亚西语 格鲁吉亚语 德语 希腊语 海地克里奥尔语 希伯来语 印地语 匈牙利 北日耳曼语 印度尼西亚人 爱尔兰语 意大利语 日本性玩偶 韩语 拉脱维亚 立陶宛 马其顿 马来语 马耳他语 挪威语
波斯语 波兰语 葡萄牙语 罗马尼亚 俄语 塞尔维亚 斯洛伐克 斯洛文尼亚 西班牙语 斯瓦希里 瑞典语 泰国人 土耳其 乌克兰 乌尔都语 越南人 威尔士语 意第绪语 孟加拉 波斯尼亚
宿务 世界语 古吉拉特语 豪萨语 苗族 伊博 爪哇 卡纳达语 高棉 老挝 拉丁语 毛利 马拉 蒙古人 尼泊尔 旁遮普 索马里 泰米尔人 泰卢固语 约鲁巴语
祖鲁
英文 Французский Немецкий Итальянский Португальский 俄文 Испанский