:: Visual Foxpro, Foxpro for DOS
drag-drop picture
dimuhametov
Автор

Сообщений: 1562
Откуда: Костанай
Дата регистрации: 01.11.2008
Уважаемые форумчане!
Навожу красоту в своем коде.
Возможно ли при переносе строки (drag-drop) из таблицы в другую визуально отображать свой текст или картинку, а не просто кусок пунктирного прямоугольника. Спасибо


------------------
Незнание делает жизнь такой интересной.
Ratings: 0 negative/0 positive
Re: drag-drop picture
PaulWist

Сообщений: 14601
Дата регистрации: 01.04.2004
WITH .grid
** для картинки просто
.column.Label1.OleDragPicture = 'Путь до картинки'
** для текстбокса есть проблема, что бы тащить мышкой надо выделить часть текста,
** для типа данных char, для int у меня не получилось,
** либо надо динамически подсовывать Label, что бы не выделять текст
.column.Text1.OleDragPicture = 'Путь до картинки'
ENDWITH


------------------
Есть многое на свете, друг Горацио...
Что и не снилось нашим мудрецам.
(В.Шекспир Гамлет)




Исправлено 1 раз(а). Последнее : PaulWist, 07.10.17 20:18
Ratings: 0 negative/0 positive
Re: drag-drop picture
dimuhametov
Автор

Сообщений: 1562
Откуда: Костанай
Дата регистрации: 01.11.2008
PaulWist
WITH .grid
** для картинки просто
.column.Label1.OleDragPicture = 'Путь до картинки'
** для текстбокса есть проблема, что бы тащить мышкой надо выделить часть текста,
** для типа данных char, для int у меня не получилось,
** либо надо динамически подсовывать Label, что бы не выделять текст
.column.Text1.OleDragPicture = 'Путь до картинки'
ENDWITH
Павел спасибо. Но картинка не появилась, использовал OleDragPicture.


------------------
Незнание делает жизнь такой интересной.
Ratings: 0 negative/0 positive
Re: drag-drop picture
PaulWist

Сообщений: 14601
Дата регистрации: 01.04.2004
Мда, что-то я запамятовал, действительно, иконка рисуется только у Lable


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

PUBLIC o
o = CREATEOBJECT('frm')
o.show()
DEFINE CLASS frm as Form
name = 'frm'
width = 375
PROCEDURE load
CREATE CURSOR test (f1 i, f2 c(60))
FOR i = 1 TO 10
INSERT INTO test VALUES (i, TRANSFORM(10 - i))
ENDFOR
GO TOP IN test
CREATE CURSOR test2 (f1 i, f2 c(60))
FOR i = 1 TO 2
INSERT INTO test2 VALUES (i, 'Тащи меня на грид ' + TRANSFORM(i))
ENDFOR
GO TOP IN test2
ENDPROC
PROCEDURE init
WITH this
.Width = 550
.height = 400
.AddObject('grd1','grd')
WITH .grd1
.top = 12
.left = 300
.visible = .t.
.Anchor = 10
.RecordSource = 'Test'
ENDWITH
.AddObject('grd2','grid')
WITH .grd2
.top = 12
.left = 12
.width = 241
.visible = .t.
.Anchor = 10
.RecordSource = 'Test2'
.ReadOnly = .t.
WITH .columns(2)
.addobject('GridLbl1','GridLbl')
.currentcontrol = 'GridLbl1'
ENDWITH
ENDWITH
ENDWITH
ENDPROC
ENDDEFINE
DEFINE CLASS lbl as Label
name = 'lbl'
Caption = 'Тащи меня на грид'
oledragmode = 1
oledropmode = 1
height = 25
width = 110
OleDragPicture = HOME(4) + "Icons\Dragdrop\DROP1PG.ICO"
ENDDEFINE
DEFINE CLASS GridLbl AS container
Width = 126
Height = 52
BackStyle = 0
BorderWidth = 0
Name = "GridLbl"
ADD OBJECT lbl1 AS lbl WITH ;
Height = 27, ;
Width = 84, ;
Caption = "lbl1", ;
Name = "lbl1"
PROCEDURE backstyle_access
If !Empty(this.Parent.ControlSource)
this.lbl1.Caption = Trim(Transform(Evaluate(this.Parent.ControlSource)))
Else
this.lbl1.Caption = ""
EndIf
this.lbl1.Width = this.Parent.Width
RETURN THIS.BackStyle
ENDPROC
PROCEDURE lbl1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
=this.Parent.backstyle
ENDPROC
ENDDEFINE
DEFINE CLASS txt as Textbox
name = 'txt'
value = 'Тащи меня на грид'
oledragmode = 1
oledropmode = 1
height = 25
width = 110
PROCEDURE oledragdrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL laArr[ 1 ], lnEll
DO CASE
CASE oDataObject.GetFormat( "VFP Source Object" )
* пытаемся получить ссылку на обьект
aa = oDataObject.GetData( "VFP Source Object", @laArr )
DO CASE
CASE (UPPER(aa.BaseClass) == 'TEXTBOX')
this.Value = 'Текстбокс ' + ALLTRIM(aa.value )
CASE (UPPER(aa.BaseClass) == 'COMMANDBUTTON')
this.Value = 'Кнопка ' + ALLTRIM(aa.Caption )
ENDCASE
NODEFAULT
this.Refresh()
CASE oDataObject.GetFormat( 15 )
aa = oDataObject.GetData( 15 , @laArr )
DO CASE
CASE ALEN(laArr) = 1
this.Value = TRANSFORM(laArr(1))
OTHERWISE
this.Value = 'Folder File '
ENDCASE
NODEFAULT
this.Refresh()
ENDCASE
ENDPROC
PROCEDURE oledragover
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
* Проверяем
DO CASE
CASE oDataObject.GetFormat( "VFP Source Object" ) OR oDataObject.GetFormat( 15 )
*!* * пытаемся выделить то что под курсором
OTHERWISE
** заглушка
ENDCASE
ENDPROC
ENDDEFINE
DEFINE CLASS grd as Grid
name = 'grd'
columncount = 2
oledropmode = 1
HighlightStyle = 2
Highlight = .t.
AllowCellSelection = .t.
width = 241
PROCEDURE init
WITH this
.column2.addobject('txt1','txt')
.column2.removeobject('text1')
.column2.currentcontrol = 'txt1'
.column2.txt1.Visible = .t.
.column2.txt1.borderstyle = 0
.column2.Sparse = .f.
ENDWITH
ENDPROC
PROCEDURE oledragdrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL laArr[ 1 ], lnEll
DO CASE
CASE oDataObject.GetFormat( "VFP Source Object" )
* пытаемся получить ссылку на обьект
aa = oDataObject.GetData( "VFP Source Object", @laArr )
WAIT WINDOW 'Уф - донесли' NOWAIT
DO CASE
CASE (UPPER(aa.BaseClass) == 'TEXTBOX')
replace f2 WITH 'Текстбокс ' + ALLTRIM(aa.value ) IN test
CASE (UPPER(aa.BaseClass) == 'COMMANDBUTTON')
replace f2 WITH 'Кнопка ' + ALLTRIM(aa.Caption ) IN test
CASE (UPPER(aa.BaseClass) == 'LABEL')
replace f2 WITH 'Label ' + ALLTRIM(aa.Caption ) IN test
ENDCASE
NODEFAULT
this.Refresh()
CASE oDataObject.GetFormat( 15 )
aa = oDataObject.GetData( 15 , @laArr )
DO CASE
CASE ALEN(laArr) = 1
replace f2 WITH TRANSFORM(laArr(1)) IN test
OTHERWISE
replace f2 WITH 'Folder File ' IN test
ENDCASE
NODEFAULT
this.Refresh()
ENDCASE
ENDPROC
PROCEDURE oledragover
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
* Проверяем
DO CASE
CASE oDataObject.GetFormat( "VFP Source Object" ) OR oDataObject.GetFormat( 15 )
WAIT WINDOW 'Несём, что надо' nowait
* пытаемся выделить то что под курсором
LOCAL nWhere_Out, nRelRow_Out, nRelCol_Out, nView_Out
nWhere_Out = 0
nRelRow_Out = 0
nRelCol_Out = 0
nView_Out = 0
WITH this
IF .GridHitTest(nXCoord, nYCoord ;
, @nWhere_Out , @nRelRow_Out , @nRelCol_Out , @nView_Out)
IF nWhere_Out = 3
.ActivateCell(nRelRow_Out, nRelCol_Out)
.Refresh()
ENDIF
ENDIF
ENDWITH
OTHERWISE
WAIT WINDOW 'Не то' nowait
ENDCASE
ENDPROC
ENDDEFINE


------------------
Есть многое на свете, друг Горацио...
Что и не снилось нашим мудрецам.
(В.Шекспир Гамлет)
Ratings: 0 negative/0 positive
Re: drag-drop picture
dimuhametov
Автор

Сообщений: 1562
Откуда: Костанай
Дата регистрации: 01.11.2008
Павел спасибо за пример.


------------------
Незнание делает жизнь такой интересной.
Ratings: 0 negative/0 positive
Re: drag-drop picture
Ydin

Сообщений: 7648
Откуда: Киев
Дата регистрации: 16.12.2005
На MouseDown объекта
DO WHILE MDOWN()
DOEVENTS
THISFORM.DRAW
THIS.TOP=MROW(THISFORM.NAME,THISFORM.SCALEMODE)+ln1
THIS.LEFT=MCOL(THISFORM.NAME,THISFORM.SCALEMODE)+ln2
ENDDO

Что угодно попляшет
Ratings: 0 negative/0 positive
Re: drag-drop picture
dimuhametov
Автор

Сообщений: 1562
Откуда: Костанай
Дата регистрации: 01.11.2008
Ydin
На MouseDown объекта
DO WHILE MDOWN()
DOEVENTS
THISFORM.DRAW
THIS.TOP=MROW(THISFORM.NAME,THISFORM.SCALEMODE)+ln1
THIS.LEFT=MCOL(THISFORM.NAME,THISFORM.SCALEMODE)+ln2
ENDDO

Что угодно попляшет
Александр, а можно поподробнее ..


------------------
Незнание делает жизнь такой интересной.
Ratings: 0 negative/0 positive
Re: drag-drop picture
Ydin

Сообщений: 7648
Откуда: Киев
Дата регистрации: 16.12.2005
Меняем координаты объекта (Left,Top) и он перемещается пока не отпустим мышь.
Вот кусок кода (ему лет 20) из имиджа "подсказка". Ее перетаскивают на нужный объект, а в его св-вах текст подсказки




Исправлено 1 раз(а). Последнее : Ydin, 17.10.17 09:20
Ratings: 0 negative/0 positive
Re: drag-drop picture
Ydin

Сообщений: 7648
Откуда: Киев
Дата регистрации: 16.12.2005
Вообще использую свой Objtoclient вместо ObjtoClient:
Он для SP3 девятки. Ошибки исправляет
Ratings: 0 negative/0 positive
Re: drag-drop picture
dimuhametov
Автор

Сообщений: 1562
Откуда: Костанай
Дата регистрации: 01.11.2008
Ydin
Меняем координаты объекта (Left,Top) и он перемещается пока не отпустим мышь.
Вот кусок кода (ему лет 20) из имиджа "подсказка". Ее перетаскивают на нужный объект, а в его св-вах текст подсказки

Ка я понял это пример типа "Рассказать про ..." , где balloon выходит лишь после "доставки" курсора к выбранному объекту.
Мне же надо что бы balloon отображался на всем пути передвижения курсора до выбранного объекта.


------------------
Незнание делает жизнь такой интересной.
Ratings: 0 negative/0 positive
Re: drag-drop picture
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Да нет, это ж код когда сам объект и таскается мышкой. Только это совсем не поможет для dragdrop "строк из грида" - ну разве что ты соорудишь контейнер с текстбоксами/лейблами визуально совпадающий со "строкой грида" и будешь его таскать... Но тогда проще уж просто в грид лейбл засунуть и по схеме Павла делать.
При том таскать такой объект можно лишь по самой форме - если контейнер на самой форме разместить (вне её, точнее вне контейнера где этот объект размещён ничего видно не будет), да и над активиксами рисоваться не будет... В общем так себе вариант.


------------------
WBR, Igor
Ratings: 0 negative/0 positive


Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 26 (Гостей: 26)

© 2000-2024 Fox Club 
Яндекс.Метрика