test grid drag and resize

242 views
Skip to first unread message

Алексей Запольский (alex;)

unread,
Sep 21, 2025, 11:51:06 AMSep 21
to Comunidad de Visual Foxpro en Español
*Foxpro code
* I prefer controls in the bottom-right and top-left corners of the grid,
* responsible for move and resize.

USE IN SELECT("customers")
USE  (HOME()+"\samples\data\customer.dbf") ALIAS customers

PUBLIC oMyForm as Form
oMyForm = CREATEOBJECT("frmTest")
oMyForm.Show()
oMyForm.Refresh
READ EVENTS

CLEAR ALL

DEFINE CLASS frmTest AS FORM
   *DoCreate = .T.
   ADD OBJECT oContainerWithGrid as ContainerWithGrid WITH ;
      Left = 10, Top = 10, Width = 300, Height = 200
       
   PROCEDURE Destroy
    DODEFAULT()
    CLEAR EVENTS
ENDDEFINE

DEFINE CLASS ContainerWithGrid AS CONTAINER
Width = 300
Height = 200
   *DOCREATE = .T.
   Name = 'ContainerWithGrid'
   Capture = .F.
   Resizable = .T.
   Movable = .T.
       
lIsResizing = .F.
lIsMoving   = .F.

   * Property to store the old mouse position
   ADD OBJECT OldPosition as Point

   ADD OBJECT oGrid as GRID

   ADD OBJECT oChkMove   AS MoveHandle WITH Left=0, Top=0
   ADD OBJECT oChkResize AS ResizeHandle

   PROCEDURE Init()
      WITH this.oGrid
         *.Parent = THISFORM.ContainerWithGrid
         *.Dock = 0
         .Visible = .T.
         .Height = .parent.Height - 20
         .Width = .parent.Width - 20
         .Left = 10
         .Top = 10
         .RecordSourceType = 1
         .RecordSource = 'customers' && Table 'customers' must exist
         .AllowAddNew = .F.
         *.AllowDelete = .F.
         .ColumnCount = 2
         .refresh
      ENDWITH
       
      * Place resize handle immediately in the corner
      THIS.oChkResize.Left = THIS.Width - THIS.oChkResize.Width
      THIS.oChkResize.Top  = THIS.Height - THIS.oChkResize.Height
   ENDPROC
ENDDEFINE

* === Base class for handles ===
DEFINE CLASS Handle AS checkbox
   Caption = ""
   Style   = 1
   Height  = 20
   Width   = 20
   PicturePosition = 14

   PROCEDURE MouseDown(nButton, nShift, nXCoord, nYCoord)
      THIS.Parent.Capture = .T.
      THIS.Parent.OldPosition.X = nXCoord
      THIS.Parent.OldPosition.Y = nYCoord
   ENDPROC

   PROCEDURE MouseUp(nButton, nShift, nXCoord, nYCoord)
      THIS.Parent.Capture = .F.
      THIS.Parent.OldPosition.X = 0
      THIS.Parent.OldPosition.Y = 0
      THIS.Value = 0
      THIS.Refresh
      NODEFA
   ENDPROC

   PROCEDURE Click
      NODEFA   && fully disable the default checkbox toggle
   ENDPROC
ENDDEFINE


* === Handle for moving ===
DEFINE CLASS MoveHandle AS Handle
   Picture = HOME()+"\graphics\icons\dragdrop\drag1pg.ico"

   PROCEDURE MouseMove(nButton, nShift, nXCoord, nYCoord)
      IF THIS.Parent.Capture
         LOCAL nDX, nDY
         nDX = nXCoord - THIS.Parent.OldPosition.X
         nDY = nYCoord - THIS.Parent.OldPosition.Y
         THIS.Parent.Left = THIS.Parent.Left + nDX
         THIS.Parent.Top  = THIS.Parent.Top  + nDY
         THIS.Parent.OldPosition.X = nXCoord
         THIS.Parent.OldPosition.Y = nYCoord
      ENDIF
   ENDPROC
ENDDEFINE


* === Handle for resizing ===
DEFINE CLASS ResizeHandle AS Handle
   Picture = HOME()+"\graphics\Cursors\NW_05.CUR"

   PROCEDURE MouseMove(nButton, nShift, nXCoord, nYCoord)
      IF THIS.Parent.Capture
         LOCAL nDX, nDY
         nDX = nXCoord - THIS.Parent.OldPosition.X
         nDY = nYCoord - THIS.Parent.OldPosition.Y

         THIS.Parent.Width  = MAX(50, THIS.Parent.Width  + nDX)
         THIS.Parent.Height = MAX(40, THIS.Parent.Height + nDY)

         * Adjust the grid size
         THIS.Parent.oGrid.Width  = THIS.Parent.Width - 20
         THIS.Parent.oGrid.Height = THIS.Parent.Height - 20

         * Update the resize handle position itself
         THIS.Left = THIS.Parent.Width - THIS.Width
         THIS.Top  = THIS.Parent.Height - THIS.Height

         THIS.Parent.OldPosition.X = nXCoord
         THIS.Parent.OldPosition.Y = nYCoord
         
         *this.refresh
      ENDIF
   ENDPROC
ENDDEFINE

DEFINE CLASS Point AS Custom
    X = 0
    Y = 0
ENDDEFINE

ZeRoberto

unread,
Sep 23, 2025, 9:59:01 AMSep 23
to publicesvfoxpro
Gracias por compartir 

Saludos 


Visual Foxpro
https://www.youtube.com/@vfpUnlimited

Grupo de Compra y Venta de Codigo Fuente en VFP

--
Blog de la Comunidad Visual FoxPro en Español http://comunidadvfp.blogspot.com
---
Has recibido este mensaje porque estás suscrito al grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver este debate, visita https://groups.google.com/d/msgid/publicesvfoxpro/e2cb0994-c2fa-4522-8b57-d93ad1ed3c8fn%40googlegroups.com.

Dsan

unread,
Sep 23, 2025, 5:46:16 PMSep 23
to publice...@googlegroups.com
Excellent contribution.

Best regards

Douglas


--
Message has been deleted

Алексей Запольский (alex;)

unread,
Sep 26, 2025, 6:49:20 PMSep 26
to Comunidad de Visual Foxpro en Español
Gracias por sus comentarios Aquí hay otro interesante ;o) *Foxpro code
*test_text_cp.prg
CLEAR
Application.Visible = .F.

SET SAFETY OFF
ON KEY LABEL ALT+Q CLEAR EVENTS

LOCAL lni, lcTempFile, frmWEditMain as FrmMain
lcTempFile = 'c:\temp\chars1.txt'

*   _SCREEN.Visible = .T.

*!* _SCREEN.FontName = "Arial"
*!* _SCREEN.FontSize = 12
*!* _SCREEN.FontCharSet = 0

frmWEditMain = CREATEOBJECT("FrmMain")
frmWEditMain .Show()
*!* READ EVENTS

*!*    DEFINE WINDOW wEditMain FROM 1,40 TO 60,170 MDI SYSTEM CLOSE FLOAT ZOOM NOMINIMIZE GROW IN DESKTOP NAME frmWEditMain
*!*    *frmWEditMain.ShowWindow = 2
*!*    *frmWEditMain.WindowType = 1
*!*    ACTIVATE WINDOW wEditMain
*!*    SHOW WINDOW wEditMain
*!*    frmWEditMain.Closable = .T.
*!*    frmWEditMain.WindowState = 2
*!*    frmWEditMain.Visible = .T.
*!*    frmWEditMain.Show()


SET TEXTMERGE ON
SET TEXTMERGE TO (lcTempFile)

FOR m.lni = 192 TO 191 + 32
\<<'CODE: #' + TRANSFORM(m.lni) + ' - ' + CHR(m.lni) + ', CODE: #' + TRANSFORM(m.lni+32) + ' - ' + CHR(m.lni+32)>>
ENDFOR

SET TEXTMERGE TO
SET TEXTMERGE OFF

COPY FILE c:\temp\chars.txt TO c:\temp\chars2.txt
COPY FILE c:\temp\chars.txt TO c:\temp\chars3.txt

*CLOSE ALL

IF .T. AND FILE(lcTempFile)

   DEFINE WINDOW wEdit1 FROM 1,1 TO 50,100 FONT "FoxFont", 12 GROW MINIMIZE FLOAT IN FrmMain NAME frmEdit1
   *ACTIVATE WINDOW wEdit1
   *frmEdit.FontCharSet = 0
   frmEdit1.FontSize = 15
   MODIFY FILE (lcTempFile) WINDOW wEdit1 IN WINDOW FrmMain SAVE NOWAIT

   DEFINE WINDOW wEdit2 FROM 6,16 TO 56,116 FONT "Arial", 12 GROW MINIMIZE FLOAT IN WINDOW FrmMain NAME frmEdit2
   *ACTIVATE WINDOW wEdit2
   frmEdit2.FontCharSet = 0
   frmEdit2.FontSize = 15
   MODIFY FILE (CHRTRAN(lcTempFile,"1","2")) WINDOW wEdit2 IN WINDOW FrmMain NOEDIT SAVE NOWAIT
   
   DEFINE WINDOW wEdit3 FROM 11,31 TO 60,131 FONT "Arial", 12 GROW MINIMIZE FLOAT IN WINDOW FrmMain NAME frmEdit3
   *ACTIVATE WINDOW wEdit3
   frmEdit3.FontCharSet = 204
   frmEdit3.FontSize = 15
   MODIFY FILE (CHRTRAN(lcTempFile,"1","3")) WINDOW wEdit3 IN WINDOW FrmMain NOEDIT SAVE NOWAIT
   
ENDIF

READ EVENTS
*_SCREEN.FontCharSet = 0
Application.Visible = .T.


DEFINE CLASS FrmMain as Form
Closable = .T.
ShowWindow = 2
* WindowState = 2
WindowType = 1
Height = 920
Width = 1000

PROCEDURE Destroy
CLEAR EVENTS
ENDDEFINE
 

среда, 24 сентября 2025 г. в 00:46:16 UTC+3, DSánchez:
Reply all
Reply to author
Forward
Message has been deleted
0 new messages