paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-14 17:52:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

Qt: introduced Drop Files Event feature.

Browse Source 
git-svn-id: trunk@18615 -
This commit is contained in:
zeljko 2009-02-09 09:22:44 +00:00
parent deba377a63
commit b5e43b5d77
2 changed files with 94 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
lcl/interfaces/qt/qtwidgets.pas
View File

@ -435,7 +435,10 @@ type
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
function IsMdiChild: Boolean;
procedure OffsetMousePos(APoint: PQtPoint); override;
procedure SlotWindowStateChange; cdecl;
function getAcceptDropFiles: Boolean;
procedure setAcceptDropFiles(AValue: Boolean);
function slotDropFiles(Sender: QObjectH; Event: QEventH): Boolean;
procedure slotWindowStateChange; cdecl;
procedure setShowInTaskBar(AValue: Boolean);
public
procedure AttachEvents; override;
@ -4061,6 +4064,14 @@ begin
BeginEventProcessing;
case QEvent_type(Event) of
QEventWindowStateChange: SlotWindowStateChange;
QEventDrop,
QEventDragMove,
QEventDragEnter:
begin
Result := getAcceptDropFiles;
if (Result) and (QEvent_type(Event) = QEventDrop) then
Result := slotDropFiles(Sender, Event);
end;
else
Result := inherited EventFilter(Sender, Event);
end;
@ -4080,6 +4091,75 @@ begin
inherited OffsetMousePos(APoint);
end;
function TQtMainWindow.getAcceptDropFiles: Boolean;
begin
Result := QWidget_acceptDrops(Widget);
end;
procedure TQtMainWindow.setAcceptDropFiles(AValue: Boolean);
begin
QWidget_setAcceptDrops(Widget, AValue);
end;
function TQtMainWindow.slotDropFiles(Sender: QObjectH; Event: QEventH
): Boolean;
var
MimeData: QMimeDataH;
QStrList: QStringListH;
ByteArr: QByteArrayH;
i: Integer;
WStr: WideString;
GotFiles: Boolean;
FilesList: TStrings;
Files: Array of String;
begin
Result := False;
GotFiles := False;
MimeData := QDropEvent_mimeData(QDropEventH(Event));
QStrList := QStringList_create();
try
QMimeData_formats(MimeData, QStrList);
for i := 0 to QStringList_size(QStrList) - 1 do
begin
QStringList_at(QStrList, @WStr, i);
GotFiles := WStr = 'text/uri-list';
if GotFiles then
break;
end;
finally
QStringList_destroy(QStrList);
end;
if not GotFiles then
exit;
ByteArr := QByteArray_create();
try
QMimeData_data(MimeData, ByteArr, @WStr);
if not QByteArray_isNull(ByteArr) then
begin
WStr := '';
for i := 0 to QByteArray_size(ByteArr) - 1 do
WStr := WStr + QByteArray_at(ByteArr, i);
FilesList := TStringList.Create;
try
FilesList.Text := UTF8Encode(WStr);
{last member of TStringList always contains empty string
since QMimeData always have #13#10#0 at the end.So we cut it here.}
SetLength(Files, FilesList.Count - 1);
for i := 0 to High(Files) do
Files[i] := FilesList.Strings[i];
finally
FilesList.Free;
end;
QDropEvent_setDropAction(QDropEventH(Event), QtCopyAction);
QDropEvent_acceptProposedAction(QDropEventH(Event));
TCustomForm(LCLOBject).IntfDropFiles(Files);
Result := True;
end;
finally
QByteArray_destroy(ByteArr);
end;
end;
{------------------------------------------------------------------------------
Function: TQtMainWindow.SlotWindowStateChange
Params: None

13
lcl/interfaces/qt/qtwsforms.pp
View File

@ -80,6 +80,7 @@ type
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
@ -193,6 +194,18 @@ begin
inherited CloseModal(ACustomForm);
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomForm.SetAllowDropFiles
Params:
Returns: Nothing
------------------------------------------------------------------------------}
class procedure TQtWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
AValue: Boolean);
begin
if AForm.HandleAllocated then
TQtMainWindow(AForm.Handle).setAcceptDropFiles(AValue);
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomForm.SetFormBorderStyle
Params: