velocidad trayectoria recorrida rapidez fĂ­sica fisica ejemplos distancia desplazamiento delphi scroll windows-controls

trayectoria - Componentes de desplazamiento sincronizado Delphi



velocidad (5)

Estoy tratando de sincronizar el desplazamiento de dos componentes TDBGrid en una aplicación VCL Forms. Tengo dificultades para interceptar el WndProc de cada componente de la cuadrícula sin algunos problemas de pila. He intentado enviar mensajes WM_VSCROLL bajo eventos de desplazamiento, pero esto todavía resulta en una operación incorrecta. Tiene que funcionar para hacer clic en la barra de desplazamiento, así como para resaltar una celda, o un botón para subir o bajar el mouse. La idea es tener dos cuadrículas una junto a la otra mostrando una especie de diálogo de coincidencia.

Intentó

SendMessage( gridX.Handle, WM_VSCROLL, SB_LINEDOWN, 0 );

también

procedure TForm1.GridXCustomWndProc( var Msg: TMessage ); begin Msg.Result := CallWindowProc( POldWndProc, gridX.Handle, Msg.Msg, Msg.wParam, Msg.lParam ); if ( Msg.Msg = WM_VSCROLL ) then begin gridY.SetActiveRow( gridX.GetActiveRow ); gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam ); SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True ); end; end;

Y

procedure TForm1.GridxCustomWndProc( var Msg: TMessage ); begin if ( Msg.Msg = WM_VSCROLL ) then begin gridY.SetActiveRow( gridX.GetActiveRow ); gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam ); SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True ); end; inherited WndProc( Msg ); end;

El primero es solo una solución temporal, el segundo da como resultado lecturas de memoria no válidas y el tercero da como resultado un desbordamiento de pila. Entonces, ninguna de estas soluciones parece funcionar para mí. ¡Me encantaría obtener información sobre cómo lograr esta tarea! Gracias por adelantado.

ACTUALIZACIÓN: solución

private [...] GridXWndProc, GridXSaveWndProc: Pointer; GridYWndProc, GridYSaveWndProc: Pointer; procedure GridXCustomWndProc( var Msg: TMessage ); procedure GridYCustomWndProc( var Msg: TMessage ); procedure TForm1.FormCreate(Sender: TObject); begin GridXWndProc := classes.MakeObjectInstance( GridXCustomWndProc ); GridXSaveWndProc := Pointer( GetWindowLong( GridX.Handle, GWL_WNDPROC ) ); SetWindowLong( GridX.Handle, GWL_WNDPROC, LongInt( GridXWndProc ) ); GridYWndProc := classes.MakeObjectInstance( GridYCustomWndProc ); GridYSaveWndProc := Pointer( GetWindowLong( GridY.Handle, GWL_WNDPROC ) ); SetWindowLong( GridY.Handle, GWL_WNDPROC, LongInt( GridYWndProc ) ); end; procedure TForm1.GridXCustomWndProc( var Msg: TMessage ); begin Msg.Result := CallWindowProc( GridXSaveWndProc, GridX.Handle, Msg.Msg, Msg.WParam, Msg.LParam ); case Msg.Msg of WM_KEYDOWN: begin case TWMKey( Msg ).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT: GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); end; end; WM_VSCROLL: GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); WM_HSCROLL: GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); WM_MOUSEWHEEL: begin ActiveControl := GridY; GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); end; WM_DESTROY: begin SetWindowLong( GridX.Handle, GWL_WNDPROC, Longint( GridXSaveWndProc ) ); Classes.FreeObjectInstance( GridXWndProc ); end; end; end; procedure TForm1.GridXMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); begin GridY.SetActiveRow( GridX.GetActiveRow ); end; procedure TForm1.GridYCustomWndProc( var Msg: TMessage ); begin Msg.Result := CallWindowProc( GridYSaveWndProc, GridY.Handle, Msg.Msg, Msg.WParam, Msg.LParam ); case Msg.Msg of WM_KEYDOWN: begin case TWMKey( Msg ).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT: GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); end; end; WM_VSCROLL: GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); WM_HSCROLL: GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); WM_MOUSEWHEEL: begin ActiveControl := GridX; GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam ); end; WM_DESTROY: begin SetWindowLong( GridY.Handle, GWL_WNDPROC, Longint( GridYSaveWndProc ) ); Classes.FreeObjectInstance( GridYWndProc ); end; end; end; procedure TForm1.GridYMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); begin GridX.SetActiveRow( GridY.GetActiveRow ); end;

Gracias a - Sertac Akyuz por la solución. Cuando se integran en una aplicación de formularios de VCL utilizando cuadrículas, se mimetizarán mutuamente al desplazarse y resaltarán el registro seleccionado.


Encontré una solución ... sé que es bastante complicado ... pero al menos es completamente funcional ...

En lugar de tratar de ocultar la barra de desplazamiento horizontal ... hago que se muestre fuera del área visible, por lo que no puede ser visto por el usuario ...

La parte difícil:

  • Pon un TPanel donde está el TMemo y pon el TMemo dentro del TPanel
  • Ocultar bordes de TPanel, poner BorderWith como 0 y todos los biselados de bvNone / bkNone
  • Configure TMemo Align para alTop, no para alClient, etc ...
  • Maneje TPanel.OnResize para hacer que TMemo.Height sea más grande que TPanel.Height tanto como la altura de la barra de desplazamiento horizontal (en el momento en que use un valor constante de 20 píxeles, pero me gustaría saber cómo obtener el valor real)

Eso es todo ... hecho !!! La barra de desplazamiento horizontal está fuera del área visible ... puedes colocar el TPanel donde quieras, darle el tamaño que desees ... esa barra de desplazamiento horizontal no será vista por el usuario y no estará oculta, por lo que GetScrollPos funcionará correctamente ... complicado, lo sé, pero completamente funcional.

Aquí está el código completo para archivar eso:

En la sección de interfaz, antes de su declaración TForm, su TForm verá esta nueva clase TMemo en lugar de la normal:

type TMemo=class(StdCtrls.TMemo) // Just to add things to TMemo class only for this unit private BusyUpdating:Boolean; // To avoid circular SyncMemo:TMemo; // To remember the TMemo to be sync Old_WindowProc:TWndMethod; // To remember old handler procedure New_WindowProc(var Mensaje:TMessage); // The new handler public constructor Create(AOwner:TComponent);override; // The new constructor destructor Destroy;override; // The new destructor end;

En la sección de implementación en cualquier lugar que prefiera:

constructor TMemo.Create(AOwner:TComponent); // The new constructor begin inherited Create(AOwner); // Call real constructor BusyUpdating:=False; // Initialize as not being in use, to let enter Old_WindowProc:=WindowProc; // Remember old handler WindowProc:=New_WindowProc; // Replace handler with new one end; destructor TMemo.Destroy; // The new destructor begin WindowProc:=Old_WindowProc; // Restore the original handler inherited Destroy; // Call the real destructor end; procedure TMemo.New_WindowProc(var Mensaje:TMessage); begin Old_WindowProc(Mensaje); // Call the real handle before doing anything if (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed or BusyUpdating // To avoid circular or (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow) then Exit; // Do no more and exit the procedure BusyUpdating:=True; // Set that object is busy in our special action SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo BusyUpdating:=False; // Set that the object is no more busy in our special action end;

También en la sección de implementación en cualquier lugar que prefiera:

procedure TForm1.FormCreate(Sender: TObject); begin Memo1.SyncMemo:=Memo2; // Tell Memo1 what TMemo must sync (Memo2) Memo2.SyncMemo:=Memo1; // Tell Memo2 what TMemo must sync (Memo1) end; procedure TForm1.pnlMemo2Resize(Sender: TObject); begin Memo2.Height:=pnlMemo2.Height+20; // Make height enough big to cause horizontal scroll bar be out of TPanel visible area, so it will not be seen by the user end;

¡Eso es gente! Sé que es bastante complicado, pero completamente funcional.

Tenga en cuenta que he cambiado en New_WindowProc el orden de evaluar las condiciones OR ... solo es para mejorar la velocidad de todos los demás mensajes, por lo tanto, demore lo menos posible el tratamiento de todos los mensajes.

Espero que en algún momento sabré cómo reemplazar esos 20 por la altura real (calculada o leída) de la barra de desplazamiento horizontal TMemo.


Probablemente esté implementando la anulación de mensaje para ambas cuadrículas. GridX desplaza GridY, que a su vez desplaza a GridX, que a su vez ... SO. Puede proteger el código de desplazamiento superficial rodeando el bloque con banderas.

type TForm1 = class(TForm) [..] private FNoScrollGridX, FNoScrollGridY: Boolean; [..] procedure TForm1.GridXCustomWndProc( var Msg: TMessage ); begin Msg.Result := CallWindowProc(POldWndProc, gridX.Handle, Msg.Msg, Msg.wParam, Msg.lParam ); if ( Msg.Msg = WM_VSCROLL ) then begin if not FNoScrollGridX then begin FNoScrollGridX := True gridY.SetActiveRow( gridX.GetActiveRow ); gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam ); // SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True ); end; FNoScrollGridX := False; end; end;

Código similar para GridY. Por cierto, no necesitas el SetScrollPos.

editar:

TForm1 = class(TForm) [..] private GridXWndProc, GridXSaveWndProc: Pointer; GridYWndProc, GridYSaveWndProc: Pointer; procedure GridXCustomWndProc(var Msg: TMessage); procedure GridYCustomWndProc(var Msg: TMessage); [..] procedure TForm1.FormCreate(Sender: TObject); begin [..] GridXWndProc := classes.MakeObjectInstance(GridXCustomWndProc); GridXSaveWndProc := Pointer(GetWindowLong(GridX.Handle, GWL_WNDPROC)); SetWindowLong(GridX.Handle, GWL_WNDPROC, LongInt(GridXWndProc)); GridYWndProc := classes.MakeObjectInstance(GridYCustomWndProc); GridYSaveWndProc := Pointer(GetWindowLong(GridY.Handle, GWL_WNDPROC)); SetWindowLong(GridY.Handle, GWL_WNDPROC, LongInt(GridYWndProc)); end; procedure TForm1.GridXCustomWndProc(var Msg: TMessage); begin Msg.Result := CallWindowProc(GridXSaveWndProc, GridX.Handle, Msg.Msg, Msg.WParam, Msg.LParam); case Msg.Msg of WM_KEYDOWN: begin case TWMKey(Msg).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT: GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam); end; end; WM_VSCROLL: GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam); WM_MOUSEWHEEL: begin ActiveControl := GridY; GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam); end; WM_DESTROY: begin SetWindowLong(GridX.Handle, GWL_WNDPROC, Longint(GridXSaveWndProc)); Classes.FreeObjectInstance(GridXWndProc); end; end; end; procedure TForm1.GridYCustomWndProc(var Msg: TMessage); begin Msg.Result := CallWindowProc(GridYSaveWndProc, GridY.Handle, Msg.Msg, Msg.WParam, Msg.LParam); case Msg.Msg of WM_KEYDOWN: begin case TWMKey(Msg).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT: GridX.Perform(Msg.Msg, Msg.WParam, Msg.LParam); end; end; WM_VSCROLL: GridX.Perform(Msg.Msg, Msg.WParam, Msg.LParam); WM_MOUSEWHEEL: begin ActiveControl := GridX; GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam); end; WM_DESTROY: begin SetWindowLong(GridY.Handle, GWL_WNDPROC, Longint(GridYSaveWndProc)); Classes.FreeObjectInstance(GridYWndProc); end; end; end;


Obtuve una solución parcial, pero ahora completa (al menos para dos TMemo) ...

Quiero decir parcial, porque solo escucha los cambios en un TMemo pero no en el otro ...

Me refiero a un trabajo completo porque no depende de lo que se hace ...

Es tan simple como poner el mismo valor de desplazamiento horizontal en un Memo que en el otro ...

No tiene nada que ver con los mensajes, pero como estaba tratando de obtener una solución de trabajo atrapando los mensajes WM_HSCROLL, etc ... dejé el código porque funciona ... intentaré mejorarlo más tarde ... por ejemplo, capturar solo WM_PAINT, o de otras maneras ... pero por ahora, lo puse como lo tengo ya que funciona ... y no encontré en ninguna parte algo mejor ...

Aquí está el código que funciona:

// On private section of TForm1 Memo_OldWndProc:TWndMethod; // Just to save and call original handler procedure Memo_NewWndProc(var TheMessage:TMessage); // New handler // On implementation section of TForm1 procedure TForm1.FormCreate(Sender: TObject); begin Memo_OldWndProc:=Memo1.WindowProc; // Save the handler Memo1.WindowProc:=Memo_NewWndProc; // Put the new handler, so we can do extra things end; procedure TForm1.Memo_NewWndProc(var TheMessage:TMessage); begin Memo_OldWndProc(TheMessage); // Let the scrollbar to move to final position Memo2.Perform(WM_HSCROLL ,SB_THUMBPOSITION+65536*GetScrollPos(Memo1.Handle,SB_HORZ) ,0 ); // Put the horizontal scroll of Memo2 at same position as Memo1 end; procedure TForm1.FormDestroy(Sender: TObject); begin Memo1.WindowProc:=Memo_OldWndProc; // Restore the old handler end;

Funciona para todas las formas de hacer scroll para cambiar ...

Notas:

  • Sé que es horrible atrapar todos los mensajes, pero al menos funciona ...
  • este es mi primer intento exitoso de tener dos TMemos con barra de desplazamiento horizontal sincronizada ...
  • Entonces, si alguien puede mejorarlo un poco (no atrapar todos los mensajes) por favor hágalo y publíquelo.
  • Solo hace que Memo1 esté sincronizado horizontalmente con la barra Memo2, pero no Memo2 esté sincronizado con Memo1
  • Presiona las teclas arriba, abajo, izquierda, derecha, rueda del mouse, etc ... lo que quieras, pero en Memo2 para verlo en acción

Trataré de mejorarlo: al hacer algo en Memo2, Memo1 scroll aún estará sincronizado ...

Creo que puede funcionar para casi cualquier control que tenga ScrollBar, no solo TMemo ...


Como yo dije...

Aquí se trata de una solución mejor (no definitiva) en términos de eficiencia, código limpio y bidireccional ... el cambio en cualquiera afecta al otro ...

Por favor, lea los comentarios en el código para entender qué significa cada oración ... es bastante complicado ... pero la idea principal es la misma que antes ... configure la otra barra de desplazamiento horizontal de TMemo tal como está en el TMemo donde el usuario está actuando ... no importa lo que haga el usuario, mueva el mouse y seleccione texto, presione las teclas izquierda, derecha, inicio, fin, use la rueda horizontal del mouse (no todas tienen una), arrastre la barra de control, presione en cualquier parte de la horizontal barra de desplazamiento, etc ...

La idea principal es ... el objeto necesita ser pintado de nuevo, entonces ponga el otro objeto barra de desplazamiento horizontal idéntica a esta ...

Esta primera parte es solo para agregar cosas a la clase TMemo, simplemente está creando una nueva clase derivada pero con el mismo nombre de clase, pero solo para la unidad dentro de declarada.

Agregue esto a la sección de interfaz, antes de su declaración TForm, para que su TForm vea esta nueva clase TMemo en lugar de la normal:

type TMemo=class(StdCtrls.TMemo) // Just to add things to TMemo class only for this unit private BusyUpdating:Boolean; // To avoid circular SyncMemo:TMemo; // To remember the TMemo to be sync Old_WindowProc:TWndMethod; // To remember old handler procedure New_WindowProc(var Mensaje:TMessage); // The new handler public constructor Create(AOwner:TComponent);override; // The new constructor destructor Destroy;override; // The new destructor end;

La siguiente parte es la implementación de declaraciones previas de esa nueva clase TMemo.

Agregue esto a la sección de implementación en cualquier lugar que prefiera:

constructor TMemo.Create(AOwner:TComponent); // The new constructor begin inherited Create(AOwner); // Call real constructor BusyUpdating:=False; // Initialize as not being in use, to let enter Old_WindowProc:=WindowProc; // Remember old handler WindowProc:=New_WindowProc; // Replace handler with new one end; destructor TMemo.Destroy; // The new destructor begin WindowProc:=Old_WindowProc; // Restore the original handler inherited Destroy; // Call the real destructor end; procedure TMemo.New_WindowProc(var Mensaje:TMessage); begin Old_WindowProc(Mensaje); // Call the real handle before doing anything if BusyUpdating // To avoid circular or (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow) or (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed then Exit; // Do no more and exit the procedure BusyUpdating:=True; // Set that object is busy in our special action SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo BusyUpdating:=False; // Set that the object is no more busy in our special action end;

Ahora la última parte, dile a cada TMemo cuál es el otro Memo que tiene que estar sincronizado.

En su sección de implementación, para el evento Form1 Create, agregue algo como esto:

procedure TForm1.FormCreate(Sender: TObject); begin Memo1.SyncMemo:=Memo2; // Tell Memo1 what TMemo must sync (Memo2) Memo2.SyncMemo:=Memo1; // Tell Memo2 what TMemo must sync (Memo1) end;

Recuerda que hemos agregado un miembro de SyncMemo a nuestra nueva clase especial de TMemo, que estaba allí solo para decirles cuál es el otro.

Ahora una pequeña configuración para ambos TMemo jsut para que esto funcione perfectamente:

  • Permita que ambas barras de desplazamiento de TMemo sean visibles
  • Deje WordWrap falso en ambos Tmemo
  • Coloque un montón de texto (lo mismo para ambos), líneas largas y muchas líneas

Ejecútelo y vea cómo ambas barras de desplazamiento horizontales siempre están sincronizadas ...

  • Si mueve una barra de desplazamiento horizontal, la otra barra de desplazamiento horizontal se mueve ...
  • Si va en el texto hacia la derecha o hacia la izquierda, el inicio de línea o el final de línea, etc., sin importar dónde está SelStart en el otro ... el desplazamiento de texto horizontal está sincronizado.

El problema por el cual esta no es una versión final es que:

  • Las barras de desplazamiento (una horizontal en mi caso) no pueden ocultarse ... ya que si una está oculta, al llamar a GetScrollPos, devuelve cero, por lo que no está sincronizada.

Si alguien sabe cómo emular ocultos o hacer que GetScrollPos no devuelva cero, por favor coméntelo, es lo único que necesito arreglar para la versión final.

Notas:

  • Obviamente, lo mismo se puede hacer con la barra de desplazamiento vertical ... simplemente cambie WM_HSCROLL a WM_VSCROLL y SB_HORZ a SB_VERT
  • Obviamente, se puede hacer lo mismo para ambos al mismo tiempo ... solo copie la línea SyncMemo.Perform dos veces y en una deje WM_HSCROLL y SB_HORZ y en la otra deje WM_VSCROLL y SB_VERT

Aquí hay un ejemplo del procedimiento New_WindowProc para sincronizar ambas barras de desplazamiento al mismo tiempo, tal vez para personas perezosas, tal vez para personas como copiar y pegar:

procedure TMemo.New_WindowProc(var Mensaje:TMessage); begin Old_WindowProc(Mensaje); // Call the real handle before doing anything if BusyUpdating // To avoid circular or (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow) or (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed then Exit; // Do no more and exit the procedure BusyUpdating:=True; // Set that object is busy in our special action SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo SyncMemo.Perform(WM_VSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_VERT),0); // Send to the other TMemo a message to set its vertical scroll as it is on this TMemo BusyUpdating:=False; // Set that the object is no more busy in our special action end;

Espero que alguien pueda solucionar el problema de una barra de desplazamiento oculta y GetScrollPos devuelva cero !!!


Gracias por GetSystemMetrics y SM_CYHSCROLL , pero no es suficiente ... solo necesito 3 píxeles más ...

Así que solo uso: GetSystemMetrics(SM_CYHSCROLL)+3

Nota: Dos de esos píxeles podrían ser porque tengo un panel padre con BevelWidth con el valor 1 pero tengo BevelInner y BevelOuter con el valor bvNone por lo que no; pero el pixel adicional no sé por qué.

Muchas gracias.

Si prefieres, únete a ellos en una publicación grande, pero creo que es mejor no mezclarlos.

En respuesta a "Sertac Akyuz" (lo siento por hacerlo aquí, pero no sé cómo publicarlos al lado de su pregunta):

  • Puse aquí las soluciones que encontré cuando las encontré ... mi intención no era usarla como un cuaderno de notas ... Descubrí la solución segundos antes de escribir las publicaciones
  • Creo que es mejor ver las publicaciones anteriores, en lugar de editar multiplicar veces la misma publicación ... no permitirá que otros sepan la solución exacta, sino que también les indicará cómo llegar a esa solución.
  • Prefiero hacer las cosas de una manera como "enseñar a pescar, en lugar de dar el pescado".
  • No abrí una nueva pregunta solo porque el título de esta es exactamente lo que estaba tratando de hacer

Importante : descubro que no se puede lograr una solución perfecta mediante la captura de mensajes porque hay un caso que causa desplazamiento pero ningún mensaje WM_VSCROLL , WM_HSCROLL (solo WM_PAINT ) ... está relacionado con la selección de texto con el mouse ... déjame explicarte cómo lo veo en acción ... Simplemente empiece cerca del final de la última línea visual y mueva el mouse un poco hacia abajo, luego detenga el movimiento del mouse y deje presionar el botón del mouse ... sin hacer nada (el mouse no se mueve, no hay ninguna tecla, sin keydown, sin botón de mouse, etc ...) el TMemo se desplaza hacia abajo hasta que llega al final del texto ... lo mismo ocurre con los rollos horizontales cuando el mouse está cerca del extremo derecho de la línea visual y se mueve hacia la derecha ... también lo mismo en direcciones opuestas ... tales pergaminos no a través de los mensajes WM_VSCROLL WM_HSCROLL , solo WM_PAINT (al menos en mi computadora) ... también ocurre lo mismo en Grids.